format files before a commit

.github/workflows/ghc.yml

@@ -26,6 +26,15 @@ jobs:
       - name: 📥 Checkout repository
         uses: actions/checkout@v4
 
+      - uses: haskell-actions/run-fourmolu@v9
+        if: matrix.os == 'ubuntu-latest'
+        with:
+          version: "0.14.0.0"
+          pattern: |
+            eo-phi-normalizer/**/*.hs
+            !eo-phi-normalizer/src/Language/EO/Phi/Syntax/**/*.hs
+            !eo-phi-normalizer/Setup.hs
+
       - name: 🧰 Setup Stack
         # FIXME use freckle/stack-action@v4 when https://github.com/freckle/stack-action/pull/31 is merged
         uses: deemp/stack-action@main
@@ -42,7 +51,7 @@ jobs:
           java-version: 21
 
       - run: npm install -g [email protected]
-      
+
       - run: ./pipeline.sh
 
   haddock:

.pre-commit-config.yaml

@@ -0,0 +1,29 @@
+# adopted from https://github.com/fourmolu/fourmolu/blob/f3b49896d0e00fb33192c43bc40496b39f62dddb/.pre-commit-config.yaml
+
+# Copyright © 2018–2020 Tweag I/O, 2020-present Matt Parsons
+
+# All rights reserved.
+
+# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+
+#     Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+
+#     Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+
+#     Neither the name Tweag I/O nor the names of contributors may be used to endorse or promote products derived from this software without specific prior written permission.
+
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+repos:
+  - repo: local
+    hooks:
+      - id: fourmolu-format
+        name: Format Haskell (.hs) files
+        entry: scripts/run-fourmolu.sh --mode=inplace
+        language: system
+        files: '\.(hs|hs-boot)$'
+        exclude: |
+          (?x)^(
+            eo-phi-normalizer/src/Language/EO/Phi/Syntax/|
+            eo-phi-normalizer/Setup.hs
+          )

.vscode/settings.json

@@ -1,3 +1,4 @@
 {
-    "haskell.formattingProvider": "fourmolu"
+    "haskell.formattingProvider": "fourmolu",
+    "editor.formatOnSave": true
 }

README.md

@@ -67,3 +67,73 @@ To run (all) tests, simply use
 ```sh
 stack test
 ```
