refactor: Generalised traverseAst to include mapAst.

This is done by teaching the type checker more about what the result of a
mapping looks like. This avoids some need for type annotations when using
this function.

.github/settings.yml

@@ -11,7 +11,7 @@ branches:
     protection:
       required_status_checks:
         contexts:
-          - "build"
+          - "build-cabal"
+          - "build-stack"
           - "cirrus-ci"
-          - "Codacy Static Code Analysis"
           - "code-review/reviewable"

.github/workflows/checks.yml

@@ -0,0 +1,28 @@
+# WARNING: Actions in this file can access repository secrets. They should never
+# execute code of the pull request. All scripts should be fetched from merged
+# TokTok code.
+name: checks
+
+on:
+  pull_request_target:
+    branches: [master]
+
+jobs:
+  check-release:
+    runs-on: ubuntu-latest
+
+    steps:
+      - uses: actions/checkout@v2
+        with:
+          ref: ${{ github.event.pull_request.head.sha }}
+      - name: Checkout TokTok/ci-tools
+        uses: actions/checkout@v2
+        with:
+          repository: TokTok/ci-tools
+          path: ci-tools
+
+      - name: Check version against GitHub releases
+        env:
+          GH_USER: ${{ secrets.GH_USER }}
+          GH_TOKEN: ${{ secrets.GH_TOKEN }}
+        run: $GITHUB_WORKSPACE/ci-tools/bin/check_release

.github/workflows/ci.yml

@@ -1,13 +1,11 @@
-name: Cabal Build
+name: ci
 
 on:
-  push:
-    branches: [master]
   pull_request:
     branches: [master]
 
 jobs:
-  build:
+  build-cabal:
     runs-on: ubuntu-latest
 
     steps:
@@ -18,42 +16,50 @@ jobs:
           cabal-version: "3.2"
 
       - name: Cache
-        uses: actions/cache@v1
+        uses: actions/cache@v2
         env:
           cache-name: cache-cabal
         with:
-          path: ~/.cabal
-          key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}
+          path: |
+            ~/.cabal/packages
+            ~/.cabal/store
+            dist-newstyle
+          key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}
           restore-keys: |
             ${{ runner.os }}-build-${{ env.cache-name }}-
             ${{ runner.os }}-build-
             ${{ runner.os }}-
-      - name: Install dependencies
-        run: |
-          if [ -f tools/prepare_third_party.sh ]; then tools/prepare_third_party.sh; fi
-          cabal update
-          cabal build --only-dependencies --enable-tests --enable-benchmarks --enable-doc all
-      - name: Build
-        run: cabal build --enable-tests --enable-benchmarks --enable-doc all
+
+      - name: Install non-Haskell dependencies
+        run: if [ -f tools/prepare_third_party.sh ]; then tools/prepare_third_party.sh; fi
       - name: Run tests
         run: cabal test --enable-doc all
-      - name: Build haddock documentation
-        run: cabal haddock --haddock-for-hackage --enable-doc
 
-      - name: Publish candidate to Hackage
-        if: ${{ github.event_name == 'push' }}
+  build-stack:
+    runs-on: ubuntu-latest
+
+    steps:
+      - uses: actions/checkout@v2
+      - uses: actions/setup-haskell@v1
+        with:
+          enable-stack: true
+          stack-version: "latest"
+
+      - name: Cache
+        uses: actions/cache@v2
         env:
-          API_TOKEN_HACKAGE: ${{ secrets.API_TOKEN_HACKAGE }}
-        run: |
-          PACKAGE=$(grep '^name:' *.cabal | awk '{print $2}')
-          VERSION=$(grep '^version:' *.cabal | awk '{print $2}')
-          cabal sdist
-          curl --header "Authorization: X-ApiKey $API_TOKEN_HACKAGE" \
-            -F "package=@dist-newstyle/sdist/$PACKAGE-$VERSION.tar.gz" \
-            "https://hackage.haskell.org/packages/candidates"
-          curl --header "Authorization: X-ApiKey $API_TOKEN_HACKAGE" \
-            -X PUT \
-            -H "Content-Type: application/x-tar" \
-            -H "Content-Encoding: gzip" \
-            --data-binary "@dist-newstyle/$PACKAGE-$VERSION-docs.tar.gz" \
-            "https://hackage.haskell.org/package/$PACKAGE-$VERSION/candidate/docs"
+          cache-name: cache-stack
+        with:
+          path: |
+            ~/.stack
+            .stack-work
+          key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}
+          restore-keys: |
+            ${{ runner.os }}-build-${{ env.cache-name }}-
+            ${{ runner.os }}-build-
+            ${{ runner.os }}-
+
+      - name: Install non-Haskell dependencies
+        run: if [ -f tools/prepare_third_party.sh ]; then tools/prepare_third_party.sh; fi
+      - name: Run tests
+        run: stack test

