Fourmolu

.github/workflows/haskell-ci.yml

@@ -23,6 +23,18 @@ concurrency:
   cancel-in-progress: true
 
 jobs:
+  check-formatting:
+    name: Check formatting
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+      - name: install fourmolu
+        run: |
+          wget https://github.com/fourmolu/fourmolu/releases/download/v0.17.0.0/fourmolu-0.17.0.0-linux-x86_64
+          chmod +x fourmolu-0.17.0.0-linux-x86_64
+          mv fourmolu-0.17.0.0-linux-x86_64 fourmolu
+      - run: ./fourmolu -c .
+
   test-with-cabal:
     name: Haskell-CI - Linux - ${{ matrix.ghc-version }}
 

bench/Constrained/Bench.hs

@@ -10,11 +10,10 @@
 module Constrained.Bench where
 
 import Constrained.API
-import Constrained.Generation
-import Constrained.Examples.Set
-import Constrained.Examples.Map
 import Constrained.Examples.Basic
-
+import Constrained.Examples.Map
+import Constrained.Examples.Set
+import Constrained.Generation
 import Control.DeepSeq
 import Criterion
 import Data.Map (Map)

examples/Constrained/Examples/Basic.hs

@@ -346,23 +346,24 @@ manyInconsistentTrans = constrained' $ \ [var| a |] [var| b |] c d e [var| f |]
 
 complicatedEither :: Specification (Either Int Int, (Either Int Int, Int, Int))
 complicatedEither = constrained' $ \ [var| i |] [var| t |] ->
