Merge pull request #1 from distrap/ci

GHC9 support and CI

.github/workflows/ci.yaml

@@ -0,0 +1,46 @@
+jobs:
+  build:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: "actions/checkout@v3"
+      - id: setup-haskell-cabal
+        uses: "haskell/actions/setup@v2"
+        with:
+          cabal-version: "${{ matrix.cabal }}"
+          enable-stack: false
+          ghc-version: "${{ matrix.ghc }}"
+      - name: Update Hackage repository
+        run: cabal update
+      - name: cabal.project.local.ci
+        run: |
+          if [ -e cabal.project.local.ci ]; then
+            cp cabal.project.local.ci cabal.project.local
+          fi
+      - name: freeze
+        run: cabal freeze
+      - uses: "actions/cache@v3"
+        with:
+          key: "${{ runner.os }}-${{ matrix.ghc }}-cabal-${{ hashFiles('cabal.project.freeze') }}"
+          path: |
+            ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
+            dist-newstyle
+      - name: Install dependencies
+        run: cabal build all --enable-tests --enable-benchmarks --only-dependencies
+      - name: build all
+        run: cabal build all --enable-tests --enable-benchmarks
+      - name: test all
+        run: cabal test all --enable-tests
+      - name: haddock all
+        run: cabal haddock all 
+    strategy:
+      matrix:
+        cabal:
+          - '3.6'
+        ghc:
+          - '8.10.7'
+          - '9.0.2'
+          - '9.2.4'
+name: Haskell CI
+on:
+  - push
+  - pull_request

cabal.project

@@ -0,0 +1,23 @@
+packages:
+  tower
+  tower-aadl
+  tower-config
+  tower-hal
+  tower-mini
+
+source-repository-package
+  type: git
+  location: https://github.com/distrap/ivory
+  tag: e5e316c79998abe62bfd6d2e9f9bcfd311593948
+  subdir:
+    ivory
+    ivory-artifact
+    ivory-backend-c
+    ivory-eval
+    ivory-hw
+    ivory-model-check
+    ivory-opts
+    ivory-quickcheck
+    ivory-serialize
+    ivory-stdlib
+    ivory-tasty

ci.dhall

@@ -0,0 +1,15 @@
+let haskellCi =
+      https://raw.githubusercontent.com/sorki/github-actions-dhall/pending/haskell-ci.dhall
+
+in    haskellCi.generalCi
+        haskellCi.matrixSteps
+        ( Some
+            { ghc =
+              [ haskellCi.GHC.GHC8107
+              , haskellCi.GHC.GHC902
+              , haskellCi.GHC.GHC924
+              ]
+            , cabal = [ haskellCi.Cabal.Cabal36 ]
+            }
+        )
+    : haskellCi.CI.Type

ci.sh

@@ -0,0 +1,13 @@
+#!/usr/bin/env bash
+# Script by @fisx
+
+set -eo pipefail
+cd "$( dirname "${BASH_SOURCE[0]}" )"
+
+echo "regenerating .github/workflows/ci.yaml..."
+
+mkdir -p .github/workflows
+
+# based on https://github.com/vmchale/github-actions-dhall
+which dhall-to-yaml || cabal install dhall-yaml
+dhall-to-yaml --file ci.dhall > .github/workflows/ci.yaml

tower-aadl/src/Tower/AADL/AST/Common.hs

@@ -39,12 +39,14 @@ data ThdIds = ThdIds
   , chanRxThds :: S.Set ThreadChans
   } deriving (Show, Eq)
 
-instance Monoid ThdIds where
-  mempty = ThdIds mempty mempty
-  c0 `mappend` c1 =
+instance Semigroup ThdIds where
+  (<>) c0 c1 =
     ThdIds (chanTxThds c0 `mappend` chanTxThds c1)
             (chanRxThds c0 `mappend` chanRxThds c1)
 
+instance Monoid ThdIds where
+  mempty = ThdIds mempty mempty
+
 getTxThds :: ThdIds -> [ThreadChans]
 getTxThds = S.toList . chanTxThds
 

tower-aadl/src/Tower/AADL/CodeGen.hs

@@ -40,10 +40,10 @@ data AADLBackend = AADLBackend
 instance TowerBackend AADLBackend where
   newtype TowerBackendCallback AADLBackend a
     = AADLCallback I.ModuleDef
-    deriving Monoid
+    deriving (Monoid, Semigroup)
   data    TowerBackendEmitter  AADLBackend    = AADLEmitter (String -> I.ModuleDef)
   newtype TowerBackendHandler  AADLBackend  a = AADLHandler (String -> I.ModuleDef)
-   deriving Monoid
+   deriving (Monoid, Semigroup)
   -- Takes a ModuleDef (containing the emitter declaration) and returns the
   -- monitor module name and monitor module.
   data TowerBackendMonitor     AADLBackend