.github/workflows/publish.yml

@@ -0,0 +1,54 @@
+name: publish
+
+on:
+  push:
+    branches: [master]
+  release:
+    types: [released]
+
+jobs:
+  hackage:
+    runs-on: ubuntu-latest
+
+    steps:
+      - uses: actions/checkout@v2
+      - name: Checkout TokTok/ci-tools
+        uses: actions/checkout@v2
+        with:
+          repository: TokTok/ci-tools
+          path: ci-tools
+
+      - uses: actions/setup-haskell@v1
+        with:
+          ghc-version: "8.10.3"
+          cabal-version: "3.2"
+
+      - name: Cache
+        uses: actions/cache@v2
+        env:
+          cache-name: cache-cabal
+        with:
+          path: |
+            ~/.cabal/packages
+            ~/.cabal/store
+            dist-newstyle
+          key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}
+          restore-keys: |
+            ${{ runner.os }}-build-${{ env.cache-name }}-
+            ${{ runner.os }}-build-
+            ${{ runner.os }}-
+
+      - name: Build haddock documentation
+        run: cabal haddock --haddock-for-hackage --enable-doc
+
+      - name: Publish package candidate to Hackage
+        if: ${{ github.event_name == 'push' }}
+        env:
+          API_TOKEN_HACKAGE: ${{ secrets.API_TOKEN_HACKAGE }}
+        run: $GITHUB_WORKSPACE/ci-tools/bin/hackage_upload candidate
+
+      - name: Publish package to Hackage
+        if: ${{ github.event_name == 'release' }}
+        env:
+          API_TOKEN_HACKAGE: ${{ secrets.API_TOKEN_HACKAGE }}
+        run: $GITHUB_WORKSPACE/ci-tools/bin/hackage_upload

BUILD.bazel

@@ -5,7 +5,7 @@ load("//third_party/haskell/happy:build_defs.bzl", "happy_parser")
 load("//third_party/haskell/hspec-discover:build_defs.bzl", "hspec_test")
 load("//tools/project:build_defs.bzl", "project")
 