+
+## Contribute
+
+### pre-commit
+
+We use [pre-commit](https://pre-commit.com/) to ensure code quality.
+
+Collaborators **MUST** set them up before commiting any code to our repository.
+
+Otherwise, the triggered CI jobs will fail.
+
+#### Set up pre-commit
+
+1. Install [Python 3](https://www.python.org/downloads/) (e.g., Python 3.10).
+1. [Install pre-commit](https://pre-commit.com/#1-install-pre-commit).
+    - Alternatively, run `pip3 install`.
+1. [Install the git hook scripts](https://pre-commit.com/#3-install-the-git-hook-scripts).
+1. Install [fourmolu](https://github.com/fourmolu/fourmolu)
+
+    ```console
+    stack install fourmolu
+    ```
+
+    - You can remove `fourmolu` later (see [SO post](https://stackoverflow.com/a/38639959))
+
+#### pre-commit configs
+
+See [docs](https://pre-commit.com/#adding-pre-commit-plugins-to-your-project).
+
+See [.pre-commit-config.yaml](.pre-commit-config.yaml).
+
+You can run a specific hook (see [docs](https://pre-commit.com/#pre-commit-run)):
+
+```console
+pre-commit run -c .pre-commit-config.yaml fourmolu-format --all
+```
+
+#### pre-commit workflow
+
+- `pre-commit` runs before a commit (at the [pre-commit phase](https://git-scm.com/book/en/v2/Customizing-Git-Git-Hooks#_committing_workflow_hooks))
+  > The pre-commit hook is run first, before you even type in a commit message. It's used to inspect the snapshot that's about to be committed, to see if you've forgotten something, to make sure tests run, or to examine whatever you need to inspect in the code. Exiting non-zero from this hook aborts the commit ...
+
+- `pre-commit` stashes ([link](https://git-scm.com/docs/git-stash)) unstaged ([link](https://git-scm.com/book/en/v2/Getting-Started-What-is-Git%3F#_the_three_states)) files.
+
+    ```console
+    [WARNING] Unstaged files detected.
+    [INFO] Stashing unstaged files to /home/eyjafjallajokull/.cache/pre-commit/patch1705090051-437857.
+    ```
+
+- `pre-commit` runs hooks.
+- A hook may exit with an error, e.g.:
+
+    ```md
+    Format Haskell (.hs) files...............................................Failed
+    - hook id: fourmolu
+    - exit code: 102
+    - files were modified by this hook
+    ```
+
+  - In case of the [fourmolu](https://github.com/fourmolu/fourmolu) formatter,
+    it's assumed that formatting a formatted `Haskell` file doesn't modify it.
+    However, `pre-commit` runs the `fourmolu` hook and reports that it has modified some files.
+    This error won't allow you to commit.
+
+- `pre-commit` unstashes files.
+
+- You should stage all changes so that `pre-commit` does not complain.
+  - In case of `fourmolu`, stage the formatted code regions.
+
+- Now, you can commit.

eo-phi-normalizer/src/Language/EO/Phi/Normalize.hs

@@ -12,8 +12,8 @@ import Data.Maybe (fromMaybe)
 import Numeric (showHex)
 
 import Control.Monad (forM)
-import Language.EO.Phi.Syntax.Abs
 import Language.EO.Phi.Rules.Common (lookupBinding)
+import Language.EO.Phi.Syntax.Abs
 
 data Context = Context
   { globalObject :: [Binding]

eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs

@@ -1,9 +1,10 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
+
 module Language.EO.Phi.Rules.Common where
 
+import Control.Applicative (Alternative ((<|>)), asum)
 import Language.EO.Phi.Syntax.Abs
-import Control.Applicative (asum, Alternative ((<|>)))
 
 -- $setup
 -- >>> :set -XOverloadedStrings
@@ -24,25 +25,28 @@ applyOneRuleAtRoot ctx@Context{..} obj =
   ]
 
 withSubObject :: (Object -> [Object]) -> Object -> [Object]
-withSubObject f root = f root <|>
-  case root of
-    Formation bindings ->
-      Formation <$> withSubObjectBindings f bindings
-    Application obj bindings -> asum
-      [ Application <$> withSubObject f obj <*> pure bindings
-      , Application obj <$> withSubObjectBindings f bindings
-      ]
-    ObjectDispatch obj a -> ObjectDispatch <$> withSubObject f obj <*> pure a
-    GlobalDispatch{} -> []
-    ThisDispatch{} -> []
-    Termination -> []
+withSubObject f root =
+  f root
+    <|> case root of
+      Formation bindings ->
+        Formation <$> withSubObjectBindings f bindings
+      Application obj bindings ->
+        asum
+          [ Application <$> withSubObject f obj <*> pure bindings
+          , Application obj <$> withSubObjectBindings f bindings
+          ]
+      ObjectDispatch obj a -> ObjectDispatch <$> withSubObject f obj <*> pure a
+      GlobalDispatch{} -> []
+      ThisDispatch{} -> []
+      Termination -> []
 
 withSubObjectBindings :: (Object -> [Object]) -> [Binding] -> [[Binding]]
 withSubObjectBindings _ [] = []
-withSubObjectBindings f (b:bs) = asum
-  [ [ b' : bs  | b'  <- withSubObjectBinding  f b ]
-  , [ b  : bs' | bs' <- withSubObjectBindings f bs ]
-  ]
+withSubObjectBindings f (b : bs) =
+  asum
+    [ [b' : bs | b' <- withSubObjectBinding f b]
+    , [b : bs' | bs' <- withSubObjectBindings f bs]
+    ]
 
 withSubObjectBinding :: (Object -> [Object]) -> Binding -> [Binding]
 withSubObjectBinding f = \case
@@ -67,15 +71,17 @@ applyRules ctx obj
   | otherwise =
       [ obj''
       | obj' <- applyOneRule ctx obj
-      , obj'' <- applyRules ctx obj' ]
+      , obj'' <- applyRules ctx obj'
+      ]
 
 applyRulesChain :: Context -> Object -> [[Object]]
 applyRulesChain ctx obj
   | isNF ctx obj = [[obj]]
   | otherwise =
       [ obj : chain
       | obj' <- applyOneRule ctx obj
-      , chain <- applyRulesChain ctx obj' ]
+      , chain <- applyRulesChain ctx obj'
+      ]
 
 -- * Helpers
 

eo-phi-normalizer/src/Language/EO/Phi/Rules/PhiPaper.hs

@@ -11,19 +11,19 @@ import Language.EO.Phi.Rules.Common
 -- | Rule 1.
 rule1 :: Rule
 rule1 _ = \case
-    Formation bindings ->
-        let Program bindings' = normalize (Program bindings)
-         in Just (Formation bindings')
-    _ -> Nothing
+  Formation bindings ->
+    let Program bindings' = normalize (Program bindings)
+     in Just (Formation bindings')
+  _ -> Nothing
 
 -- | Rule 6.
 rule6 :: Rule
 rule6 ctx (ObjectDispatch (Formation bindings) a)
-    | Just obj <- lookupBinding a bindings = do
-        guard (isNF ctx obj)
-        return (Application obj [AlphaBinding Rho (Formation bindings')])
-  where
-    bindings' = filter (not . isDispatched) bindings
-    isDispatched (AlphaBinding a' _) = a == a'
-    isDispatched _ = False
-rule6 _ _ = Nothing
+  | Just obj <- lookupBinding a bindings = do
+      guard (isNF ctx obj)
+      return (Application obj [AlphaBinding Rho (Formation bindings')])
+ where
+  bindings' = filter (not . isDispatched) bindings
+  isDispatched (AlphaBinding a' _) = a == a'
+  isDispatched _ = False
+rule6 _ _ = Nothing

eo-phi-normalizer/src/Language/EO/Phi/Syntax.hs

@@ -1,5 +1,6 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
 {-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 module Language.EO.Phi.Syntax (
   module Language.EO.Phi.Syntax.Abs,
   parseObject,
@@ -8,11 +9,11 @@ module Language.EO.Phi.Syntax (
 ) where
 
 import Data.Char (isSpace)
+import Data.String (IsString (..))
 import Language.EO.Phi.Syntax.Abs
 import qualified Language.EO.Phi.Syntax.Abs as Phi
 import qualified Language.EO.Phi.Syntax.Par as Phi
 import qualified Language.EO.Phi.Syntax.Print as Phi
-import Data.String (IsString(..))
 
 instance IsString Phi.Object where
   fromString = unsafeParseObject

eo-phi-normalizer/test/Language/EO/PhiSpec.hs

@@ -22,12 +22,12 @@ applyRule rule = \case
 
 spec :: Spec
 spec = do
-  describe "Rules unit tests"
-    $ forM_ ([(1, rule1), (6, rule6)] :: [(Int, Rule)])
-    $ \(idx, rule) -> do
-      PhiTestGroup{..} <- runIO (filePhiTests [i|test/eo/phi/rule-#{idx}.yaml|])
-      describe title
-        $ forM_ tests
-        $ \PhiTest{..} ->
-          it name do
-            applyRule (rule (Context [])) input `shouldBe` Just normalized
+  describe "Rules unit tests" $
+    forM_ ([(1, rule1), (6, rule6)] :: [(Int, Rule)]) $
+      \(idx, rule) -> do
+        PhiTestGroup{..} <- runIO (filePhiTests [i|test/eo/phi/rule-#{idx}.yaml|])
+        describe title $
+          forM_ tests $
+            \PhiTest{..} ->
+              it name do
+                applyRule (rule (Context [])) input `shouldBe` Just normalized

fourmolu.yaml

@@ -44,7 +44,17 @@ unicode: never
 respectful: true
 
 # Fixity information for operators
-fixities: []
+# listed explicitly to ensure consistent formatting
+# between HLS and standalone versions of fourmolu
+# https://github.com/haskell/haskell-language-server/issues/3882
+fixities:
+  - infixr 9  .
+  - infixr 5  ++
+  - infixl 4  <$
+  - infixl 1  >>, >>=
+  - infixr 1  =<<
+  - infixr 0  $, $!
+  - infixl 4 <*>, <*, *>, <**>
 
 # Module reexports Fourmolu should know about
 reexports: []

requirements.txt

@@ -0,0 +1 @@
+pre-commit==3.6.0

scripts/run-fourmolu.sh

@@ -0,0 +1,41 @@
+#!/usr/bin/env bash
+#
+# Run fourmolu, assuming it's already been built.
+
+# adopted from https://github.com/fourmolu/fourmolu/blob/f3b49896d0e00fb33192c43bc40496b39f62dddb/.pre-commit-config.yaml
+
+# Copyright © 2018–2020 Tweag I/O, 2020-present Matt Parsons
+
+# All rights reserved.
+
+# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+
+#     Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+
+#     Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+
+#     Neither the name Tweag I/O nor the names of contributors may be used to endorse or promote products derived from this software without specific prior written permission.
+
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+set -eu -o pipefail
+
+if [[ -z "${BUILD_TYPE:-}" ]]; then
+    # naive detection of stack vs cabal
+    if [[ -d .stack-work ]]; then
+        BUILD_TYPE=stack
+    else
+        BUILD_TYPE=cabal
+    fi
+fi
+
+case "${BUILD_TYPE}" in
+    (stack) FOURMOLU='stack exec -- fourmolu' ;;
+    (cabal) FOURMOLU='cabal run -- fourmolu' ;;
+    (*)
+        echo "Unknown build type: ${BUILD_TYPE}" >&2
+        exit 1
+    ;;
+esac
+
+exec $FOURMOLU "$@"