tower-aadl/src/Tower/AADL/Threads.hs

@@ -44,9 +44,11 @@ data HasInit = NoInit | HasInit deriving (Show, Read, Eq, Ord)
 
 instance Monoid HasInit where
   mempty                    = NoInit
-  HasInit `mappend` _       = HasInit
-  _       `mappend` HasInit = HasInit
-  _       `mappend` _       = NoInit
+
+instance Semigroup HasInit where
+  HasInit <> _       = HasInit
+  _       <> HasInit = HasInit
+  _       <> _       = NoInit
 
 -- Intermediate data types that collect Tower elements into groups that are
 -- meaningful for AADL (notably, distinguishing active and passive threads).
@@ -66,12 +68,16 @@ data PassiveThreads = PassiveThreads
 
 instance Monoid ActiveThreads where
   mempty = ActiveThreads mempty [] [] [] [] []
-  ActiveThreads a0 b0 c0 d0 e0 f0 `mappend` ActiveThreads a1 b1 c1 d1 e1 f1 =
+
+instance Semigroup ActiveThreads where
+  ActiveThreads a0 b0 c0 d0 e0 f0 <> ActiveThreads a1 b1 c1 d1 e1 f1 =
     ActiveThreads (a0 <> a1) (b0 <> b1) (c0 <> c1) (d0 <> d1) (e0 <> e1) (f0 <> f1)
 
 instance Monoid PassiveThreads where
   mempty = PassiveThreads []
-  PassiveThreads a0 `mappend` PassiveThreads a1 =
+
+instance Semigroup PassiveThreads where
+  PassiveThreads a0 <> PassiveThreads a1 =
     PassiveThreads (a0++a1)
 
 injectInitThread :: ActiveThreads

tower-mini/src/Tower/Mini.hs

@@ -201,7 +201,9 @@ mkMonitorName m = TAST.monitorName m ++ "_monitor"
 
 instance Monoid (TowerBackendOutput MiniBackend) where
     mempty = MiniOutput [] [] [] (const [])
-    mappend mo1 mo2 =
+
+instance Semigroup (TowerBackendOutput MiniBackend) where
+    (<>) mo1 mo2 =
       MiniOutput
         (outputInitCallbacks mo1   `mappend` outputInitCallbacks mo2)
         (outputPeriodCallbacks mo1 `mappend` outputPeriodCallbacks mo2)

tower/src/Ivory/Tower/Monad/Handler.hs

@@ -66,14 +66,14 @@ instance Functor (Handler area e) where
 
 instance Monad (Handler area e) where
   return x = Handler $ return x
-  Handler x >>= f = Handler $ x >>= (unHandler . f)
+  Handler x >>= f = Handler $ x >>= (\y -> unHandler $ f y)
 
 instance Applicative (Handler area e) where
   pure = return
   (<*>) = ap
 
 instance MonadFix (Handler area e) where
-  mfix f = Handler $ mfix (unHandler . f)
+  mfix f = Handler $ mfix (\x -> unHandler $ f x)
 
 newtype Handler' backend (area :: Area *) e a = Handler'
   { unHandler' :: ReaderT Unique

tower/src/Ivory/Tower/Monad/Monitor.hs

@@ -39,14 +39,14 @@ instance Functor (Monitor e) where
 
 instance Monad (Monitor e) where
   return x = Monitor $ return x
-  Monitor x >>= f = Monitor $ x >>= (unMonitor . f)
+  Monitor x >>= f = Monitor $ x >>= (\y -> unMonitor $ f y)
 
 instance Applicative (Monitor e) where
   pure = return
   (<*>) = ap
 
 instance MonadFix (Monitor e) where
-  mfix f = Monitor $ mfix (unMonitor . f)
+  mfix f = Monitor $ mfix (\x -> unMonitor $ f x)
 
 newtype Monitor' backend e a = Monitor'
   { unMonitor' :: WriterT ([AST.Handler], [SomeHandler backend], ModuleDef) (Tower' backend e) a

tower/src/Ivory/Tower/Monad/Tower.hs

@@ -43,14 +43,15 @@ instance Functor (Tower e) where
 
 instance Monad (Tower e) where
   return x = Tower $ return x
-  Tower x >>= f = Tower $ x >>= (unTower . f)
+  Tower x >>= f =
+    Tower $ x >>= (\y -> unTower $ f y)
 
 instance Applicative (Tower e) where
   pure = return
   (<*>) = ap
 
 instance MonadFix (Tower e) where
-  mfix f = Tower $ mfix (unTower . f)
+  mfix f = Tower $ mfix (\x -> unTower $ f x)
 
 instance MonadFail (Tower e) where
   fail = error