From 4c4956428944a0b3ce6cb1f88dab1df7c041407c Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 2 Apr 2026 08:56:14 +0200 Subject: [PATCH 01/16] upgrade to ghc 9.10 --- .github/workflows/ci.yml | 5 +++ crem.cabal | 37 +++++++++---------- examples/Crem/Example/Cart/Aggregate.hs | 4 ++ examples/Crem/Example/Cart/Shipping.hs | 16 +++++--- examples/Crem/Example/LockDoor.hs | 4 ++ .../Crem/Example/RiskManager/Aggregate.hs | 6 +++ .../Crem/Example/RiskManager/Projection.hs | 22 +++++++---- examples/Crem/Example/TheHobbit.hs | 6 +++ examples/Crem/Example/TriangularMachine.hs | 2 + examples/Crem/Example/TwoSwitchesGate.lhs | 6 +++ examples/Crem/Example/Uno.hs | 6 +++ flake.lock | 32 ++++++++-------- flake.nix | 11 +++--- nix/haskell-configurations.nix | 1 + package.yaml | 23 ++++-------- src/Crem/BaseMachine.hs | 6 +++ src/Crem/Decider.hs | 7 +++- src/Crem/Graph.hs | 2 + src/Crem/Render/RenderFlow.hs | 2 + src/Crem/Render/RenderableVertices.hs | 2 + src/Crem/StateMachine.hs | 2 + src/Crem/Topology.hs | 13 +++++-- 22 files changed, 140 insertions(+), 75 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f29b71f..7c44000 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -58,6 +58,11 @@ jobs: - name: Build run: cabal build -f errors + - name: Unlit + run: | + unlit -i examples/Crem/Example/TwoSwitchesGate.lhs -o examples/Crem/Example/TwoSwitchesGate.hs \ + rm examples/Crem/Example/TwoSwitchesGate.lhs + - name: Test on current dependencies run: cabal test diff --git a/crem.cabal b/crem.cabal index d7294f5..440f638 100644 --- a/crem.cabal +++ b/crem.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack @@ -29,11 +29,6 @@ extra-source-files: flag errors description: enable -Werror manual: True - default: False - -flag test-doctest - description: run doctests - manual: True default: True library @@ -52,14 +47,15 @@ library DerivingStrategies LambdaCase PackageImports + RoleAnnotations ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-home-modules -Wno-missing-import-lists -Wno-all-missed-specialisations -Wno-prepositive-qualified-module build-depends: - base >=4.15 && <4.19 + base >=4.15 && <4.21 , machines >=0.7.3 && <0.8 , nothunks >=0.1 && <0.4 , profunctors >=3.2 && <5.7 - , singletons-base >=3.0 && <3.3 - , text >=1.2 && <2.1 + , singletons-base >=3.0 && <3.5 + , text >=1.2 && <2.2 default-language: Haskell2010 if impl(ghc >= 9.2) ghc-options: -Wno-missing-kind-signatures @@ -142,9 +138,10 @@ library crem-examples DerivingStrategies LambdaCase PackageImports + RoleAnnotations ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-home-modules -Wno-missing-import-lists -Wno-all-missed-specialisations -Wno-prepositive-qualified-module build-depends: - base >=4.15 && <4.19 + base >=4.15 && <4.21 , crem , profunctors , singletons-base @@ -211,9 +208,10 @@ executable hobbit-game DerivingStrategies LambdaCase PackageImports + RoleAnnotations ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-home-modules -Wno-missing-import-lists -Wno-all-missed-specialisations -Wno-prepositive-qualified-module build-depends: - base >=4.15 && <4.19 + base >=4.15 && <4.21 , crem , crem-examples default-language: Haskell2010 @@ -278,9 +276,10 @@ executable hobbit-map DerivingStrategies LambdaCase PackageImports + RoleAnnotations ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-home-modules -Wno-missing-import-lists -Wno-all-missed-specialisations -Wno-prepositive-qualified-module build-depends: - base >=4.15 && <4.19 + base >=4.15 && <4.21 , crem , crem-examples , text @@ -347,12 +346,15 @@ test-suite crem-doctests DerivingStrategies LambdaCase PackageImports + RoleAnnotations ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-home-modules -Wno-missing-import-lists -Wno-all-missed-specialisations -Wno-prepositive-qualified-module -threaded -Wno-unused-packages build-depends: - base >=4.15 && <4.19 + Cabal + , base >=4.15 && <4.21 , crem , crem-examples - , doctest-parallel >=0.2.3 && <0.4 + , doctest-parallel >=0.2.3 && <0.5 + , ghc default-language: Haskell2010 if impl(ghc >= 9.2) ghc-options: -Wno-missing-kind-signatures @@ -406,10 +408,6 @@ test-suite crem-doctests TypeSynonymInstances if flag(errors) ghc-options: -Werror - if flag(test-doctest) - buildable: True - else - buildable: False test-suite crem-spec type: exitcode-stdio-1.0 @@ -427,11 +425,12 @@ test-suite crem-spec DerivingStrategies LambdaCase PackageImports + RoleAnnotations ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-home-modules -Wno-missing-import-lists -Wno-all-missed-specialisations -Wno-prepositive-qualified-module build-tool-depends: hspec-discover:hspec-discover build-depends: - base >=4.15 && <4.19 + base >=4.15 && <4.21 , crem , crem-examples , hspec >=2.7 && <2.12 diff --git a/examples/Crem/Example/Cart/Aggregate.hs b/examples/Crem/Example/Cart/Aggregate.hs index 2a503cb..0f27ff9 100644 --- a/examples/Crem/Example/Cart/Aggregate.hs +++ b/examples/Crem/Example/Cart/Aggregate.hs @@ -5,6 +5,10 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns diff --git a/examples/Crem/Example/Cart/Shipping.hs b/examples/Crem/Example/Cart/Shipping.hs index b508ead..8830346 100644 --- a/examples/Crem/Example/Cart/Shipping.hs +++ b/examples/Crem/Example/Cart/Shipping.hs @@ -5,6 +5,10 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wredundant-constraints {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors @@ -31,13 +35,13 @@ data ShippingCommand data ShippingEvent $( singletons - [d| - data ShippingVertex = ShippingVertex - deriving stock (Eq, Show, Enum, Bounded) + [d| + data ShippingVertex = ShippingVertex + deriving stock (Eq, Show, Enum, Bounded) - shippingTopology :: Topology ShippingVertex - shippingTopology = Topology [] - |] + shippingTopology :: Topology ShippingVertex + shippingTopology = Topology [] + |] ) deriving via AllVertices ShippingVertex instance RenderableVertices ShippingVertex diff --git a/examples/Crem/Example/LockDoor.hs b/examples/Crem/Example/LockDoor.hs index 8154e4e..c054eec 100644 --- a/examples/Crem/Example/LockDoor.hs +++ b/examples/Crem/Example/LockDoor.hs @@ -7,6 +7,10 @@ {-# OPTIONS_GHC -Wno-all-missed-specialisations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns diff --git a/examples/Crem/Example/RiskManager/Aggregate.hs b/examples/Crem/Example/RiskManager/Aggregate.hs index 285c7b0..447e170 100644 --- a/examples/Crem/Example/RiskManager/Aggregate.hs +++ b/examples/Crem/Example/RiskManager/Aggregate.hs @@ -5,6 +5,10 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns @@ -49,6 +53,8 @@ data AggregateState (vertex :: AggregateVertex) where ReceivedCreditBureauDataFirst :: UserData -> CreditBureauData -> AggregateState 'ReceivedCreditBureauDataFirstVertex CollectedAllData :: UserData -> LoanDetails -> CreditBureauData -> AggregateState 'CollectedAllDataVertex +type role AggregateState nominal + riskAggregate :: BaseMachine AggregateTopology RiskCommand (Maybe RiskEvent) riskAggregate = BaseMachineT diff --git a/examples/Crem/Example/RiskManager/Projection.hs b/examples/Crem/Example/RiskManager/Projection.hs index 769f64c..db580b7 100644 --- a/examples/Crem/Example/RiskManager/Projection.hs +++ b/examples/Crem/Example/RiskManager/Projection.hs @@ -6,6 +6,10 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns @@ -50,15 +54,15 @@ instance Monoid ReceivedData where } $( singletons - [d| - data ProjectionVertex - = SingleProjectionVertex - deriving stock (Eq, Show, Enum, Bounded) + [d| + data ProjectionVertex + = SingleProjectionVertex + deriving stock (Eq, Show, Enum, Bounded) - projectionTopology :: Topology ProjectionVertex - projectionTopology = - Topology [] - |] + projectionTopology :: Topology ProjectionVertex + projectionTopology = + Topology [] + |] ) deriving via AllVertices ProjectionVertex instance RenderableVertices ProjectionVertex @@ -66,6 +70,8 @@ deriving via AllVertices ProjectionVertex instance RenderableVertices Projection data ProjectionState (vertex :: ProjectionVertex) where SingleProjectionState :: ReceivedData -> ProjectionState 'SingleProjectionVertex +type role ProjectionState nominal + riskProjection :: BaseMachine ProjectionTopology RiskEvent ReceivedData riskProjection = BaseMachineT diff --git a/examples/Crem/Example/TheHobbit.hs b/examples/Crem/Example/TheHobbit.hs index b41349e..82d5257 100644 --- a/examples/Crem/Example/TheHobbit.hs +++ b/examples/Crem/Example/TheHobbit.hs @@ -5,6 +5,10 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns @@ -84,6 +88,8 @@ data HobbitState (vertex :: HobbitVertex) where TrollsPathState :: KeyState -> HobbitState 'TrollsPath TrollsCaveState :: HobbitState 'TrollsCave +type role HobbitState nominal + stateMessage :: HobbitState vertex -> HobbitMessage stateMessage TunnelLikeHallState = HobbitMessage diff --git a/examples/Crem/Example/TriangularMachine.hs b/examples/Crem/Example/TriangularMachine.hs index 26ab66c..a3918a4 100644 --- a/examples/Crem/Example/TriangularMachine.hs +++ b/examples/Crem/Example/TriangularMachine.hs @@ -9,6 +9,8 @@ import Crem.StateMachine (StateMachine, unrestrictedMachine) data TriangularState (a :: ()) where OnlyState :: Int -> TriangularState '() +type role TriangularState nominal + triangular :: StateMachine Int Int triangular = unrestrictedMachine diff --git a/examples/Crem/Example/TwoSwitchesGate.lhs b/examples/Crem/Example/TwoSwitchesGate.lhs index 0a844e0..7cee860 100644 --- a/examples/Crem/Example/TwoSwitchesGate.lhs +++ b/examples/Crem/Example/TwoSwitchesGate.lhs @@ -9,6 +9,10 @@ > {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} > -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns > {-# OPTIONS_GHC -Wno-unused-type-patterns #-} +> -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +> {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +> -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +> {-# OPTIONS_GHC -Wno-missing-role-annotations #-} > > module Crem.Example.TwoSwitchesGate where > @@ -59,6 +63,8 @@ Next we need to define which data every vertex of our topology should contain. T > data SwitchState (vertex :: SwitchVertex) where > OnState :: SwitchState 'SwitchIsOn > OffState :: SwitchState 'SwitchIsOff +> +> type role SwitchState nominal In this case, for every vertex there is just one possible state. diff --git a/examples/Crem/Example/Uno.hs b/examples/Crem/Example/Uno.hs index 923a756..92ef08c 100644 --- a/examples/Crem/Example/Uno.hs +++ b/examples/Crem/Example/Uno.hs @@ -13,6 +13,10 @@ {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns {-# OPTIONS_GHC -Wno-unused-type-patterns #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- | Porting of https://github.com/thinkbeforecoding/UnoCore/blob/solution/Uno/Game.fs module Crem.Example.Uno where @@ -192,6 +196,8 @@ data UnoState (vertex :: UnoVertex) where UnoInitialState :: UnoState 'Initial UnoStartedState :: StateData -> UnoState 'Started +type role UnoState nominal + -- * Errors data GameError diff --git a/flake.lock b/flake.lock index 8624f85..7699d76 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "flake-compat": { "flake": false, "locked": { - "lastModified": 1673956053, - "narHash": "sha256-4gtG9iQuiKITOjNQQeQIpoIB6b16fm+504Ch3sNKLd8=", + "lastModified": 1767039857, + "narHash": "sha256-vNpUSpF5Nuw8xvDLj2KCwwksIbjua2LZCqhV1LNRDns=", "owner": "edolstra", "repo": "flake-compat", - "rev": "35bb57c0c8d8b62bbfd284272c928ceb64ddbde9", + "rev": "5edf11c44bc78a0d334f6334cdaf7d60d732daab", "type": "github" }, "original": { @@ -21,11 +21,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1681202837, - "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=", + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", "owner": "numtide", "repo": "flake-utils", - "rev": "cfacdce06f30d2b68473a46042957675eebb3401", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", "type": "github" }, "original": { @@ -36,11 +36,11 @@ }, "nix-filter": { "locked": { - "lastModified": 1681154353, - "narHash": "sha256-MCJ5FHOlbfQRFwN0brqPbCunLEVw05D/3sRVoNVt2tI=", + "lastModified": 1757882181, + "narHash": "sha256-+cCxYIh2UNalTz364p+QYmWHs0P+6wDhiWR4jDIKQIU=", "owner": "numtide", "repo": "nix-filter", - "rev": "f529f42792ade8e32c4be274af6b6d60857fbee7", + "rev": "59c44d1909c72441144b93cf0f054be7fe764de5", "type": "github" }, "original": { @@ -51,11 +51,11 @@ }, "nixpkgs": { "locked": { - "lastModified": 1681303793, - "narHash": "sha256-JEdQHsYuCfRL2PICHlOiH/2ue3DwoxUX7DJ6zZxZXFk=", + "lastModified": 1773821835, + "narHash": "sha256-TJ3lSQtW0E2JrznGVm8hOQGVpXjJyXY2guAxku2O9A4=", "owner": "nixos", "repo": "nixpkgs", - "rev": "fe2ecaf706a5907b5e54d979fbde4924d84b65fc", + "rev": "b40629efe5d6ec48dd1efba650c797ddbd39ace0", "type": "github" }, "original": { @@ -67,16 +67,16 @@ }, "nixpkgs-stable": { "locked": { - "lastModified": 1681269223, - "narHash": "sha256-i6OeI2f7qGvmLfD07l1Az5iBL+bFeP0RHixisWtpUGo=", + "lastModified": 1773814637, + "narHash": "sha256-GNU+ooRmrHLfjlMsKdn0prEKVa0faVanm0jrgu1J/gY=", "owner": "nixos", "repo": "nixpkgs", - "rev": "87edbd74246ccdfa64503f334ed86fa04010bab9", + "rev": "fea3b367d61c1a6592bc47c72f40a9f3e6a53e96", "type": "github" }, "original": { "owner": "nixos", - "ref": "nixos-22.11", + "ref": "nixos-25.11", "repo": "nixpkgs", "type": "github" } diff --git a/flake.nix b/flake.nix index 582c821..35858c0 100644 --- a/flake.nix +++ b/flake.nix @@ -3,7 +3,7 @@ inputs = { nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable"; - nixpkgs-stable.url = "github:nixos/nixpkgs/nixos-22.11"; + nixpkgs-stable.url = "github:nixos/nixpkgs/nixos-25.11"; flake-utils.url = "github:numtide/flake-utils"; nix-filter.url = "github:numtide/nix-filter"; flake-compat = { @@ -38,13 +38,13 @@ haskellPackages.override { overrides = self: super: { hpack = pkgs.hpack; - crem = pkgs.haskell.lib.compose.disableCabalFlag "test-doctest" ((self.callCabal2nix "crem" src { }).overrideAttrs (attrs: { + crem = (self.callCabal2nix "crem" src { }).overrideAttrs (attrs: { # doctest-parallel needs to know where the compiled crem package is preCheck = '' export GHC_PACKAGE_PATH="dist/package.conf.inplace:$GHC_PACKAGE_PATH" ''; - })); - fourmolu = pkgs.haskell.packages.ghc944.fourmolu; + }); + fourmolu = pkgs.haskell.packages.ghc910.fourmolu; }; }; @@ -62,7 +62,7 @@ configurations; # The version of GHC used for default package and development shell. - defaultGhcVersion = "ghc90"; + defaultGhcVersion = "ghc910"; # This is a shell utility that watches source files for changes, and triggers a # command when they change. @@ -122,6 +122,7 @@ haskell-language-server build-watch test-watch + unlit ]; shellHook = '' export PS1="❄️ GHC ${haskellPackages.ghc.version} $PS1" diff --git a/nix/haskell-configurations.nix b/nix/haskell-configurations.nix index 0f0e1bd..e2f9c7a 100644 --- a/nix/haskell-configurations.nix +++ b/nix/haskell-configurations.nix @@ -12,4 +12,5 @@ } { ghcVersion = "92"; } { ghcVersion = "94"; } + { ghcVersion = "910"; } ] diff --git a/package.yaml b/package.yaml index 29f4292..b889b50 100644 --- a/package.yaml +++ b/package.yaml @@ -27,13 +27,8 @@ extra-source-files: flags: errors: description: enable -Werror - default: False - manual: True - - test-doctest: - description: run doctests - manual: True default: True + manual: True when: - condition: impl(ghc >= 9.2) @@ -99,6 +94,7 @@ default-extensions: - DerivingStrategies # https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/deriving_strategies.html#extension-DerivingStrategies - LambdaCase # https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/lambda_case.html#extension-LambdaCase - PackageImports # https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/package_qualified_imports.html#extension-PackageImports + - RoleAnnotations # https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/roles.html#extension-RoleAnnotations # Options inspired by: https://medium.com/mercury-bank/enable-all-the-warnings-a0517bc081c3 ghc-options: @@ -117,14 +113,14 @@ ghc-options: - -Wno-prepositive-qualified-module # https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wprepositive-qualified-module dependencies: - - base >= 4.15 && < 4.19 + - base >= 4.15 && < 4.21 library: source-dirs: src dependencies: - profunctors >= 3.2 && < 5.7 - - singletons-base >= 3.0 && < 3.3 - - text >= 1.2 && < 2.1 + - singletons-base >= 3.0 && < 3.5 + - text >= 1.2 && < 2.2 - nothunks >= 0.1 && < 0.4 - machines >=0.7.3 && <0.8 # Disable adding Paths_crem to other-modules, because it does not conform to our style guide. @@ -172,13 +168,10 @@ tests: dependencies: - crem - crem-examples - - doctest-parallel >= 0.2.3 && < 0.4 + - doctest-parallel >= 0.2.3 && < 0.5 + - ghc + - Cabal when: - - condition: flag(test-doctest) - then: - buildable: True - else: - buildable: False - condition: false other-modules: Paths_crem diff --git a/src/Crem/BaseMachine.hs b/src/Crem/BaseMachine.hs index f155262..20eca58 100644 --- a/src/Crem/BaseMachine.hs +++ b/src/Crem/BaseMachine.hs @@ -35,6 +35,8 @@ data -> ActionResult m topology state initialVertex output } +type role BaseMachineT representational nominal representational nominal + -- | A `BaseMachine` is an effectful machine for every possible monad @m@. -- Needing to work for every monad, in fact it can not perform any kind of -- effect and needs to be pure in nature. @@ -113,6 +115,8 @@ instance (Applicative m) => Choice (BaseMachineT m topology) where data InitialState (state :: vertex -> Type) where InitialState :: state vertex -> InitialState state +type role InitialState representational + -- | The result of an action of the state machine. -- An @ActionResult m topology state initialVertex output@ contains an @output@ -- and a @state finalVertex@, where the transition from @initialVertex@ to @@ -130,6 +134,8 @@ data => m (output, state finalVertex) -> ActionResult m topology state initialVertex output +type role ActionResult representational nominal nominal nominal nominal + -- | Allows to change the computational context of an `ActionResult` from @m@ -- to @n@, given we have a [natural transformation](https://stackoverflow.com/a/58364172/2718064) -- from @m@ to @n@. diff --git a/src/Crem/Decider.hs b/src/Crem/Decider.hs index 1d467ae..7f50ec4 100644 --- a/src/Crem/Decider.hs +++ b/src/Crem/Decider.hs @@ -10,7 +10,6 @@ module Crem.Decider where import Crem.BaseMachine (ActionResult (..), BaseMachine, BaseMachineT (..), InitialState (..)) import Crem.Topology (AllowedTransition, Topology) -import Data.Foldable (foldl') import "base" Data.Kind (Type) -- | A @Decider topology input output@ is a Decider which receives inputs of @@ -42,6 +41,8 @@ data -> EvolutionResult topology state initialVertex output } +type role Decider nominal representational representational + -- | A smart wrapper over the machine state, which allows to enforce that only -- transitions allowed by the @topology@ are actually performed. data @@ -49,13 +50,15 @@ data (topology :: Topology vertex) (state :: vertex -> Type) (initialVertex :: vertex) - output + (output :: k) where EvolutionResult :: (AllowedTransition topology initialVertex finalVertex) => state finalVertex -> EvolutionResult topology state initialVertex output +type role EvolutionResult nominal representational nominal phantom + -- | translate a `Decider` into a `BaseMachine` deciderMachine :: Decider topology input output diff --git a/src/Crem/Graph.hs b/src/Crem/Graph.hs index 03f14ad..cdec402 100644 --- a/src/Crem/Graph.hs +++ b/src/Crem/Graph.hs @@ -12,6 +12,8 @@ newtype Graph a = Graph [(a, a)] deriving stock (Eq, Show) deriving newtype (NoThunks) +type role Graph representational + -- | The product graph. -- It has as vertices the product of the set of vertices of the initial graph. -- It has as edge from @(a1, b1)@ to @(a2, b2)@ if and only if there is an edge diff --git a/src/Crem/Render/RenderFlow.hs b/src/Crem/Render/RenderFlow.hs index 4b3d118..d080e54 100644 --- a/src/Crem/Render/RenderFlow.hs +++ b/src/Crem/Render/RenderFlow.hs @@ -21,6 +21,8 @@ data TreeMetadata a | BinaryLabel (TreeMetadata a) (TreeMetadata a) deriving stock (Show) +type role TreeMetadata representational + instance NoThunks a => NoThunks (TreeMetadata a) where showTypeOf _ = "TreeMetadata" wNoThunks ctxt tm = diff --git a/src/Crem/Render/RenderableVertices.hs b/src/Crem/Render/RenderableVertices.hs index 4a0b023..a424a86 100644 --- a/src/Crem/Render/RenderableVertices.hs +++ b/src/Crem/Render/RenderableVertices.hs @@ -23,6 +23,8 @@ class RenderableVertices a where -- `RenderableVertices` which lists all the terms of type @a@. newtype AllVertices a = AllVertices a +type role AllVertices representational + instance (Enum a, Bounded a) => RenderableVertices (AllVertices a) where vertices :: [AllVertices a] vertices = AllVertices <$> [minBound .. maxBound] diff --git a/src/Crem/StateMachine.hs b/src/Crem/StateMachine.hs index 3baf2b2..0eb8439 100644 --- a/src/Crem/StateMachine.hs +++ b/src/Crem/StateMachine.hs @@ -77,6 +77,8 @@ data StateMachineT m input output where -> StateMachineT m b (n c) -> StateMachineT m a (n c) +type role StateMachineT representational nominal nominal + instance NoThunks (StateMachineT m input output) where showTypeOf _ = "StateMachineT" wNoThunks ctxt sm = diff --git a/src/Crem/Topology.hs b/src/Crem/Topology.hs index 7a238ce..59c7158 100644 --- a/src/Crem/Topology.hs +++ b/src/Crem/Topology.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeAbstractions #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wredundant-constraints @@ -8,6 +9,10 @@ {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns {-# OPTIONS_GHC -Wno-unused-type-patterns #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- | A `Topology` is a list of allowed transition for a state machine. -- We are using it to enforce that only allowed transitions could be performed. @@ -62,8 +67,8 @@ data AllowTransition (topology :: Topology vertex) (initial :: vertex) (final :: -- | If we know that we have an edge from @a@ to @b@ in @map@, -- then we also have an edge from @a@ to @b@ if we add another vertex AllowAddingVertex - :: AllowTransition ('Topology map) a b - -> AllowTransition ('Topology (x ': map)) a b + :: AllowTransition ('Topology tmap) a b + -> AllowTransition ('Topology (x ': tmap)) a b instance NoThunks (AllowTransition topology initial final) where showTypeOf _ = "AllowTransition" @@ -87,9 +92,9 @@ instance {-# INCOHERENT #-} (AllowedTransition ('Topology ('(a, l1) ': l2)) a b) allowsTransition = AllowAddingEdge (allowsTransition :: AllowTransition ('Topology ('(a, l1) ': l2)) a b) -instance {-# INCOHERENT #-} (AllowedTransition ('Topology map) a b) => AllowedTransition ('Topology (x ': map)) a b where +instance {-# INCOHERENT #-} (AllowedTransition ('Topology tmap) a b) => AllowedTransition ('Topology (x ': tmap)) a b where allowsTransition = - AllowAddingVertex (allowsTransition :: AllowTransition ('Topology map) a b) + AllowAddingVertex (allowsTransition :: AllowTransition ('Topology tmap) a b) instance {-# INCOHERENT #-} AllowedTransition topology a a where allowsTransition = AllowIdentityEdge From e0897a06d7a61f00fe64247703138b7d74306de1 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 2 Apr 2026 09:23:16 +0200 Subject: [PATCH 02/16] fix formatting --- .github/workflows/ci.yml | 4 +- examples/Crem/Example/Cart/Aggregate.hs | 28 ++++---- examples/Crem/Example/LockDoor.hs | 28 ++++---- .../Crem/Example/RiskManager/Aggregate.hs | 36 +++++------ examples/Crem/Example/Switch.hs | 20 +++--- examples/Crem/Example/TheHobbit.hs | 44 ++++++------- examples/Crem/Example/Uno.hs | 26 ++++---- spec/Crem/Render/RenderFlowSpec.hs | 2 +- spec/Crem/RiskManagerSpec.hs | 64 +++++++++---------- src/Crem/BaseMachine.hs | 3 +- src/Crem/Decider.hs | 3 +- src/Crem/Render/RenderFlow.hs | 2 +- src/Crem/Topology.hs | 32 +++++----- 13 files changed, 148 insertions(+), 144 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 7c44000..1ab5960 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -80,4 +80,6 @@ jobs: uses: actions/checkout@v3 - name: Check code formatting - uses: fourmolu/fourmolu-action@v6 + uses: haskell-actions/run-fourmolu@v12 + with: + version: "0.19.0.1" diff --git a/examples/Crem/Example/Cart/Aggregate.hs b/examples/Crem/Example/Cart/Aggregate.hs index 0f27ff9..a990f28 100644 --- a/examples/Crem/Example/Cart/Aggregate.hs +++ b/examples/Crem/Example/Cart/Aggregate.hs @@ -24,21 +24,21 @@ import Crem.Topology import "singletons-base" Data.Singletons.Base.TH $( singletons - [d| - data CartVertex - = WaitingForPayment - | InitiatingPayment - | PaymentComplete - deriving stock (Eq, Show, Enum, Bounded) + [d| + data CartVertex + = WaitingForPayment + | InitiatingPayment + | PaymentComplete + deriving stock (Eq, Show, Enum, Bounded) - cartTopology :: Topology CartVertex - cartTopology = - Topology - [ (WaitingForPayment, [InitiatingPayment]) - , (InitiatingPayment, [PaymentComplete]) - , (PaymentComplete, []) - ] - |] + cartTopology :: Topology CartVertex + cartTopology = + Topology + [ (WaitingForPayment, [InitiatingPayment]) + , (InitiatingPayment, [PaymentComplete]) + , (PaymentComplete, []) + ] + |] ) deriving via AllVertices CartVertex instance RenderableVertices CartVertex diff --git a/examples/Crem/Example/LockDoor.hs b/examples/Crem/Example/LockDoor.hs index c054eec..432b1ca 100644 --- a/examples/Crem/Example/LockDoor.hs +++ b/examples/Crem/Example/LockDoor.hs @@ -24,21 +24,21 @@ import Crem.Topology import "singletons-base" Data.Singletons.Base.TH $( singletons - [d| - data LockDoorVertex - = IsLockOpen - | IsLockClosed - | IsLockLocked - deriving stock (Eq, Show, Enum, Bounded) + [d| + data LockDoorVertex + = IsLockOpen + | IsLockClosed + | IsLockLocked + deriving stock (Eq, Show, Enum, Bounded) - lockDoorTopology :: Topology LockDoorVertex - lockDoorTopology = - Topology - [ (IsLockOpen, [IsLockClosed]) - , (IsLockClosed, [IsLockOpen, IsLockLocked]) - , (IsLockLocked, [IsLockClosed]) - ] - |] + lockDoorTopology :: Topology LockDoorVertex + lockDoorTopology = + Topology + [ (IsLockOpen, [IsLockClosed]) + , (IsLockClosed, [IsLockOpen, IsLockLocked]) + , (IsLockLocked, [IsLockClosed]) + ] + |] ) deriving via AllVertices LockDoorVertex instance RenderableVertices LockDoorVertex diff --git a/examples/Crem/Example/RiskManager/Aggregate.hs b/examples/Crem/Example/RiskManager/Aggregate.hs index 447e170..ddb8a94 100644 --- a/examples/Crem/Example/RiskManager/Aggregate.hs +++ b/examples/Crem/Example/RiskManager/Aggregate.hs @@ -23,25 +23,25 @@ import Crem.Topology import "singletons-base" Data.Singletons.Base.TH $( singletons - [d| - data AggregateVertex - = NoDataVertex - | CollectedUserDataVertex - | CollectedLoanDetailsFirstVertex - | ReceivedCreditBureauDataFirstVertex - | CollectedAllDataVertex - deriving stock (Eq, Show, Enum, Bounded) + [d| + data AggregateVertex + = NoDataVertex + | CollectedUserDataVertex + | CollectedLoanDetailsFirstVertex + | ReceivedCreditBureauDataFirstVertex + | CollectedAllDataVertex + deriving stock (Eq, Show, Enum, Bounded) - aggregateTopology :: Topology AggregateVertex - aggregateTopology = - Topology - [ (NoDataVertex, [CollectedUserDataVertex]) - , (CollectedUserDataVertex, [CollectedLoanDetailsFirstVertex, ReceivedCreditBureauDataFirstVertex]) - , (CollectedLoanDetailsFirstVertex, [CollectedAllDataVertex]) - , (ReceivedCreditBureauDataFirstVertex, [CollectedAllDataVertex]) - , (CollectedAllDataVertex, []) - ] - |] + aggregateTopology :: Topology AggregateVertex + aggregateTopology = + Topology + [ (NoDataVertex, [CollectedUserDataVertex]) + , (CollectedUserDataVertex, [CollectedLoanDetailsFirstVertex, ReceivedCreditBureauDataFirstVertex]) + , (CollectedLoanDetailsFirstVertex, [CollectedAllDataVertex]) + , (ReceivedCreditBureauDataFirstVertex, [CollectedAllDataVertex]) + , (CollectedAllDataVertex, []) + ] + |] ) deriving via AllVertices AggregateVertex instance RenderableVertices AggregateVertex diff --git a/examples/Crem/Example/Switch.hs b/examples/Crem/Example/Switch.hs index 625bde6..e26fdaf 100644 --- a/examples/Crem/Example/Switch.hs +++ b/examples/Crem/Example/Switch.hs @@ -12,16 +12,16 @@ import Crem.Topology import "singletons-base" Data.Singletons.Base.TH $( singletons - [d| - -- topology with a two vertices and one edge from each vertex to the - -- other - switchTopology :: Topology Bool - switchTopology = - Topology - [ (True, [False]) - , (False, [True]) - ] - |] + [d| + -- topology with a two vertices and one edge from each vertex to the + -- other + switchTopology :: Topology Bool + switchTopology = + Topology + [ (True, [False]) + , (False, [True]) + ] + |] ) switchMachine :: SBool a -> BaseMachine SwitchTopology () () diff --git a/examples/Crem/Example/TheHobbit.hs b/examples/Crem/Example/TheHobbit.hs index 82d5257..17048c0 100644 --- a/examples/Crem/Example/TheHobbit.hs +++ b/examples/Crem/Example/TheHobbit.hs @@ -45,29 +45,29 @@ instance Monoid HobbitMessage where mempty = HobbitMessage "" $( singletons - [d| - data HobbitVertex - = TunnelLikeHall - | Lonelands - | TrollsClearing - | Rivendell - | MistyMountain - | TrollsPath - | TrollsCave - deriving stock (Eq, Show, Enum, Bounded) + [d| + data HobbitVertex + = TunnelLikeHall + | Lonelands + | TrollsClearing + | Rivendell + | MistyMountain + | TrollsPath + | TrollsCave + deriving stock (Eq, Show, Enum, Bounded) - hobbitTopology :: Topology HobbitVertex - hobbitTopology = - Topology - [ (TunnelLikeHall, [Lonelands]) - , (Lonelands, [TunnelLikeHall, TrollsClearing]) - , (TrollsClearing, [Rivendell, TrollsPath]) - , (Rivendell, [TrollsClearing, MistyMountain]) - , (MistyMountain, [Rivendell]) - , (TrollsPath, [TrollsClearing, TrollsCave]) - , (TrollsCave, [TrollsPath]) - ] - |] + hobbitTopology :: Topology HobbitVertex + hobbitTopology = + Topology + [ (TunnelLikeHall, [Lonelands]) + , (Lonelands, [TunnelLikeHall, TrollsClearing]) + , (TrollsClearing, [Rivendell, TrollsPath]) + , (Rivendell, [TrollsClearing, MistyMountain]) + , (MistyMountain, [Rivendell]) + , (TrollsPath, [TrollsClearing, TrollsCave]) + , (TrollsCave, [TrollsPath]) + ] + |] ) deriving via AllVertices HobbitVertex instance RenderableVertices HobbitVertex diff --git a/examples/Crem/Example/Uno.hs b/examples/Crem/Example/Uno.hs index 92ef08c..1854178 100644 --- a/examples/Crem/Example/Uno.hs +++ b/examples/Crem/Example/Uno.hs @@ -7,16 +7,16 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunrecognised-pragmas {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns {-# OPTIONS_GHC -Wno-unused-type-patterns #-} --- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures -{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} --- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations -{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- | Porting of https://github.com/thinkbeforecoding/UnoCore/blob/solution/Uno/Game.fs module Crem.Example.Uno where @@ -172,15 +172,15 @@ data Event -- * Topology $( singletons - [d| - data UnoVertex - = Initial - | Started - deriving stock (Eq, Show, Enum, Bounded) - - unoTopology :: Topology UnoVertex - unoTopology = Topology [(Initial, [Started])] - |] + [d| + data UnoVertex + = Initial + | Started + deriving stock (Eq, Show, Enum, Bounded) + + unoTopology :: Topology UnoVertex + unoTopology = Topology [(Initial, [Started])] + |] ) deriving via AllVertices UnoVertex instance RenderableVertices UnoVertex diff --git a/spec/Crem/Render/RenderFlowSpec.hs b/spec/Crem/Render/RenderFlowSpec.hs index 792f142..67a2d09 100644 --- a/spec/Crem/Render/RenderFlowSpec.hs +++ b/spec/Crem/Render/RenderFlowSpec.hs @@ -20,7 +20,7 @@ spec = `shouldBe` Right ( Mermaid "state lockMachine {" <> ( renderLabelledGraph "lockMachine" . baseMachineAsGraph @_ @_ @_ @_ @Identity $ - lockDoorMachine SIsLockClosed + lockDoorMachine SIsLockClosed ) <> Mermaid "}" , MachineLabel "lockMachine" diff --git a/spec/Crem/RiskManagerSpec.hs b/spec/Crem/RiskManagerSpec.hs index b4fd202..f171315 100644 --- a/spec/Crem/RiskManagerSpec.hs +++ b/spec/Crem/RiskManagerSpec.hs @@ -136,58 +136,58 @@ spec = it "registers one user when a registration event is received" $ do run readModel (UserDataRegistered myUserData) `shouldOutput` [ ReceivedData - { receivedUserData = Just myUserData - , receivedLoanDetails = Nothing - , receivedCreditBureauData = Nothing - } + { receivedUserData = Just myUserData + , receivedLoanDetails = Nothing + , receivedCreditBureauData = Nothing + } ] it "registers two users when two registration events are received" $ do runMultiple readModel [UserDataRegistered myUserData, UserDataRegistered notMyUserData] `shouldOutput` [ ReceivedData - { receivedUserData = Just myUserData - , receivedLoanDetails = Nothing - , receivedCreditBureauData = Nothing - } + { receivedUserData = Just myUserData + , receivedLoanDetails = Nothing + , receivedCreditBureauData = Nothing + } , ReceivedData - { receivedUserData = Just notMyUserData - , receivedLoanDetails = Nothing - , receivedCreditBureauData = Nothing - } + { receivedUserData = Just notMyUserData + , receivedLoanDetails = Nothing + , receivedCreditBureauData = Nothing + } ] describe "whole" $ do it "registers one user when a registration command is received" $ do run whole (RegisterUserData myUserData) `shouldOutput` [ ReceivedData - { receivedUserData = Just myUserData - , receivedLoanDetails = Nothing - , receivedCreditBureauData = Nothing - } + { receivedUserData = Just myUserData + , receivedLoanDetails = Nothing + , receivedCreditBureauData = Nothing + } , ReceivedData - { receivedUserData = Just myUserData - , receivedLoanDetails = Nothing - , receivedCreditBureauData = Just creditBureauData - } + { receivedUserData = Just myUserData + , receivedLoanDetails = Nothing + , receivedCreditBureauData = Just creditBureauData + } ] it "registers two users when two registration commands are received" $ do runMultiple whole [RegisterUserData myUserData, RegisterUserData notMyUserData] `shouldOutput` [ ReceivedData - { receivedUserData = Just myUserData - , receivedLoanDetails = Nothing - , receivedCreditBureauData = Nothing - } + { receivedUserData = Just myUserData + , receivedLoanDetails = Nothing + , receivedCreditBureauData = Nothing + } , ReceivedData - { receivedUserData = Just myUserData - , receivedLoanDetails = Nothing - , receivedCreditBureauData = Just creditBureauData - } + { receivedUserData = Just myUserData + , receivedLoanDetails = Nothing + , receivedCreditBureauData = Just creditBureauData + } , ReceivedData - { receivedUserData = Just notMyUserData - , receivedLoanDetails = Nothing - , receivedCreditBureauData = Just creditBureauData - } + { receivedUserData = Just notMyUserData + , receivedLoanDetails = Nothing + , receivedCreditBureauData = Just creditBureauData + } ] describe "riskApplication" $ do diff --git a/src/Crem/BaseMachine.hs b/src/Crem/BaseMachine.hs index 20eca58..75e7bbe 100644 --- a/src/Crem/BaseMachine.hs +++ b/src/Crem/BaseMachine.hs @@ -25,7 +25,8 @@ data m (topology :: Topology vertex) (input :: Type) - (output :: Type) = forall state. + (output :: Type) + = forall state. BaseMachineT { initialState :: InitialState state , action diff --git a/src/Crem/Decider.hs b/src/Crem/Decider.hs index 7f50ec4..8a78259 100644 --- a/src/Crem/Decider.hs +++ b/src/Crem/Decider.hs @@ -30,7 +30,8 @@ data Decider (topology :: Topology vertex) input - output = forall state. + output + = forall state. Decider { deciderInitialState :: InitialState state , decide :: forall vertex'. input -> state vertex' -> output diff --git a/src/Crem/Render/RenderFlow.hs b/src/Crem/Render/RenderFlow.hs index d080e54..98d9471 100644 --- a/src/Crem/Render/RenderFlow.hs +++ b/src/Crem/Render/RenderFlow.hs @@ -23,7 +23,7 @@ data TreeMetadata a type role TreeMetadata representational -instance NoThunks a => NoThunks (TreeMetadata a) where +instance (NoThunks a) => NoThunks (TreeMetadata a) where showTypeOf _ = "TreeMetadata" wNoThunks ctxt tm = case tm of diff --git a/src/Crem/Topology.hs b/src/Crem/Topology.hs index 59c7158..05550b1 100644 --- a/src/Crem/Topology.hs +++ b/src/Crem/Topology.hs @@ -3,16 +3,16 @@ {-# LANGUAGE TypeAbstractions #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wredundant-constraints {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns {-# OPTIONS_GHC -Wno-unused-type-patterns #-} --- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations -{-# OPTIONS_GHC -Wno-missing-role-annotations #-} --- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures -{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- | A `Topology` is a list of allowed transition for a state machine. -- We are using it to enforce that only allowed transitions could be performed. @@ -42,10 +42,10 @@ import "singletons-base" Prelude.Singletons -- Since we are using this information at the type level, and then we want to -- bring it down to the value level, we wrap it in `singletons` $( singletons - [d| - newtype Topology vertex = Topology - {edges :: [(vertex, [vertex])]} - |] + [d| + newtype Topology vertex = Topology + {edges :: [(vertex, [vertex])]} + |] ) -- ** AllowedTransition @@ -105,10 +105,10 @@ instance {-# INCOHERENT #-} AllowedTransition topology a a where -- Given a type @a@ for vertices, only trivial transitions, i.e. staying -- at the same vertex, are allowed $( singletons - [d| - trivialTopology :: Topology a - trivialTopology = Topology [] - |] + [d| + trivialTopology :: Topology a + trivialTopology = Topology [] + |] ) -- ** Allow all topology @@ -116,8 +116,8 @@ $( singletons -- | Given a type @a@ for vertices, every transition from one vertex to -- any other is allowed $( singletons - [d| - allowAllTopology :: (Bounded a, Enum a) => Topology a - allowAllTopology = Topology [(a, [minBound .. maxBound]) | a <- [minBound .. maxBound]] - |] + [d| + allowAllTopology :: (Bounded a, Enum a) => Topology a + allowAllTopology = Topology [(a, [minBound .. maxBound]) | a <- [minBound .. maxBound]] + |] ) From c81e073644dd3f3a04b397f440a21cf5a0431dd9 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 09:37:03 +0200 Subject: [PATCH 03/16] TypeAbstractions works only from GHC 9.8 --- src/Crem/Topology.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Crem/Topology.hs b/src/Crem/Topology.hs index 05550b1..e8b48a2 100644 --- a/src/Crem/Topology.hs +++ b/src/Crem/Topology.hs @@ -1,6 +1,11 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} + +#if __GLASGOW_HASKELL__ >= 908 {-# LANGUAGE TypeAbstractions #-} +#endif + {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures From 8e080e65497fc5aaf208447d1d87f83f2ae3e67e Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 09:37:22 +0200 Subject: [PATCH 04/16] declare ghc 9.6 and 9.8 as nix versions --- nix/haskell-configurations.nix | 2 ++ 1 file changed, 2 insertions(+) diff --git a/nix/haskell-configurations.nix b/nix/haskell-configurations.nix index e2f9c7a..b062b59 100644 --- a/nix/haskell-configurations.nix +++ b/nix/haskell-configurations.nix @@ -12,5 +12,7 @@ } { ghcVersion = "92"; } { ghcVersion = "94"; } + { ghcVersion = "96"; } + { ghcVersion = "98"; } { ghcVersion = "910"; } ] From f3f7fac950bbb9ff1339dba9404cad79a684e91c Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 09:37:41 +0200 Subject: [PATCH 05/16] add new versions of ghc and cabal to CI --- .github/workflows/ci.yml | 22 +++------------------- 1 file changed, 3 insertions(+), 19 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 1ab5960..61a9809 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,22 +13,9 @@ jobs: build: strategy: matrix: - ghc: ['9.0.2', '9.2.7', '9.4.4', '9.6.1'] - cabal: ['3.4.1.0', '3.6.2.0', '3.8.1.0', '3.10.1.0'] + ghc: ['9.0.2', '9.2.8', '9.4.8', '9.6.7', '9.8.4', '9.10.3'] + cabal: ['3.10.2.0', '3.12.1.0', '3.14.2.0', '3.16.1.0'] os: ['ubuntu-latest', 'macos-latest'] - exclude: - # Cabal 3.4.1.0 supports GHC version < 9.1 - - cabal: '3.4.1.0' - ghc: '9.2.7' - - cabal: '3.4.1.0' - ghc: '9.4.4' - - cabal: '3.4.1.0' - ghc: '9.6.1' - # Cabal 3.6.2.0 supports GHC version < 9.4 - - cabal: '3.6.2.0' - ghc: '9.4.4' - - cabal: '3.6.2.0' - ghc: '9.6.1' runs-on: ${{ matrix.os }} name: platform ${{ matrix.os }} GHC ${{ matrix.ghc }} cabal ${{ matrix.cabal }} steps: @@ -37,7 +24,7 @@ jobs: - name: Setup Haskell id: setup-haskell - uses: haskell/actions/setup@v2 + uses: haskell-actions/setup@v2 with: ghc-version: ${{ matrix.ghc }} cabal-version: ${{ matrix.cabal }} @@ -49,9 +36,6 @@ jobs: key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- - - name: Update cabal package list - run: cabal update - - name: Build dependencies run: cabal build --only-dependencies From 2735e1a912589960c6947fa2bbb3f3ef333dc970 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 10:29:25 +0200 Subject: [PATCH 06/16] use correct fourmolu version with nix --- flake.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flake.nix b/flake.nix index 35858c0..ffff68f 100644 --- a/flake.nix +++ b/flake.nix @@ -44,7 +44,7 @@ export GHC_PACKAGE_PATH="dist/package.conf.inplace:$GHC_PACKAGE_PATH" ''; }); - fourmolu = pkgs.haskell.packages.ghc910.fourmolu; + fourmolu = pkgs.haskell.packages."ghc${ghcVersion}".fourmolu; }; }; From 773f1878d6484fc6900b025f3ef35c5fd5287aea Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 10:38:27 +0200 Subject: [PATCH 07/16] temporarily restrict ghc and cabal versions --- .github/workflows/ci.yml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 61a9809..54ecdcb 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,8 +13,10 @@ jobs: build: strategy: matrix: - ghc: ['9.0.2', '9.2.8', '9.4.8', '9.6.7', '9.8.4', '9.10.3'] - cabal: ['3.10.2.0', '3.12.1.0', '3.14.2.0', '3.16.1.0'] + #ghc: ['9.0.2', '9.2.8', '9.4.8', '9.6.7', '9.8.4', '9.10.3'] + #cabal: ['3.10.2.0', '3.12.1.0', '3.14.2.0', '3.16.1.0'] + ghc: ['9.10.3'] + cabal: ['3.16.1.0'] os: ['ubuntu-latest', 'macos-latest'] runs-on: ${{ matrix.os }} name: platform ${{ matrix.os }} GHC ${{ matrix.ghc }} cabal ${{ matrix.cabal }} From 3abfc0ee73dad306513bd9ffe9eee5111a54bb29 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 11:00:21 +0200 Subject: [PATCH 08/16] clearly specify singletons-base version --- .github/workflows/ci.yml | 11 ++++---- cabal.project | 2 +- crem.cabal | 55 +++++++++++++++++++++++++++++++++------ package.yaml | 56 +++++++++++++++++++++++++++++++++------- 4 files changed, 100 insertions(+), 24 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 54ecdcb..726bdad 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,11 +13,9 @@ jobs: build: strategy: matrix: - #ghc: ['9.0.2', '9.2.8', '9.4.8', '9.6.7', '9.8.4', '9.10.3'] - #cabal: ['3.10.2.0', '3.12.1.0', '3.14.2.0', '3.16.1.0'] - ghc: ['9.10.3'] - cabal: ['3.16.1.0'] - os: ['ubuntu-latest', 'macos-latest'] + ghc: ['9.0.2', '9.2.8', '9.4.8', '9.6.7', '9.8.4', '9.10.3'] + cabal: ['3.10.2.0', '3.12.1.0', '3.14.2.0', '3.16.1.0'] + os: ['ubuntu-latest'] #, 'macos-latest'] runs-on: ${{ matrix.os }} name: platform ${{ matrix.os }} GHC ${{ matrix.ghc }} cabal ${{ matrix.cabal }} steps: @@ -46,7 +44,8 @@ jobs: - name: Unlit run: | - unlit -i examples/Crem/Example/TwoSwitchesGate.lhs -o examples/Crem/Example/TwoSwitchesGate.hs \ + cabal install unlit + unlit -i examples/Crem/Example/TwoSwitchesGate.lhs -o examples/Crem/Example/TwoSwitchesGate.hs rm examples/Crem/Example/TwoSwitchesGate.lhs - name: Test on current dependencies diff --git a/cabal.project b/cabal.project index 7cce255..5d14d99 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,4 @@ -index-state: 2023-03-14T09:58:19Z +index-state: 2026-04-09T08:51:20Z packages: *.cabal write-ghc-environment-files: always tests: True diff --git a/crem.cabal b/crem.cabal index 440f638..bf2d297 100644 --- a/crem.cabal +++ b/crem.cabal @@ -19,9 +19,11 @@ license-file: LICENSE build-type: Simple tested-with: GHC ==9.0.2 - , GHC ==9.2.7 - , GHC ==9.4.4 - , GHC ==9.6.1 + , GHC ==9.2.8 + , GHC ==9.4.8 + , GHC ==9.6.7 + , GHC ==9.8.4 + , GHC ==9.10.3 extra-source-files: README.md CHANGELOG.md @@ -51,11 +53,6 @@ library ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-home-modules -Wno-missing-import-lists -Wno-all-missed-specialisations -Wno-prepositive-qualified-module build-depends: base >=4.15 && <4.21 - , machines >=0.7.3 && <0.8 - , nothunks >=0.1 && <0.4 - , profunctors >=3.2 && <5.7 - , singletons-base >=3.0 && <3.5 - , text >=1.2 && <2.2 default-language: Haskell2010 if impl(ghc >= 9.2) ghc-options: -Wno-missing-kind-signatures @@ -109,6 +106,48 @@ library TypeSynonymInstances if flag(errors) ghc-options: -Werror + if impl(ghc >= 9.10) + build-depends: + machines >=0.7.3 && <0.8 + , nothunks >=0.1 && <0.4 + , profunctors >=3.2 && <5.7 + , singletons-base ==3.4.* + , text >=1.2 && <2.2 + if impl(ghc >= 9.8) && impl(ghc < 9.10) + build-depends: + machines >=0.7.3 && <0.8 + , nothunks >=0.1 && <0.4 + , profunctors >=3.2 && <5.7 + , singletons-base ==3.3.* + , text >=1.2 && <2.2 + if impl(ghc >= 9.6) && impl(ghc < 9.8) + build-depends: + machines >=0.7.3 && <0.8 + , nothunks >=0.1 && <0.4 + , profunctors >=3.2 && <5.7 + , singletons-base ==3.2.* + , text >=1.2 && <2.2 + if impl(ghc >= 9.4) && impl(ghc < 9.6) + build-depends: + machines >=0.7.3 && <0.8 + , nothunks >=0.1 && <0.4 + , profunctors >=3.2 && <5.7 + , singletons-base >=3.1.1 && <3.2 + , text >=1.2 && <2.2 + if impl(ghc >= 9.2) && impl(ghc < 9.4) + build-depends: + machines >=0.7.3 && <0.8 + , nothunks >=0.1 && <0.4 + , profunctors >=3.2 && <5.7 + , singletons-base >=3.1 && <3.1.1 + , text >=1.2 && <2.2 + if impl(ghc >= 9.0) && impl(ghc < 9.2) + build-depends: + machines >=0.7.3 && <0.8 + , nothunks >=0.1 && <0.4 + , profunctors >=3.2 && <5.7 + , singletons-base ==3.0.* + , text >=1.2 && <2.2 library crem-examples exposed-modules: diff --git a/package.yaml b/package.yaml index b889b50..dc41a73 100644 --- a/package.yaml +++ b/package.yaml @@ -16,9 +16,11 @@ description: flow and their state space." tested-with: - GHC ==9.0.2 - - GHC ==9.2.7 - - GHC ==9.4.4 - - GHC ==9.6.1 + - GHC ==9.2.8 + - GHC ==9.4.8 + - GHC ==9.6.7 + - GHC ==9.8.4 + - GHC ==9.10.3 extra-source-files: - README.md @@ -117,17 +119,53 @@ dependencies: library: source-dirs: src - dependencies: - - profunctors >= 3.2 && < 5.7 - - singletons-base >= 3.0 && < 3.5 - - text >= 1.2 && < 2.2 - - nothunks >= 0.1 && < 0.4 - - machines >=0.7.3 && <0.8 # Disable adding Paths_crem to other-modules, because it does not conform to our style guide. # https://github.com/sol/hpack#handling-of-paths_-modules when: - condition: false other-modules: Paths_crem + - condition: impl(ghc >= 9.10) + dependencies: + - profunctors >= 3.2 && < 5.7 + - text >= 1.2 && < 2.2 + - nothunks >= 0.1 && < 0.4 + - machines >=0.7.3 && <0.8 + - singletons-base >= 3.4 && < 3.5 + - condition: impl(ghc >= 9.8) && impl(ghc < 9.10) + dependencies: + - profunctors >= 3.2 && < 5.7 + - text >= 1.2 && < 2.2 + - nothunks >= 0.1 && < 0.4 + - machines >=0.7.3 && <0.8 + - singletons-base >= 3.3 && < 3.4 + - condition: impl(ghc >= 9.6) && impl(ghc < 9.8) + dependencies: + - profunctors >= 3.2 && < 5.7 + - text >= 1.2 && < 2.2 + - nothunks >= 0.1 && < 0.4 + - machines >=0.7.3 && <0.8 + - singletons-base >= 3.2 && < 3.3 + - condition: impl(ghc >= 9.4) && impl(ghc < 9.6) + dependencies: + - profunctors >= 3.2 && < 5.7 + - text >= 1.2 && < 2.2 + - nothunks >= 0.1 && < 0.4 + - machines >=0.7.3 && <0.8 + - singletons-base >= 3.1.1 && < 3.2 + - condition: impl(ghc >= 9.2) && impl(ghc < 9.4) + dependencies: + - profunctors >= 3.2 && < 5.7 + - text >= 1.2 && < 2.2 + - nothunks >= 0.1 && < 0.4 + - machines >=0.7.3 && <0.8 + - singletons-base >= 3.1 && < 3.1.1 + - condition: impl(ghc >= 9.0) && impl(ghc < 9.2) + dependencies: + - profunctors >= 3.2 && < 5.7 + - text >= 1.2 && < 2.2 + - nothunks >= 0.1 && < 0.4 + - machines >=0.7.3 && <0.8 + - singletons-base >= 3.0 && < 3.1 internal-libraries: crem-examples: From 6e0b76b4d236df142f2a775995e3d628328203a8 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 17:49:26 +0200 Subject: [PATCH 09/16] bump version of ceckout github action --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 726bdad..7a0829c 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -20,7 +20,7 @@ jobs: name: platform ${{ matrix.os }} GHC ${{ matrix.ghc }} cabal ${{ matrix.cabal }} steps: - name: Checkout - uses: actions/checkout@v3 + uses: actions/checkout@v6 - name: Setup Haskell id: setup-haskell From c84ec898b0b8a4a3b37d74e43932d1e7989d0d4e Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 17:50:07 +0200 Subject: [PATCH 10/16] use GHC options only with correct GHC version --- examples/Crem/Example/Cart/Aggregate.hs | 5 ++ examples/Crem/Example/Cart/Shipping.hs | 5 ++ examples/Crem/Example/LockDoor.hs | 5 ++ .../Crem/Example/RiskManager/Aggregate.hs | 5 ++ .../Crem/Example/RiskManager/Projection.hs | 5 ++ examples/Crem/Example/TheHobbit.hs | 48 +++++++------------ examples/Crem/Example/TwoSwitchesGate.lhs | 5 ++ examples/Crem/Example/Uno.hs | 5 ++ src/Crem/Topology.hs | 4 ++ 9 files changed, 55 insertions(+), 32 deletions(-) diff --git a/examples/Crem/Example/Cart/Aggregate.hs b/examples/Crem/Example/Cart/Aggregate.hs index a990f28..9a1daa3 100644 --- a/examples/Crem/Example/Cart/Aggregate.hs +++ b/examples/Crem/Example/Cart/Aggregate.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE TemplateHaskell #-} @@ -5,10 +6,14 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} + +#if __GLASGOW_HASKELL__ >= 908 -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations {-# OPTIONS_GHC -Wno-missing-role-annotations #-} +#endif + -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns diff --git a/examples/Crem/Example/Cart/Shipping.hs b/examples/Crem/Example/Cart/Shipping.hs index 8830346..cd5282b 100644 --- a/examples/Crem/Example/Cart/Shipping.hs +++ b/examples/Crem/Example/Cart/Shipping.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE TemplateHaskell #-} @@ -5,10 +6,14 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} + +#if __GLASGOW_HASKELL__ >= 908 -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations {-# OPTIONS_GHC -Wno-missing-role-annotations #-} +#endif + -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wredundant-constraints {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors diff --git a/examples/Crem/Example/LockDoor.hs b/examples/Crem/Example/LockDoor.hs index 432b1ca..8b75be9 100644 --- a/examples/Crem/Example/LockDoor.hs +++ b/examples/Crem/Example/LockDoor.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE TemplateHaskell #-} @@ -7,10 +8,14 @@ {-# OPTIONS_GHC -Wno-all-missed-specialisations #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} + +#if __GLASGOW_HASKELL__ >= 908 -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations {-# OPTIONS_GHC -Wno-missing-role-annotations #-} +#endif + -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns diff --git a/examples/Crem/Example/RiskManager/Aggregate.hs b/examples/Crem/Example/RiskManager/Aggregate.hs index ddb8a94..fa66e8a 100644 --- a/examples/Crem/Example/RiskManager/Aggregate.hs +++ b/examples/Crem/Example/RiskManager/Aggregate.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE TemplateHaskell #-} @@ -5,10 +6,14 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} + +#if __GLASGOW_HASKELL__ >= 908 -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations {-# OPTIONS_GHC -Wno-missing-role-annotations #-} +#endif + -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns diff --git a/examples/Crem/Example/RiskManager/Projection.hs b/examples/Crem/Example/RiskManager/Projection.hs index db580b7..fc7a2fb 100644 --- a/examples/Crem/Example/RiskManager/Projection.hs +++ b/examples/Crem/Example/RiskManager/Projection.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingVia #-} @@ -6,10 +7,14 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} + +#if __GLASGOW_HASKELL__ >= 908 -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations {-# OPTIONS_GHC -Wno-missing-role-annotations #-} +#endif + -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns diff --git a/examples/Crem/Example/TheHobbit.hs b/examples/Crem/Example/TheHobbit.hs index 17048c0..40310f0 100644 --- a/examples/Crem/Example/TheHobbit.hs +++ b/examples/Crem/Example/TheHobbit.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE TemplateHaskell #-} @@ -5,10 +6,14 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} + +#if __GLASGOW_HASKELL__ >= 908 -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations {-# OPTIONS_GHC -Wno-missing-role-annotations #-} +#endif + -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns @@ -93,62 +98,41 @@ type role HobbitState nominal stateMessage :: HobbitState vertex -> HobbitMessage stateMessage TunnelLikeHallState = HobbitMessage - "You are in a tunnel-like hall.\n\ - \You can only go east to the Lonelands" + "You are in a tunnel-like hall.\nYou can only go east to the Lonelands" stateMessage LonelandsState = HobbitMessage - "You are in the lonelands.\n\ - \You can either go west to a tunnel-like hall\n\ - \or go east to the Trolls clearing" + "You are in the lonelands.\nYou can either go west to a tunnel-like hall\nor go east to the Trolls clearing" stateMessage (TrollsClearingState keyState) = if keyState == DayDawned then HobbitMessage - "You are in the Trolls clearing.\n\ - \You could go north to the Trolls path,\n\ - \you can go east to Rivendell\n\ - \or you could get the key for the TrollsCave" + "You are in the Trolls clearing.\nYou could go north to the Trolls path,\nyou can go east to Rivendell\nor you could get the key for the TrollsCave" else HobbitMessage - "You are in the Trolls clearing.\n\ - \You could go north to the Trolls path,\n\ - \you can go east to Rivendell" + "You are in the Trolls clearing.\nYou could go north to the Trolls path,\nyou can go east to Rivendell" stateMessage (RivendellState _) = HobbitMessage - "You are in Rivendell.\n\ - \You could either go west to the Trolls clearing\n\ - \or go east to the Misty mountains\n" + "You are in Rivendell.\nYou could either go west to the Trolls clearing\nor go east to the Misty mountains\n" stateMessage (MistyMountainState _) = HobbitMessage - "You are in the Misty mountains.\n\ - \You can only go east to Rivendell" + "You are in the Misty mountains.\nYou can only go east to Rivendell" stateMessage (TrollsPathState keyState) = case keyState of NoKey -> HobbitMessage - "You are in the Trolls path.\n\ - \You can go south to the Trolls clearing\n\ - \or you can wait a bit" + "You are in the Trolls path.\nYou can go south to the Trolls clearing\nor you can wait a bit" DayDawned -> HobbitMessage - "You are in the Trolls path.\n\ - \You can go south to the Trolls clearing\n\ - \or you can wait some more" + "You are in the Trolls path.\nYou can go south to the Trolls clearing\nor you can wait some more" GotKey -> HobbitMessage - "You are in the Trolls path.\n\ - \You can go south to the Trolls clearing,\n\ - \you can unlock the door to the Trolls cave\n\ - \or you can wait some more" + "You are in the Trolls path.\nYou can go south to the Trolls clearing,\nyou can unlock the door to the Trolls cave\nor you can wait some more" DoorUnlocked -> HobbitMessage - "You are in the Trolls path.\n\ - \You can go south to the Trolls clearing\n\ - \or you can go north to the Trolls cave" + "You are in the Trolls path.\nYou can go south to the Trolls clearing\nor you can go north to the Trolls cave" stateMessage TrollsCaveState = HobbitMessage - "Welcome to the Trolls cave!\n\ - \Now you can go back south to the Trolls path" + "Welcome to the Trolls cave!\nNow you can go back south to the Trolls path" hobbitResult :: (Applicative m, AllowedTransition HobbitTopology initialVertex finalVertex) diff --git a/examples/Crem/Example/TwoSwitchesGate.lhs b/examples/Crem/Example/TwoSwitchesGate.lhs index 7cee860..3b2e6bc 100644 --- a/examples/Crem/Example/TwoSwitchesGate.lhs +++ b/examples/Crem/Example/TwoSwitchesGate.lhs @@ -1,3 +1,4 @@ +> {-# LANGUAGE CPP #-} > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE DerivingVia #-} > {-# LANGUAGE TemplateHaskell #-} @@ -10,9 +11,13 @@ > -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns > {-# OPTIONS_GHC -Wno-unused-type-patterns #-} > -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +> +> #if __GLASGOW_HASKELL__ >= 908 +> -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures > {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} > -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations > {-# OPTIONS_GHC -Wno-missing-role-annotations #-} +> #endif > > module Crem.Example.TwoSwitchesGate where > diff --git a/examples/Crem/Example/Uno.hs b/examples/Crem/Example/Uno.hs index 1854178..e3ae8e6 100644 --- a/examples/Crem/Example/Uno.hs +++ b/examples/Crem/Example/Uno.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# HLINT ignore "Redundant id" #-} {-# LANGUAGE DeriveAnyClass #-} @@ -7,10 +8,14 @@ {-# LANGUAGE UndecidableInstances #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} + +#if __GLASGOW_HASKELL__ >= 908 -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations {-# OPTIONS_GHC -Wno-missing-role-annotations #-} +#endif + -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunrecognised-pragmas {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors diff --git a/src/Crem/Topology.hs b/src/Crem/Topology.hs index e8b48a2..bac62eb 100644 --- a/src/Crem/Topology.hs +++ b/src/Crem/Topology.hs @@ -8,10 +8,14 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} + +#if __GLASGOW_HASKELL__ >= 908 -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations {-# OPTIONS_GHC -Wno-missing-role-annotations #-} +#endif + -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wredundant-constraints {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors From 6b7d8107cf1d8784f7ba4fa29ecfcce7068b02c1 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 18:08:49 +0200 Subject: [PATCH 11/16] renounce literate haskell --- .github/workflows/ci.yml | 6 - .../2026-04-09-renounce-literate-haskell | 0 examples/Crem/Example/TwoSwitchesGate.hs | 259 ++++++++++++++++++ examples/Crem/Example/TwoSwitchesGate.lhs | 254 ----------------- flake.nix | 1 - 5 files changed, 259 insertions(+), 261 deletions(-) create mode 100644 decision-log/2026-04-09-renounce-literate-haskell create mode 100644 examples/Crem/Example/TwoSwitchesGate.hs delete mode 100644 examples/Crem/Example/TwoSwitchesGate.lhs diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 7a0829c..dee8460 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -42,12 +42,6 @@ jobs: - name: Build run: cabal build -f errors - - name: Unlit - run: | - cabal install unlit - unlit -i examples/Crem/Example/TwoSwitchesGate.lhs -o examples/Crem/Example/TwoSwitchesGate.hs - rm examples/Crem/Example/TwoSwitchesGate.lhs - - name: Test on current dependencies run: cabal test diff --git a/decision-log/2026-04-09-renounce-literate-haskell b/decision-log/2026-04-09-renounce-literate-haskell new file mode 100644 index 0000000..e69de29 diff --git a/examples/Crem/Example/TwoSwitchesGate.hs b/examples/Crem/Example/TwoSwitchesGate.hs new file mode 100644 index 0000000..c046626 --- /dev/null +++ b/examples/Crem/Example/TwoSwitchesGate.hs @@ -0,0 +1,259 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies +{-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors +{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns +{-# OPTIONS_GHC -Wno-unused-type-patterns #-} + +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +#if __GLASGOW_HASKELL__ >= 908 +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures +{-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} +-- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations +{-# OPTIONS_GHC -Wno-missing-role-annotations #-} +#endif +module Crem.Example.TwoSwitchesGate where + +import "base" Data.Functor.Identity +import "crem" Crem.BaseMachine +import "crem" Crem.Render.Render +import "crem" Crem.Render.RenderFlow +import "crem" Crem.Render.RenderableVertices (AllVertices (..), RenderableVertices) +import "crem" Crem.StateMachine +import "crem" Crem.Topology +import "profunctors" Data.Profunctor +import "singletons-base" Data.Singletons.Base.TH +import "text" Data.Text (pack) + +-- We would like to implement a gate opening mechanism controlled by two switches. We would like the gate to open only when the two switches are on. + +-- We would like to implement this by composing several small state machines: one for every switch, one for making sure that we actually receive the right message from both switches, and one for actually opening the gate. + +-- Let's start with the switch. + +-- The first thing we need to do is to define the topology of our machine, meaning the allowed transitions in its state space. + +-- For a switch, there are only two states. Either the switch is on or it is off. + +-- Moreover, we want those switches to be usable only once, and therefore we want to forbid the transition from the `on`` to the `off` position. In other terms, we allow only to go from the `off` position to the `on` position. + +$( singletons + [d| + data SwitchVertex + = SwitchIsOn + | SwitchIsOff + deriving stock (Eq, Show, Bounded, Enum) + + switchTopology :: Topology SwitchVertex + switchTopology = + Topology + [(SwitchIsOff, [SwitchIsOn])] + |] + ) + +-- Notice that we need to wrap this in `singletons` because we will soon need to use this data type as a kind, to store information in the type of our state machines. + +-- We need also an instance of `RenderableVertices SwitchVertex` to decide which vertices to render for our machine. To obtain that, we use `deriving via` together with the `AllVertices` newtype. + +deriving via AllVertices SwitchVertex instance RenderableVertices SwitchVertex + +-- Next we need to define which data every vertex of our topology should contain. To express that we use a generalized algebraid data type indexed with `SwitchVertex` + +data SwitchState (vertex :: SwitchVertex) where + OnState :: SwitchState 'SwitchIsOn + OffState :: SwitchState 'SwitchIsOff + +type role SwitchState nominal + +-- In this case, for every vertex there is just one possible state. + +-- At this point we need to define which inputs our machine should handle and which outputs it should emit. In the case there is only one meaningful input, the request of turning on the switch, and one meaningful output, the notification that the switch has been turned on. + +data SwitchInput = TurnOn + +data SwitchOutput = TurnedOn + deriving stock (Show) + +instance Semigroup SwitchOutput where + TurnedOn <> TurnedOn = TurnedOn + +-- At this point we can actually implement our switch as a `BaseMachine` + +switch :: () -> BaseMachine SwitchTopology SwitchInput SwitchOutput +switch _ = + BaseMachineT + { initialState = InitialState OffState + , action = \case + OnState -> \_ -> pureResult TurnedOn OnState + OffState -> \_ -> pureResult TurnedOn OnState + } + +-- We start from the `OffState` and every time we receive a request to turn the switch on, we return a message informing the external world that the switch in turned on and we update the state accordingly if needed. + +-- Since we need two separate switches, we can create them by invoking the `switch` function twice + +switch1 :: BaseMachine SwitchTopology SwitchInput SwitchOutput +switch1 = switch () + +switch2 :: BaseMachine SwitchTopology SwitchInput SwitchOutput +switch2 = switch () + +-- This concludes the implementation of our switch machine. Next, we would like to implement a machine which receives as inputs the output of two switches and emits a message whenever both the switches have been turned on. + +-- Again, we need to start thinking about the topology of our machine. Since we need to track the state of the two switches, we will have four vertices + +$( singletons + [d| + data BothVertex + = NoSwitchOn + | OnlyFirstSwitchOn + | OnlySecondSwitchOn + | BothSwitchesOn + deriving (Eq, Show, Enum, Bounded) + + bothTopology :: Topology BothVertex + bothTopology = + Topology + [ (NoSwitchOn, [OnlyFirstSwitchOn, OnlySecondSwitchOn]) + , (OnlyFirstSwitchOn, [BothSwitchesOn]) + , (OnlySecondSwitchOn, [BothSwitchesOn]) + ] + |] + ) + +deriving via AllVertices BothVertex instance RenderableVertices BothVertex + +-- The topology again constrains the machine with the invariant the we can only turn on switches. + +-- Next we need to define the state space, assigning a data type to every vertex in the topology. In this case we don't have the need to attach data to our vertices so we can simply define + +data BothState (vertex :: BothVertex) where + NoSwitchOnState :: BothState 'NoSwitchOn + OnlyFirstSwitchOnState :: BothState 'OnlyFirstSwitchOn + OnlySecondSwitchOnState :: BothState 'OnlySecondSwitchOn + BothSwitchesOnState :: BothState 'BothSwitchesOn + +-- Before defining the logic of the machine, we need to define its inputs and outputs. Since we would like it to monitor the outputs of both switches, its input type could be + +type BothInput = Either SwitchOutput SwitchOutput + +-- Its output instead will be a potential message to actually open the gate + +data OpenGate = OpenGate + +type BothOutput = Maybe OpenGate + +-- and eventually we can define the logic of our state machine + +bothMachine :: BaseMachine BothTopology BothInput BothOutput +bothMachine = + BaseMachineT + { initialState = InitialState NoSwitchOnState + , action = \case + NoSwitchOnState -> \case + Left _ -> pureResult Nothing OnlyFirstSwitchOnState + Right _ -> pureResult Nothing OnlySecondSwitchOnState + OnlyFirstSwitchOnState -> \case + Left _ -> pureResult Nothing OnlyFirstSwitchOnState + Right _ -> pureResult (Just OpenGate) BothSwitchesOnState + OnlySecondSwitchOnState -> \case + Left _ -> pureResult (Just OpenGate) BothSwitchesOnState + Right _ -> pureResult Nothing OnlySecondSwitchOnState + BothSwitchesOnState -> \_ -> pureResult Nothing BothSwitchesOnState + } + +-- The last machine that we need is one representing the actual gate. Since the logic is exactly the same as the one of the switches, we can actually reuse what we defined above + +gate :: BaseMachine SwitchTopology SwitchInput SwitchOutput +gate = switch () + +-- Now we have all the machines we wanted and we need to connect them appropriately. + +-- We have the two switches which produce a `SwitchOutput` and the `bothMachine` which accepts inputs of type `Either SwitchOutput SwitchOutput`. + +-- We need to pair up the two switches, first, and then connect them to the `bothMachine`. We need to pair the two switches in a way that allows us to decide whether to run one or the other: this is exactly what the `Alternative` constructor of the `StateMachineT` data type allows us to do. + +switches :: StateMachine (Either SwitchInput SwitchInput) (Either SwitchOutput SwitchOutput) +switches = Basic switch1 `Alternative` Basic switch2 + +-- Notice that we had to wrap our `switch` machines with `Basic` to turn them into `StateMachine`s, which is the more composable type used by `Alternative`. + +-- Now we have the output of `switches` which coincides with the input of `bothMachine`, and therefore we can pass every output we get from `switches` to `bothMachine`. We use the `Sequential` constractor exactly for this + +bothSwitches :: StateMachine (Either SwitchInput SwitchInput) BothOutput +bothSwitches = switches `Sequential` Basic bothMachine + +-- Now we have a machine which emits `BothOutput = Maybe OpenGate`. Our `gate` machine on the other hand accepts inputs of type `SwitchInput`. To connect those, we need to do some adjusting. + +-- First, we can translate an `OpenGate` into a `SwitchInput` + +openGateToSwitchInput :: OpenGate -> SwitchInput +openGateToSwitchInput OpenGate = TurnOn + +-- and we can use this function to adapt our `gate` machine so that it accepts `OpenGate` as input. + +gate' :: BaseMachine SwitchTopology OpenGate SwitchOutput +gate' = lmap openGateToSwitchInput gate + +-- Still `bothSwitches` emits values of type `Maybe OpenGate`. We could lift our `gate'` machine to `Maybe OpenGate` inputs using the `maybeM` combinator. + +maybeGate :: BaseMachine SwitchTopology (Maybe OpenGate) (Maybe SwitchOutput) +maybeGate = maybeM gate' + +-- At this point we could conclude our composition, joining together `bothMachine` and `maybeGate` + +gateMachine :: StateMachine (Either SwitchInput SwitchInput) (Maybe SwitchOutput) +gateMachine = bothSwitches `Sequential` Basic maybeGate + +-- Now we have a single machine which describes out whole flow. + +-- Now, there are two things which we could do with `gateMachine`. + +-- The first thing is actually executing it. To do it we can use the `runMultiple` function. + +-- We can try to to turn on both switches and verify that the gate actually opened + +-- | +-- >>> openedGate +-- Just TurnedOn +openedGate :: Maybe SwitchOutput +openedGate = fst . runIdentity $ runMultiple gateMachine [Left TurnOn, Right TurnOn] + +-- Or we can turn just the first switch several times without opening the gate + +-- | +-- >>> closedGate +-- Nothing +closedGate :: Maybe SwitchOutput +closedGate = fst . runIdentity $ runMultiple gateMachine [Left TurnOn, Left TurnOn, Left TurnOn] + +-- The other thing we can do is actually rendering a diagram representing how the `gateMachine` works. + +-- The best rendering we can get displays the flow of the machine and the state space for every step of the flow + +-- | +-- >>> gateFlow +-- Right "state switch1 {\nswitch1_SwitchIsOn\nswitch1_SwitchIsOff\nswitch1_SwitchIsOff --> switch1_SwitchIsOn\n}\nstate switch2 {\nswitch2_SwitchIsOn\nswitch2_SwitchIsOff\nswitch2_SwitchIsOff --> switch2_SwitchIsOn\n}\nstate fork_choice_switch1switch2 <>\nstate join_choice_switch1switch2 <>\nfork_choice_switch1switch2 --> switch1\nfork_choice_switch1switch2 --> switch2\nswitch1 --> join_choice_switch1switch2\nswitch2 --> join_choice_switch1switch2\nstate both {\nboth_NoSwitchOn\nboth_OnlyFirstSwitchOn\nboth_OnlySecondSwitchOn\nboth_BothSwitchesOn\nboth_NoSwitchOn --> both_OnlyFirstSwitchOn\nboth_NoSwitchOn --> both_OnlySecondSwitchOn\nboth_OnlyFirstSwitchOn --> both_BothSwitchesOn\nboth_OnlySecondSwitchOn --> both_BothSwitchesOn\n}\njoin_choice_switch1switch2 --> both\nstate gate {\ngate_SwitchIsOn\ngate_SwitchIsOff\ngate_SwitchIsOff --> gate_SwitchIsOn\n}\nboth --> gate" +gateFlow :: Either String Mermaid +gateFlow = + (\(mermaid, _, _) -> mermaid) + <$> renderFlow + ( BinaryLabel + ( BinaryLabel + ( BinaryLabel + (LeafLabel . MachineLabel . pack $ "switch1") + (LeafLabel . MachineLabel . pack $ "switch2") + ) + (LeafLabel . MachineLabel . pack $ "both") + ) + (LeafLabel . MachineLabel . pack $ "gate") + ) + (gateMachine @Identity) + +-- The result is a diagram which looks like [this](https://mermaid.live/edit#pako:eNqNVN9vgjAQ_lfIPYORCgjE-LBsS_aw-eDbQkI6KMKU1kDd5oz_-0qhcwyr8tAf331333G99gAJSwmEUHPMyX2BVxUurQ8UUQkY9WfBk9w2DhE1xNdt46Wcn-oF1eBZpjUYljU_G-jYF0V9UaQRRTpRpBFF50UzVq3jJGdFQuIuO5XHbNbi87kiv7OC3kC-EPNPEW7kNWfSnUYD6lNQPHSdJ3_mjfFc1bpZxy-srZAqtAQXdLN_LKqaa2xLkjCanjHeiaGFSd0znGRkoldVdHyt8iDYyU-b1DCg3kn0zoVGUG6qzKtm6MrcrAf93AdVM_9HZdyBv0hFHqMyggklqUpcpOJuS9EIeE5KEkEolimu1hEIN8HbbVPh8JAWnFUQZnhTExPwjrPlniYQ8mpHFKl7H35ZW0xfGevtITzAF4RWYAfeaDwOpp7rIdeEPYROgEaub6PA95GY3KMJ39I7GE0dx5-4E9vxJv50LOhEpvPcvk3yiTr-AO8tobo) where you can clearly see the overall structure of the machine we created, and for every step of the flow the state space of the basic state machine governing that step. diff --git a/examples/Crem/Example/TwoSwitchesGate.lhs b/examples/Crem/Example/TwoSwitchesGate.lhs deleted file mode 100644 index 3b2e6bc..0000000 --- a/examples/Crem/Example/TwoSwitchesGate.lhs +++ /dev/null @@ -1,254 +0,0 @@ -> {-# LANGUAGE CPP #-} -> {-# LANGUAGE DataKinds #-} -> {-# LANGUAGE DerivingVia #-} -> {-# LANGUAGE TemplateHaskell #-} -> {-# LANGUAGE TypeFamilies #-} -> {-# LANGUAGE UndecidableInstances #-} -> -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies -> {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-} -> -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors -> {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} -> -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns -> {-# OPTIONS_GHC -Wno-unused-type-patterns #-} -> -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures -> -> #if __GLASGOW_HASKELL__ >= 908 -> -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-poly-kind-signatures -> {-# OPTIONS_GHC -Wno-missing-poly-kind-signatures #-} -> -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag-Wmissing-role-annotations -> {-# OPTIONS_GHC -Wno-missing-role-annotations #-} -> #endif -> -> module Crem.Example.TwoSwitchesGate where -> -> import "crem" Crem.BaseMachine -> import "crem" Crem.Render.Render -> import "crem" Crem.Render.RenderableVertices (AllVertices(..), RenderableVertices) -> import "crem" Crem.Render.RenderFlow -> import "crem" Crem.StateMachine -> import "crem" Crem.Topology -> import "base" Data.Functor.Identity -> import "profunctors" Data.Profunctor -> import "singletons-base" Data.Singletons.Base.TH -> import "text" Data.Text (pack) - -We would like to implement a gate opening mechanism controlled by two switches. We would like the gate to open only when the two switches are on. - -We would like to implement this by composing several small state machines: one for every switch, one for making sure that we actually receive the right message from both switches, and one for actually opening the gate. - -Let's start with the switch. - -The first thing we need to do is to define the topology of our machine, meaning the allowed transitions in its state space. - -For a switch, there are only two states. Either the switch is on or it is off. - -Moreover, we want those switches to be usable only once, and therefore we want to forbid the transition from the `on`` to the `off` position. In other terms, we allow only to go from the `off` position to the `on` position. - -> $( singletons -> [d| -> data SwitchVertex -> = SwitchIsOn -> | SwitchIsOff -> deriving stock (Eq, Show, Bounded, Enum) -> -> switchTopology :: Topology SwitchVertex -> switchTopology = Topology -> [(SwitchIsOff, [ SwitchIsOn ])] -> |] -> ) - -Notice that we need to wrap this in `singletons` because we will soon need to use this data type as a kind, to store information in the type of our state machines. - -We need also an instance of `RenderableVertices SwitchVertex` to decide which vertices to render for our machine. To obtain that, we use `deriving via` together with the `AllVertices` newtype. - -> deriving via AllVertices SwitchVertex instance RenderableVertices SwitchVertex - -Next we need to define which data every vertex of our topology should contain. To express that we use a generalized algebraid data type indexed with `SwitchVertex` - -> data SwitchState (vertex :: SwitchVertex) where -> OnState :: SwitchState 'SwitchIsOn -> OffState :: SwitchState 'SwitchIsOff -> -> type role SwitchState nominal - -In this case, for every vertex there is just one possible state. - -At this point we need to define which inputs our machine should handle and which outputs it should emit. In the case there is only one meaningful input, the request of turning on the switch, and one meaningful output, the notification that the switch has been turned on. - -> data SwitchInput = TurnOn -> -> data SwitchOutput = TurnedOn -> deriving stock Show -> -> instance Semigroup SwitchOutput where -> TurnedOn <> TurnedOn = TurnedOn - -At this point we can actually implement our switch as a `BaseMachine` - -> switch :: () -> BaseMachine SwitchTopology SwitchInput SwitchOutput -> switch _ = -> BaseMachineT -> { initialState = InitialState OffState -> , action = \case -> OnState -> \_ -> pureResult TurnedOn OnState -> OffState -> \_ -> pureResult TurnedOn OnState -> } - -We start from the `OffState` and every time we receive a request to turn the switch on, we return a message informing the external world that the switch in turned on and we update the state accordingly if needed. - -Since we need two separate switches, we can create them by invoking the `switch` function twice - -> switch1 :: BaseMachine SwitchTopology SwitchInput SwitchOutput -> switch1 = switch () -> -> switch2 :: BaseMachine SwitchTopology SwitchInput SwitchOutput -> switch2 = switch () - -This concludes the implementation of our switch machine. Next, we would like to implement a machine which receives as inputs the output of two switches and emits a message whenever both the switches have been turned on. - -Again, we need to start thinking about the topology of our machine. Since we need to track the state of the two switches, we will have four vertices - -> $( singletons -> [d| -> data BothVertex -> = NoSwitchOn -> | OnlyFirstSwitchOn -> | OnlySecondSwitchOn -> | BothSwitchesOn -> deriving (Eq, Show, Enum, Bounded) -> -> bothTopology :: Topology BothVertex -> bothTopology = Topology -> [ (NoSwitchOn, [OnlyFirstSwitchOn, OnlySecondSwitchOn]) -> , (OnlyFirstSwitchOn, [BothSwitchesOn]) -> , (OnlySecondSwitchOn, [BothSwitchesOn]) -> ] -> |] -> ) -> -> deriving via AllVertices BothVertex instance RenderableVertices BothVertex - -The topology again constrains the machine with the invariant the we can only turn on switches. - -Next we need to define the state space, assigning a data type to every vertex in the topology. In this case we don't have the need to attach data to our vertices so we can simply define - -> data BothState (vertex :: BothVertex) where -> NoSwitchOnState :: BothState 'NoSwitchOn -> OnlyFirstSwitchOnState :: BothState 'OnlyFirstSwitchOn -> OnlySecondSwitchOnState :: BothState 'OnlySecondSwitchOn -> BothSwitchesOnState :: BothState 'BothSwitchesOn - -Before defining the logic of the machine, we need to define its inputs and outputs. Since we would like it to monitor the outputs of both switches, its input type could be - -> type BothInput = Either SwitchOutput SwitchOutput - -Its output instead will be a potential message to actually open the gate - -> data OpenGate = OpenGate -> -> type BothOutput = Maybe OpenGate - -and eventually we can define the logic of our state machine - -> bothMachine :: BaseMachine BothTopology BothInput BothOutput -> bothMachine = -> BaseMachineT -> { initialState = InitialState NoSwitchOnState -> , action = \case -> NoSwitchOnState -> \case -> Left _ -> pureResult Nothing OnlyFirstSwitchOnState -> Right _ -> pureResult Nothing OnlySecondSwitchOnState -> OnlyFirstSwitchOnState -> \case -> Left _ -> pureResult Nothing OnlyFirstSwitchOnState -> Right _ -> pureResult (Just OpenGate) BothSwitchesOnState -> OnlySecondSwitchOnState -> \case -> Left _ -> pureResult (Just OpenGate) BothSwitchesOnState -> Right _ -> pureResult Nothing OnlySecondSwitchOnState -> BothSwitchesOnState -> \_ -> pureResult Nothing BothSwitchesOnState -> } - -The last machine that we need is one representing the actual gate. Since the logic is exactly the same as the one of the switches, we can actually reuse what we defined above - -> gate :: BaseMachine SwitchTopology SwitchInput SwitchOutput -> gate = switch () - -Now we have all the machines we wanted and we need to connect them appropriately. - -We have the two switches which produce a `SwitchOutput` and the `bothMachine` which accepts inputs of type `Either SwitchOutput SwitchOutput`. - -We need to pair up the two switches, first, and then connect them to the `bothMachine`. We need to pair the two switches in a way that allows us to decide whether to run one or the other: this is exactly what the `Alternative` constructor of the `StateMachineT` data type allows us to do. - -> switches :: StateMachine (Either SwitchInput SwitchInput) (Either SwitchOutput SwitchOutput) -> switches = Basic switch1 `Alternative` Basic switch2 - -Notice that we had to wrap our `switch` machines with `Basic` to turn them into `StateMachine`s, which is the more composable type used by `Alternative`. - -Now we have the output of `switches` which coincides with the input of `bothMachine`, and therefore we can pass every output we get from `switches` to `bothMachine`. We use the `Sequential` constractor exactly for this - -> bothSwitches :: StateMachine (Either SwitchInput SwitchInput) BothOutput -> bothSwitches = switches `Sequential` Basic bothMachine - -Now we have a machine which emits `BothOutput = Maybe OpenGate`. Our `gate` machine on the other hand accepts inputs of type `SwitchInput`. To connect those, we need to do some adjusting. - -First, we can translate an `OpenGate` into a `SwitchInput` - -> openGateToSwitchInput :: OpenGate -> SwitchInput -> openGateToSwitchInput OpenGate = TurnOn - -and we can use this function to adapt our `gate` machine so that it accepts `OpenGate` as input. - -> gate' :: BaseMachine SwitchTopology OpenGate SwitchOutput -> gate' = lmap openGateToSwitchInput gate - -Still `bothSwitches` emits values of type `Maybe OpenGate`. We could lift our `gate'` machine to `Maybe OpenGate` inputs using the `maybeM` combinator. - -> maybeGate :: BaseMachine SwitchTopology (Maybe OpenGate) (Maybe SwitchOutput) -> maybeGate = maybeM gate' - -At this point we could conclude our composition, joining together `bothMachine` and `maybeGate` - -> gateMachine :: StateMachine (Either SwitchInput SwitchInput) (Maybe SwitchOutput) -> gateMachine = bothSwitches `Sequential` Basic maybeGate - -Now we have a single machine which describes out whole flow. - -Now, there are two things which we could do with `gateMachine`. - -The first thing is actually executing it. To do it we can use the `runMultiple` function. - -We can try to to turn on both switches and verify that the gate actually opened - -> -- | -> -- >>> openedGate -> -- Just TurnedOn -> openedGate :: Maybe SwitchOutput -> openedGate = fst . runIdentity $ runMultiple gateMachine [Left TurnOn, Right TurnOn] - -Or we can turn just the first switch several times without opening the gate - -> -- | -> -- >>> closedGate -> -- Nothing -> closedGate :: Maybe SwitchOutput -> closedGate = fst . runIdentity $ runMultiple gateMachine [Left TurnOn, Left TurnOn, Left TurnOn] - -The other thing we can do is actually rendering a diagram representing how the `gateMachine` works. - -The best rendering we can get displays the flow of the machine and the state space for every step of the flow - -> -- | -> -- >>> gateFlow -> -- Right "state switch1 {\nswitch1_SwitchIsOn\nswitch1_SwitchIsOff\nswitch1_SwitchIsOff --> switch1_SwitchIsOn\n}\nstate switch2 {\nswitch2_SwitchIsOn\nswitch2_SwitchIsOff\nswitch2_SwitchIsOff --> switch2_SwitchIsOn\n}\nstate fork_choice_switch1switch2 <>\nstate join_choice_switch1switch2 <>\nfork_choice_switch1switch2 --> switch1\nfork_choice_switch1switch2 --> switch2\nswitch1 --> join_choice_switch1switch2\nswitch2 --> join_choice_switch1switch2\nstate both {\nboth_NoSwitchOn\nboth_OnlyFirstSwitchOn\nboth_OnlySecondSwitchOn\nboth_BothSwitchesOn\nboth_NoSwitchOn --> both_OnlyFirstSwitchOn\nboth_NoSwitchOn --> both_OnlySecondSwitchOn\nboth_OnlyFirstSwitchOn --> both_BothSwitchesOn\nboth_OnlySecondSwitchOn --> both_BothSwitchesOn\n}\njoin_choice_switch1switch2 --> both\nstate gate {\ngate_SwitchIsOn\ngate_SwitchIsOff\ngate_SwitchIsOff --> gate_SwitchIsOn\n}\nboth --> gate" -> gateFlow :: Either String Mermaid -> gateFlow = (\(mermaid, _, _) -> mermaid) <$> -> renderFlow -> (BinaryLabel -> (BinaryLabel -> (BinaryLabel -> (LeafLabel . MachineLabel . pack $ "switch1") -> (LeafLabel . MachineLabel . pack $ "switch2")) -> (LeafLabel . MachineLabel . pack $ "both")) -> (LeafLabel . MachineLabel . pack $ "gate")) -> (gateMachine @Identity) - -The result is a diagram which looks like [this](https://mermaid.live/edit#pako:eNqNVN9vgjAQ_lfIPYORCgjE-LBsS_aw-eDbQkI6KMKU1kDd5oz_-0qhcwyr8tAf331333G99gAJSwmEUHPMyX2BVxUurQ8UUQkY9WfBk9w2DhE1xNdt46Wcn-oF1eBZpjUYljU_G-jYF0V9UaQRRTpRpBFF50UzVq3jJGdFQuIuO5XHbNbi87kiv7OC3kC-EPNPEW7kNWfSnUYD6lNQPHSdJ3_mjfFc1bpZxy-srZAqtAQXdLN_LKqaa2xLkjCanjHeiaGFSd0znGRkoldVdHyt8iDYyU-b1DCg3kn0zoVGUG6qzKtm6MrcrAf93AdVM_9HZdyBv0hFHqMyggklqUpcpOJuS9EIeE5KEkEolimu1hEIN8HbbVPh8JAWnFUQZnhTExPwjrPlniYQ8mpHFKl7H35ZW0xfGevtITzAF4RWYAfeaDwOpp7rIdeEPYROgEaub6PA95GY3KMJ39I7GE0dx5-4E9vxJv50LOhEpvPcvk3yiTr-AO8tobo) where you can clearly see the overall structure of the machine we created, and for every step of the flow the state space of the basic state machine governing that step. diff --git a/flake.nix b/flake.nix index ffff68f..3f75f57 100644 --- a/flake.nix +++ b/flake.nix @@ -122,7 +122,6 @@ haskell-language-server build-watch test-watch - unlit ]; shellHook = '' export PS1="❄️ GHC ${haskellPackages.ghc.version} $PS1" From c5b58a98194ab7c30d6c2c490dc01c69c521599f Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Thu, 9 Apr 2026 23:00:11 +0200 Subject: [PATCH 12/16] import foldl' when needed --- src/Crem/Decider.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Crem/Decider.hs b/src/Crem/Decider.hs index 8a78259..5f0809f 100644 --- a/src/Crem/Decider.hs +++ b/src/Crem/Decider.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} -- | The [Decider pattern](https://thinkbeforecoding.com/post/2021/12/17/functional-event-sourcing-decider) @@ -10,6 +11,11 @@ module Crem.Decider where import Crem.BaseMachine (ActionResult (..), BaseMachine, BaseMachineT (..), InitialState (..)) import Crem.Topology (AllowedTransition, Topology) + +#if __GLASGOW_HASKELL__ < 910 +import "base" Data.Foldable (foldl') +#endif + import "base" Data.Kind (Type) -- | A @Decider topology input output@ is a Decider which receives inputs of From b7c76b707672eaf2e39238730f4dd822b6c1b925 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Fri, 10 Apr 2026 08:16:36 +0200 Subject: [PATCH 13/16] renounce literate Haskell decision log --- decision-log/2026-04-09-renounce-literate-haskell | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/decision-log/2026-04-09-renounce-literate-haskell b/decision-log/2026-04-09-renounce-literate-haskell index e69de29..0e80ea8 100644 --- a/decision-log/2026-04-09-renounce-literate-haskell +++ b/decision-log/2026-04-09-renounce-literate-haskell @@ -0,0 +1,12 @@ +name: renounce literate Haskell +date: 2026-04-09 +context: > + Currently we are using literate Haskell for one example where the comments take the most part of the file. + + This always created issues with `doctest-parallel` execution, since the library is not able to parse literate Haskell files. + + Moreover, lately we found that, when trying to use CPP conditionals inside a literate Haskell files, then it fails to compile. +decision: > + We decide to renounce literate Haskell, since it is creating more issues that the value it is providing +consequences: > + We `unlit` the literate Haskell file, and we turn it into a normal Haskell module with a lot of comments From ac3e7139108b75051c4bed2fbe5f6c3d75a2bd95 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Fri, 10 Apr 2026 08:18:01 +0200 Subject: [PATCH 14/16] restore sane package boundaries --- crem.cabal | 47 +++++------------------------------------------ package.yaml | 48 ++++++------------------------------------------ 2 files changed, 11 insertions(+), 84 deletions(-) diff --git a/crem.cabal b/crem.cabal index bf2d297..996c1b4 100644 --- a/crem.cabal +++ b/crem.cabal @@ -53,6 +53,11 @@ library ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-home-modules -Wno-missing-import-lists -Wno-all-missed-specialisations -Wno-prepositive-qualified-module build-depends: base >=4.15 && <4.21 + , machines >=0.7.3 && <0.8 + , nothunks >=0.1 && <0.4 + , profunctors >=3.2 && <5.7 + , singletons-base >=3.0 && <3.5 + , text >=1.2 && <2.2 default-language: Haskell2010 if impl(ghc >= 9.2) ghc-options: -Wno-missing-kind-signatures @@ -106,48 +111,6 @@ library TypeSynonymInstances if flag(errors) ghc-options: -Werror - if impl(ghc >= 9.10) - build-depends: - machines >=0.7.3 && <0.8 - , nothunks >=0.1 && <0.4 - , profunctors >=3.2 && <5.7 - , singletons-base ==3.4.* - , text >=1.2 && <2.2 - if impl(ghc >= 9.8) && impl(ghc < 9.10) - build-depends: - machines >=0.7.3 && <0.8 - , nothunks >=0.1 && <0.4 - , profunctors >=3.2 && <5.7 - , singletons-base ==3.3.* - , text >=1.2 && <2.2 - if impl(ghc >= 9.6) && impl(ghc < 9.8) - build-depends: - machines >=0.7.3 && <0.8 - , nothunks >=0.1 && <0.4 - , profunctors >=3.2 && <5.7 - , singletons-base ==3.2.* - , text >=1.2 && <2.2 - if impl(ghc >= 9.4) && impl(ghc < 9.6) - build-depends: - machines >=0.7.3 && <0.8 - , nothunks >=0.1 && <0.4 - , profunctors >=3.2 && <5.7 - , singletons-base >=3.1.1 && <3.2 - , text >=1.2 && <2.2 - if impl(ghc >= 9.2) && impl(ghc < 9.4) - build-depends: - machines >=0.7.3 && <0.8 - , nothunks >=0.1 && <0.4 - , profunctors >=3.2 && <5.7 - , singletons-base >=3.1 && <3.1.1 - , text >=1.2 && <2.2 - if impl(ghc >= 9.0) && impl(ghc < 9.2) - build-depends: - machines >=0.7.3 && <0.8 - , nothunks >=0.1 && <0.4 - , profunctors >=3.2 && <5.7 - , singletons-base ==3.0.* - , text >=1.2 && <2.2 library crem-examples exposed-modules: diff --git a/package.yaml b/package.yaml index dc41a73..55535e9 100644 --- a/package.yaml +++ b/package.yaml @@ -119,53 +119,17 @@ dependencies: library: source-dirs: src + dependencies: + - profunctors >= 3.2 && < 5.7 + - text >= 1.2 && < 2.2 + - nothunks >= 0.1 && < 0.4 + - machines >=0.7.3 && <0.8 + - singletons-base >= 3.0 && < 3.5 # Disable adding Paths_crem to other-modules, because it does not conform to our style guide. # https://github.com/sol/hpack#handling-of-paths_-modules when: - condition: false other-modules: Paths_crem - - condition: impl(ghc >= 9.10) - dependencies: - - profunctors >= 3.2 && < 5.7 - - text >= 1.2 && < 2.2 - - nothunks >= 0.1 && < 0.4 - - machines >=0.7.3 && <0.8 - - singletons-base >= 3.4 && < 3.5 - - condition: impl(ghc >= 9.8) && impl(ghc < 9.10) - dependencies: - - profunctors >= 3.2 && < 5.7 - - text >= 1.2 && < 2.2 - - nothunks >= 0.1 && < 0.4 - - machines >=0.7.3 && <0.8 - - singletons-base >= 3.3 && < 3.4 - - condition: impl(ghc >= 9.6) && impl(ghc < 9.8) - dependencies: - - profunctors >= 3.2 && < 5.7 - - text >= 1.2 && < 2.2 - - nothunks >= 0.1 && < 0.4 - - machines >=0.7.3 && <0.8 - - singletons-base >= 3.2 && < 3.3 - - condition: impl(ghc >= 9.4) && impl(ghc < 9.6) - dependencies: - - profunctors >= 3.2 && < 5.7 - - text >= 1.2 && < 2.2 - - nothunks >= 0.1 && < 0.4 - - machines >=0.7.3 && <0.8 - - singletons-base >= 3.1.1 && < 3.2 - - condition: impl(ghc >= 9.2) && impl(ghc < 9.4) - dependencies: - - profunctors >= 3.2 && < 5.7 - - text >= 1.2 && < 2.2 - - nothunks >= 0.1 && < 0.4 - - machines >=0.7.3 && <0.8 - - singletons-base >= 3.1 && < 3.1.1 - - condition: impl(ghc >= 9.0) && impl(ghc < 9.2) - dependencies: - - profunctors >= 3.2 && < 5.7 - - text >= 1.2 && < 2.2 - - nothunks >= 0.1 && < 0.4 - - machines >=0.7.3 && <0.8 - - singletons-base >= 3.0 && < 3.1 internal-libraries: crem-examples: From 40fa96fc59eba045ba33853490ccffe30ace10f5 Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Fri, 10 Apr 2026 08:29:35 +0200 Subject: [PATCH 15/16] reenable macos ci --- .github/workflows/ci.yml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index dee8460..0539144 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,9 +13,9 @@ jobs: build: strategy: matrix: - ghc: ['9.0.2', '9.2.8', '9.4.8', '9.6.7', '9.8.4', '9.10.3'] - cabal: ['3.10.2.0', '3.12.1.0', '3.14.2.0', '3.16.1.0'] - os: ['ubuntu-latest'] #, 'macos-latest'] + ghc: ['9.0.2'] #['9.0.2', '9.2.8', '9.4.8', '9.6.7', '9.8.4', '9.10.3'] + cabal: ['3.16.1.0'] #['3.10.2.0', '3.12.1.0', '3.14.2.0', '3.16.1.0'] + os: ['macos-latest'] #['ubuntu-latest', 'macos-latest'] runs-on: ${{ matrix.os }} name: platform ${{ matrix.os }} GHC ${{ matrix.ghc }} cabal ${{ matrix.cabal }} steps: @@ -36,6 +36,9 @@ jobs: key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- + - name: Setup upterm session + uses: owenthereal/action-upterm@v1 + - name: Build dependencies run: cabal build --only-dependencies @@ -49,7 +52,6 @@ jobs: run: cabal test --index-state HEAD - name: Test on oldest dependencies - if: matrix.cabal == '3.10.1.0' run: cabal test --prefer-oldest format: From 211cf8fe893c8c622f5fe75b385f3b9e717434fd Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Fri, 10 Apr 2026 09:19:28 +0200 Subject: [PATCH 16/16] remove macos machines from ci --- .github/workflows/ci.yml | 9 +++------ ...2026-04-09-renounce-literate-haskell.yaml} | 0 .../2026-04-10-remove-macos-from-ci.yaml | 19 +++++++++++++++++++ 3 files changed, 22 insertions(+), 6 deletions(-) rename decision-log/{2026-04-09-renounce-literate-haskell => 2026-04-09-renounce-literate-haskell.yaml} (100%) create mode 100644 decision-log/2026-04-10-remove-macos-from-ci.yaml diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0539144..5bb99de 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,9 +13,9 @@ jobs: build: strategy: matrix: - ghc: ['9.0.2'] #['9.0.2', '9.2.8', '9.4.8', '9.6.7', '9.8.4', '9.10.3'] - cabal: ['3.16.1.0'] #['3.10.2.0', '3.12.1.0', '3.14.2.0', '3.16.1.0'] - os: ['macos-latest'] #['ubuntu-latest', 'macos-latest'] + ghc: ['9.0.2', '9.2.8', '9.4.8', '9.6.7', '9.8.4', '9.10.3'] + cabal: ['3.10.2.0', '3.12.1.0', '3.14.2.0', '3.16.1.0'] + os: ['ubuntu-latest'] runs-on: ${{ matrix.os }} name: platform ${{ matrix.os }} GHC ${{ matrix.ghc }} cabal ${{ matrix.cabal }} steps: @@ -36,9 +36,6 @@ jobs: key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- - - name: Setup upterm session - uses: owenthereal/action-upterm@v1 - - name: Build dependencies run: cabal build --only-dependencies diff --git a/decision-log/2026-04-09-renounce-literate-haskell b/decision-log/2026-04-09-renounce-literate-haskell.yaml similarity index 100% rename from decision-log/2026-04-09-renounce-literate-haskell rename to decision-log/2026-04-09-renounce-literate-haskell.yaml diff --git a/decision-log/2026-04-10-remove-macos-from-ci.yaml b/decision-log/2026-04-10-remove-macos-from-ci.yaml new file mode 100644 index 0000000..08b3acb --- /dev/null +++ b/decision-log/2026-04-10-remove-macos-from-ci.yaml @@ -0,0 +1,19 @@ +name: remove macos from ci +date: 2026-04-10 +context: > + With the support for GHC 9.10 and newer cabal versions, we stumbled into an issue with respect to builds with `macos` machines. + + The issue present itself as follows, during `cabal build`: + + ``` + : error: + Warning: Couldn't figure out LLVM version! + Make sure you have installed LLVM between [9 and 13) + ghc-9.0.2: could not execute: opt + ``` + + I tried applying the suggestions frm https://discourse.haskell.org/t/cabal-and-llvm-issue/3672 but was not able to solve the issue. +decision: > + For the moment the decision is to remove `macos` machines from CI and hide the issue under the carpet. +consequences: > + I will create an issue about this if someone more knowledgeable than me wants to fix this.