-  [ caseOn i
-      (branch $ \ a -> a `elem_` lit [1..10])
-      (branch $ \ b -> b `elem_` lit [1..10])
+  [ caseOn
+      i
+      (branch $ \a -> a `elem_` lit [1 .. 10])
+      (branch $ \b -> b `elem_` lit [1 .. 10])
   , match t $ \ [var| k |] _ _ ->
-    [ k ==. i
-    , not_ $ k `elem_` lit [ Left j | j <- [1..9] ]
-    ]
+      [ k ==. i
+      , not_ $ k `elem_` lit [Left j | j <- [1 .. 9]]
+      ]
   ]
 
 pairCant :: Specification (Int, (Int, Int))
 pairCant = constrained' $ \ [var| i |] [var| p |] ->
-  [ assert $ i `elem_` lit [1..10]
+  [ assert $ i `elem_` lit [1 .. 10]
   , match p $ \ [var| k |] _ ->
-    [ k ==. i
-    , not_ $ k `elem_` lit [1..9]
-    ]
+      [ k ==. i
+      , not_ $ k `elem_` lit [1 .. 9]
+      ]
   ]
 
 signumPositive :: Specification Rational
-signumPositive = constrained $ \ x -> signum (x * 30) >=. 1
+signumPositive = constrained $ \x -> signum (x * 30) >=. 1

examples/Constrained/Examples/Fold.hs

@@ -36,10 +36,10 @@ evenSpec = explainSpec ["even via (x+x)"] $
       (\ [var|somey|] -> [assert $ evenx ==. somey + somey])
 
 composeEvenSpec :: Specification Int
-composeEvenSpec = constrained $ \ x -> [satisfies x evenSpec, assert $ x >. 10]
+composeEvenSpec = constrained $ \x -> [satisfies x evenSpec, assert $ x >. 10]
 
 composeOddSpec :: Specification Int
-composeOddSpec = constrained $ \ x -> [satisfies x oddSpec, assert $ x >. 10]
+composeOddSpec = constrained $ \x -> [satisfies x oddSpec, assert $ x >. 10]
 
 sum3WithLength :: Integer -> Specification ([Int], Int, Int, Int)
 sum3WithLength n =

examples/Constrained/Examples/Map.hs

@@ -128,24 +128,27 @@ mapIsJust = constrained' $ \ [var| x |] [var| y |] ->
 
 eitherKeys :: Specification ([Int], [Int], Map (Either Int Int) Int)
 eitherKeys = constrained' $ \ [var| as |] [var| bs |] [var| m |] ->
-  [
-    forAll' m $ \ [var| k |] _v ->
-      [ caseOn k
-          (branch $ \ a -> a `elem_` as)
-          (branch $ \ b -> b `elem_` bs)
-      , reify as (map Left) $ \ ls ->
-        reify bs (map Right) $ \ rs ->
-          k `elem_` ls ++. rs
+  [ forAll' m $ \ [var| k |] _v ->
+      [ caseOn
+          k
+          (branch $ \a -> a `elem_` as)
+          (branch $ \b -> b `elem_` bs)
+      , reify as (map Left) $ \ls ->
+          reify bs (map Right) $ \rs ->
+            k `elem_` ls ++. rs
       ]
   ]
 
 keysExample :: Specification (Either Int Int)
-keysExample = constrained $ \ k ->
-  [ caseOn k
-      (branch $ \ a -> a `elem_` as)
-      (branch $ \ b -> b `elem_` bs)
-  , reify as (map Left) $ \ ls ->
-    reify bs (map Right) $ \ rs ->
-      k `elem_` ls ++. rs
-  ] where as = lit [ 1 .. 10]
-          bs = lit [ 11 .. 20 ]
+keysExample = constrained $ \k ->
+  [ caseOn
+      k
+      (branch $ \a -> a `elem_` as)
+      (branch $ \b -> b `elem_` bs)
+  , reify as (map Left) $ \ls ->
+      reify bs (map Right) $ \rs ->
+        k `elem_` ls ++. rs
+  ]
+  where
+    as = lit [1 .. 10]
+    bs = lit [11 .. 20]

fourmolu.yaml

@@ -0,0 +1,16 @@
+indentation: 2
+function-arrows: trailing
+comma-style: leading
+import-export-style: diff-friendly
+indent-wheres: true
+record-brace-space: true
+newlines-between-decls: 1
+haddock-style: single-line
+haddock-style-module:
+let-style: auto
+in-style: right-align
+unicode: never
+respectful: false
+fixities: []
+single-constraint-parens: never
+column-limit: 100

scripts/fourmolize.sh

@@ -0,0 +1 @@
+fourmolu -i .

src/Constrained/Base.hs

@@ -32,7 +32,7 @@ module Constrained.Base (
   pattern (:<:),
   pattern (:>:),
   pattern Unary,
-  Ctx(..),
+  Ctx (..),
   toCtx,
   flipCtx,
   fromListCtx,
@@ -675,7 +675,7 @@ instance Show (BaseW d r) where
   show ToGenericW = "toSimpleRep"
   show FromGenericW = "fromSimpleRep"
 
-instance Syntax BaseW where
+instance Syntax BaseW
 
 instance Semantics BaseW where
   semantics FromGenericW = fromSimpleRep

src/Constrained/Conformance.hs

@@ -31,9 +31,9 @@ import Constrained.Syntax
 import Data.List (intersect, nub)
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe
+import Data.Semigroup (sconcat)
 import Data.Set (Set)
 import Data.Set qualified as Set
-import Data.Semigroup (sconcat)
 import Prettyprinter hiding (cat)
 import Test.QuickCheck (Property, Testable, property)
 

src/Constrained/Env.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE ImpredicativeTypes #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE ImpredicativeTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
@@ -76,7 +76,7 @@ find env var = do
 -- | Filter the keys in an env, useful for removing irrelevant variables in
 -- error messages
 filterKeys :: Env -> (forall a. Typeable a => Var a -> Bool) -> Env
-filterKeys (Env m) f = Env $ Map.filterWithKey (\ (EnvKey k) _ -> f k) m
+filterKeys (Env m) f = Env $ Map.filterWithKey (\(EnvKey k) _ -> f k) m
 
 instance Pretty EnvValue where
   pretty (EnvValue x) = viaShow x

src/Constrained/GenT.hs

@@ -60,7 +60,9 @@ module Constrained.GenT (
   listFromGE,
 ) where
 
+import Control.Arrow (second)
 import Control.Monad
+import Control.Monad.Trans
 import Data.Foldable
 import Data.List.NonEmpty (NonEmpty ((:|)), (<|))
 import Data.List.NonEmpty qualified as NE
@@ -70,8 +72,6 @@ import System.Random
 import Test.QuickCheck hiding (Args, Fun)
 import Test.QuickCheck.Gen
 import Test.QuickCheck.Random
-import Control.Arrow (second)
-import Control.Monad.Trans
 
 -- ==============================================================
 -- The GE Monad
@@ -127,27 +127,27 @@ runThreadingGen g = MkGen $ \seed size -> do
   snd <$> unThreadingGen g seed size
 
 strictGetSize :: Applicative m => ThreadingGenT m Int
-strictGetSize = ThreadingGen $ \ seed size -> pure (seed, size)
+strictGetSize = ThreadingGen $ \seed size -> pure (seed, size)
 
 scaleThreading :: (Int -> Int) -> ThreadingGenT m a -> ThreadingGenT m a
-scaleThreading f sg = ThreadingGen $ \ seed size -> unThreadingGen sg seed (f size)
+scaleThreading f sg = ThreadingGen $ \seed size -> unThreadingGen sg seed (f size)
 
-newtype ThreadingGenT m a = ThreadingGen { unThreadingGen :: QCGen -> Int -> m (QCGen, a) }
+newtype ThreadingGenT m a = ThreadingGen {unThreadingGen :: QCGen -> Int -> m (QCGen, a)}
 
 instance Functor m => Functor (ThreadingGenT m) where
-  fmap f (ThreadingGen g) = ThreadingGen $ \ seed size -> second f <$> g seed size
+  fmap f (ThreadingGen g) = ThreadingGen $ \seed size -> second f <$> g seed size
 
 instance Monad m => Applicative (ThreadingGenT m) where
-  pure a = ThreadingGen $ \ seed _ -> pure (seed, a)
+  pure a = ThreadingGen $ \seed _ -> pure (seed, a)
   (<*>) = ap
 
 instance Monad m => Monad (ThreadingGenT m) where
-  ThreadingGen g >>= k = ThreadingGen $ \ seed size -> do
+  ThreadingGen g >>= k = ThreadingGen $ \seed size -> do
     (seed', a) <- g seed size
     unThreadingGen (k a) seed' size
 
 instance MonadTrans ThreadingGenT where
-  lift m = ThreadingGen $ \ seed _ -> (seed,) <$> m
+  lift m = ThreadingGen $ \seed _ -> (seed,) <$> m
 
 ------------------------------------------------------------------------
 -- The GenT monad
@@ -233,7 +233,7 @@ instance MonadGenError m => MonadGenError (GenT m) where
   fatalErrors es = GenT $ \_ xs -> lift $ fatalErrors (cat es xs)
 
   -- Perhaps we want to turn fatalError into genError, if mode_ is Loose?
-  explainNE e (GenT f) = GenT $ \mode es -> ThreadingGen $ \ seed size -> explainNE e $ unThreadingGen (f mode es) seed size
+  explainNE e (GenT f) = GenT $ \mode es -> ThreadingGen $ \seed size -> explainNE e $ unThreadingGen (f mode es) seed size
 
 -- ====================================================
 -- useful operations on NonEmpty
@@ -454,7 +454,7 @@ sizeT = GenT $ \_ _ -> strictGetSize
 
 -- | Always succeeds, but returns the internal GE structure for analysis
 inspect :: forall m a. MonadGenError m => GenT GE a -> GenT m (GE a)
-inspect (GenT f) = GenT $ \ mode msgs -> liftGenToThreading $ runThreadingGen $ f mode msgs
+inspect (GenT f) = GenT $ \mode msgs -> liftGenToThreading $ runThreadingGen $ f mode msgs
 
 -- | Ignore all kinds of Errors, by squashing them into Nothing
 tryGenT :: MonadGenError m => GenT GE a -> GenT m (Maybe a)