-project()
+project(custom_github = True)
 
 alex_lexer(
     name = "Lexer",

src/Language/Cimple/IO.hs

@@ -20,16 +20,16 @@ import qualified Language.Cimple.Parser          as Parser
 import           Language.Cimple.Program         (Program)
 import qualified Language.Cimple.Program         as Program
 import           Language.Cimple.TranslationUnit (TranslationUnit)
-import           Language.Cimple.TraverseAst     (TextActions, mapAst,
-                                                  textActions)
+import           Language.Cimple.TraverseAst     (TextActions, textActions,
+                                                  traverseAst)
 import qualified Language.Cimple.TreeParser      as TreeParser
 
 type StringNode = Node () (Lexeme String)
 type TextNode = Node () (Lexeme Text)
 
 toTextAst :: [StringNode] -> [TextNode]
 toTextAst stringAst =
-    evalState (mapAst cacheActions stringAst) Map.empty
+    evalState (traverseAst cacheActions stringAst) Map.empty
   where
     cacheActions :: TextActions (State (Map String Text)) () String Text
     cacheActions = textActions $ \s -> do

src/Language/Cimple/TraverseAst.hs

@@ -6,8 +6,9 @@
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE StrictData            #-}
+{-# LANGUAGE TypeFamilies          #-}
 module Language.Cimple.TraverseAst
-    ( mapAst, traverseAst
+    ( traverseAst
 
     , doFiles, doFile
     , doNodes, doNode
@@ -24,18 +25,20 @@ module Language.Cimple.TraverseAst
 import           Language.Cimple.AST   (Node (..))
 import           Language.Cimple.Lexer (Lexeme (..))
 
-class TraverseAst iattr oattr itext otext a b where
-    mapFileAst :: Applicative f => AstActions f iattr oattr itext otext -> FilePath -> a -> f b
-
-mapAst
-    :: (TraverseAst iattr oattr itext otext a b, Applicative f)
-    => AstActions f iattr oattr itext otext -> a -> f b
-mapAst = flip mapFileAst "<stdin>"
+class TraverseAst iattr oattr itext otext a where
+    type Mapped iattr oattr itext otext a
+    mapFileAst
+        :: Applicative f
+        => AstActions f iattr oattr itext otext
+        -> FilePath
+        -> a
+        -> f (Mapped iattr oattr itext otext a)
 
 traverseAst
-    :: (TraverseAst attr attr text text a a, Applicative f)
-    => AstActions f attr attr text text -> a -> f a
-traverseAst = mapAst
+    :: (TraverseAst iattr oattr itext otext    a, Applicative f)
+    => AstActions f iattr oattr itext otext -> a
+    -> f    (Mapped iattr oattr itext otext    a)
+traverseAst = flip mapFileAst "<stdin>"
 
 data AstActions f iattr oattr itext otext = AstActions
     { doFiles     :: [(FilePath, [Node iattr (Lexeme itext)])] -> f [(FilePath, [Node oattr (Lexeme otext)])] -> f [(FilePath, [Node oattr (Lexeme otext)])]
@@ -48,8 +51,10 @@ data AstActions f iattr oattr itext otext = AstActions
     , doAttr      :: FilePath ->       iattr                                                                  -> f                   oattr
     }
 
-instance TraverseAst iattr oattr itext otext        a         b
-      => TraverseAst iattr oattr itext otext (Maybe a) (Maybe b) where
+instance TraverseAst iattr oattr itext otext        a
+      => TraverseAst iattr oattr itext otext (Maybe a) where
+    type        Mapped iattr oattr itext otext (Maybe a)
+       = Maybe (Mapped iattr oattr itext otext        a)
     mapFileAst _       _           Nothing  = pure Nothing
     mapFileAst actions currentFile (Just x) = Just <$> mapFileAst actions currentFile x
 
@@ -82,34 +87,32 @@ identityActions :: Applicative f => AstActions f attr attr text text
 identityActions = astActions pure pure
 
 
-instance TraverseAst iattr oattr itext otext itext otext where
-    mapFileAst AstActions{..} = doText
-
-instance TraverseAst iattr oattr itext otext iattr oattr where
-    mapFileAst AstActions{..} = doAttr
-
-instance TraverseAst iattr oattr itext otext (Lexeme itext)
-                                             (Lexeme otext) where
+instance TraverseAst iattr oattr itext otext (Lexeme itext) where
+    type Mapped iattr oattr itext otext (Lexeme itext)
+                                      =  Lexeme otext
     mapFileAst :: forall f . Applicative f
                => AstActions f iattr oattr itext otext -> FilePath -> Lexeme itext -> f (Lexeme otext)
-    mapFileAst actions@AstActions{..} currentFile = doLexeme currentFile <*>
-        \(L p c s) -> L p c <$> recurse s
-      where
-        recurse :: TraverseAst iattr oattr itext otext a b => a -> f b
-        recurse = mapFileAst actions currentFile
+    mapFileAst AstActions{..} currentFile = doLexeme currentFile <*>
+        \(L p c s) -> L p c <$> doText currentFile s
 
-instance TraverseAst iattr oattr itext otext [Lexeme itext]
-                                             [Lexeme otext] where
+instance TraverseAst iattr oattr itext otext [Lexeme itext] where
+    type Mapped iattr oattr itext otext [Lexeme itext]
+                                      = [Lexeme otext]
     mapFileAst actions@AstActions{..} currentFile = doLexemes currentFile <*>
         traverse (mapFileAst actions currentFile)
 
-instance TraverseAst iattr oattr itext otext (Node iattr (Lexeme itext))
-                                             (Node oattr (Lexeme otext)) where
-    mapFileAst :: forall f . Applicative f
-               => AstActions f iattr oattr itext otext -> FilePath -> Node iattr (Lexeme itext) -> f (Node oattr (Lexeme otext))
+instance TraverseAst iattr oattr itext otext (Node iattr (Lexeme itext)) where
+    type Mapped iattr oattr itext otext (Node iattr (Lexeme itext))
+                                      =  Node oattr (Lexeme otext)
+    mapFileAst
+        :: forall f . Applicative f
+        => AstActions f iattr oattr itext otext
+        -> FilePath
+        ->    Node iattr (Lexeme itext)
+        -> f (Node oattr (Lexeme otext))
     mapFileAst actions@AstActions{..} currentFile = doNode currentFile <*> \case
         Attr attr node ->
-            Attr <$> recurse attr <*> recurse node
+            Attr <$> doAttr currentFile attr <*> recurse node
         PreprocInclude path ->
             PreprocInclude <$> recurse path
         PreprocDefine name ->
@@ -292,20 +295,23 @@ instance TraverseAst iattr oattr itext otext (Node iattr (Lexeme itext))
             ConstDefn scope <$> recurse ty <*> recurse name <*> recurse value
 
       where
-        recurse :: TraverseAst iattr oattr itext otext a b => a -> f b
+        recurse :: TraverseAst iattr oattr itext otext a => a -> f (Mapped iattr oattr itext otext a)
         recurse = mapFileAst actions currentFile
 
-instance TraverseAst iattr oattr itext otext [Node iattr (Lexeme itext)]
-                                             [Node oattr (Lexeme otext)] where
+instance TraverseAst iattr oattr itext otext [Node iattr (Lexeme itext)] where
+    type Mapped iattr oattr itext otext [Node iattr (Lexeme itext)]
+                                      = [Node oattr (Lexeme otext)]
     mapFileAst actions@AstActions{..} currentFile = doNodes currentFile <*>
         traverse (mapFileAst actions currentFile)
 
-instance TraverseAst iattr oattr itext otext (FilePath, [Node iattr (Lexeme itext)])
-                                             (FilePath, [Node oattr (Lexeme otext)]) where
+instance TraverseAst iattr oattr itext otext (FilePath, [Node iattr (Lexeme itext)]) where
+    type Mapped iattr oattr itext otext (FilePath, [Node iattr (Lexeme itext)])
+                                      = (FilePath, [Node oattr (Lexeme otext)])
     mapFileAst actions@AstActions{..} _ tu@(currentFile, _) = doFile <*>
         traverse (mapFileAst actions currentFile) $ tu
 
-instance TraverseAst iattr oattr itext otext [(FilePath, [Node iattr (Lexeme itext)])]
-                                             [(FilePath, [Node oattr (Lexeme otext)])] where
+instance TraverseAst iattr oattr itext otext [(FilePath, [Node iattr (Lexeme itext)])] where
+    type Mapped iattr oattr itext otext [(FilePath, [Node iattr (Lexeme itext)])]
+                                      = [(FilePath, [Node oattr (Lexeme otext)])]
     mapFileAst actions@AstActions{..} currentFile = doFiles <*>
         traverse (mapFileAst actions currentFile)

test/Language/CimpleSpec.hs

@@ -8,7 +8,7 @@ import           Test.Hspec         (Spec, describe, it, shouldBe)
 import           Language.Cimple    (AlexPosn (..), CommentStyle (..),
                                      Lexeme (..), LexemeClass (..),
                                      LiteralType (..), Node (..), Scope (..),
-                                     TextActions, mapAst, textActions)
+                                     TextActions, textActions, traverseAst)
 import           Language.Cimple.IO (parseText)
 
 
@@ -21,7 +21,7 @@ spec = do
                 actions = textActions (Just . Text.unpack)
             mapM (mapM (mapM (Just . Text.unpack))) ast
                 `shouldBe`
-                mapAst actions ast
+                traverseAst actions ast
 
     describe "C parsing" $ do
         it "should parse a simple function" $ do