Merge pull request #349 from geniusyield/formatter-auto-commit

ci(#348): add fourmolu check to CI

.github/workflows/haskell.yml

@@ -118,6 +118,7 @@ jobs:
           ${{ runner.os }}-build-${{ env.cache-name }}-
           ${{ runner.os }}-build-
           ${{ runner.os }}-
+
     - name: Install LIBSODIUM
       run: |
         git clone https://github.com/input-output-hk/libsodium
@@ -167,6 +168,10 @@ jobs:
       run: cabal build --only-dependencies --enable-tests --enable-benchmarks
     - name: Build all targets (cabal)
       run: cabal build --enable-tests --enable-benchmarks all
+    - name: Install fourmolu
+      run: cabal install fourmolu --overwrite-policy=always
+    - name: Run checks (fourmolu)
+      run: git ls-files -z '*.hs' | xargs -P 12 -0 fourmolu --mode check
     - name: Symlink cardano-node binaries
       run: cabal install --package-env=$(pwd) --overwrite-policy=always cardano-cli cardano-node
     - name: Run privnet tests

fourmolu.yaml

@@ -1,7 +1,9 @@
 indentation: 2
 comma-style: leading
 record-brace-space: true
-indent-wheres: true
+indent-wheres: false
 respectful: true
 haddock-style: multi-line
 newlines-between-decls: 1
+single-constraint-parens: never
+single-deriving-parens: never

src-plutustx/GeniusYield/OnChain/AStakeValidator.hs

@@ -1,31 +1,31 @@
 {-# LANGUAGE NoImplicitPrelude #-}
-{-|
+
+{- |
 Module      : GeniusYield.OnChain.AStakeValidator
 Copyright   : (c) 2023 GYELD GMBH
 License     : Apache 2.0
 Maintainer  : [email protected]
 Stability   : develop
-
 -}
-module GeniusYield.OnChain.AStakeValidator
-    ( mkAStakeValidator
-    ) where
+module GeniusYield.OnChain.AStakeValidator (
+  mkAStakeValidator,
+) where
 
-import           PlutusLedgerApi.V2
-import           PlutusTx.Prelude   as PlutusTx
+import PlutusLedgerApi.V2
+import PlutusTx.Prelude as PlutusTx
 
-{-# INLINABLE mkAStakeValidator #-}
+{-# INLINEABLE mkAStakeValidator #-}
 mkAStakeValidator :: Address -> BuiltinData -> BuiltinData -> ()
 mkAStakeValidator addr _ ctx' = case scriptContextPurpose ctx of
   Certifying _ -> ()
-  Rewarding _  -> if paidToAddress then () else error ()
-  _            -> error ()
-  where
-    ctx :: ScriptContext
-    ctx = unsafeFromBuiltinData ctx'
+  Rewarding _ -> if paidToAddress then () else error ()
+  _ -> error ()
+ where
+  ctx :: ScriptContext
+  ctx = unsafeFromBuiltinData ctx'
 
-    info :: TxInfo
-    info = scriptContextTxInfo ctx
+  info :: TxInfo
+  info = scriptContextTxInfo ctx
 
-    paidToAddress :: Bool
-    paidToAddress = any (\o -> txOutAddress o == addr) $ txInfoOutputs info
+  paidToAddress :: Bool
+  paidToAddress = any (\o -> txOutAddress o == addr) $ txInfoOutputs info

src-plutustx/GeniusYield/OnChain/AStakeValidator/Compiled.hs

@@ -1,25 +1,25 @@
-{-# LANGUAGE DataKinds       #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-|
+
+{- |
 Module      : GeniusYield.OnChain.AStakeValidator.Compiled
 Copyright   : (c) 2023 GYELD GMBH
 License     : Apache 2.0
 Maintainer  : [email protected]
 Stability   : develop
-
 -}
 module GeniusYield.OnChain.AStakeValidator.Compiled (
-    originalAStakeValidator,
+  originalAStakeValidator,
 ) where
 
-import           GeniusYield.OnChain.AStakeValidator
-import           PlutusCore.Version                  (plcVersion100)
-import qualified PlutusLedgerApi.V2
-import qualified PlutusTx
+import GeniusYield.OnChain.AStakeValidator
+import PlutusCore.Version (plcVersion100)
+import PlutusLedgerApi.V2 qualified
+import PlutusTx qualified
 
-originalAStakeValidator
-  :: PlutusLedgerApi.V2.Address
-  -> PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ())
+originalAStakeValidator ::
+  PlutusLedgerApi.V2.Address ->
+  PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ())
 originalAStakeValidator addr =
-    $$(PlutusTx.compile [|| mkAStakeValidator ||])
+  $$(PlutusTx.compile [||mkAStakeValidator||])
     `PlutusTx.unsafeApplyCode` PlutusTx.liftCode plcVersion100 addr

src-plutustx/GeniusYield/OnChain/Examples/ReadOracle.hs

@@ -1,35 +1,36 @@
 {-# LANGUAGE NoImplicitPrelude #-}
-{-|
+
+{- |
 Module      : GeniusYield.OnChain.Examples.ReadOracle
 Copyright   : (c) 2023 GYELD GMBH
 License     : Apache 2.0
 Maintainer  : [email protected]
 Stability   : develop
-
 -}
-module GeniusYield.OnChain.Examples.ReadOracle
-    ( mkReadOracleValidator
-    ) where
+module GeniusYield.OnChain.Examples.ReadOracle (
+  mkReadOracleValidator,
+) where
+
+import PlutusLedgerApi.V2
+import PlutusTx.Prelude as PlutusTx
 
-import           PlutusLedgerApi.V2
-import           PlutusTx.Prelude   as PlutusTx
+{-# INLINEABLE mkReadOracleValidator #-}
 
-{-# INLINABLE mkReadOracleValidator #-}
 -- | Fail if there are no reference inputs with input datums.
 mkReadOracleValidator :: BuiltinData -> BuiltinData -> BuiltinData -> ()
 mkReadOracleValidator _ _ ctx'
-    | any (hasOutputDatum . txOutDatum) refins = ()
-    | otherwise                                = error ()
-  where
-    ctx :: ScriptContext
-    ctx = unsafeFromBuiltinData ctx'
+  | any (hasOutputDatum . txOutDatum) refins = ()
+  | otherwise = error ()
+ where
+  ctx :: ScriptContext
+  ctx = unsafeFromBuiltinData ctx'
 
-    info :: TxInfo
-    info = scriptContextTxInfo ctx
+  info :: TxInfo
+  info = scriptContextTxInfo ctx
 
-    refins :: [TxOut]
-    refins = map txInInfoResolved (txInfoReferenceInputs info)
+  refins :: [TxOut]
+  refins = map txInInfoResolved (txInfoReferenceInputs info)
 
-    hasOutputDatum :: OutputDatum -> Bool
-    hasOutputDatum (OutputDatum _) = True
-    hasOutputDatum _               = False
+  hasOutputDatum :: OutputDatum -> Bool
+  hasOutputDatum (OutputDatum _) = True
+  hasOutputDatum _ = False

src-plutustx/GeniusYield/OnChain/Examples/ReadOracle/Compiled.hs

@@ -1,20 +1,20 @@
-{-# LANGUAGE DataKinds       #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-|
+
+{- |
 Module      : GeniusYield.OnChain.Examples.ReadOracle.Compiled
 Copyright   : (c) 2023 GYELD GMBH
 License     : Apache 2.0
 Maintainer  : [email protected]
 Stability   : develop
-
 -}
-module GeniusYield.OnChain.Examples.ReadOracle.Compiled
-    ( readOracleValidator
-    ) where
+module GeniusYield.OnChain.Examples.ReadOracle.Compiled (
+  readOracleValidator,
+) where
 
-import qualified PlutusTx
+import PlutusTx qualified
 
-import           GeniusYield.OnChain.Examples.ReadOracle
+import GeniusYield.OnChain.Examples.ReadOracle
 
 readOracleValidator :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ())
-readOracleValidator = $$(PlutusTx.compile [|| mkReadOracleValidator ||])
+readOracleValidator = $$(PlutusTx.compile [||mkReadOracleValidator||])

src-plutustx/GeniusYield/OnChain/TestToken.hs

@@ -1,39 +1,38 @@
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# OPTIONS -fno-strictness -fno-spec-constr -fno-specialise #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
-{-|
+{- |
 Module      : GeniusYield.OnChain.TestToken
 Copyright   : (c) 2023 GYELD GMBH
 License     : Apache 2.0
 Maintainer  : [email protected]
 Stability   : develop
-
 -}
 module GeniusYield.OnChain.TestToken (
-    mkTestTokenPolicy,
+  mkTestTokenPolicy,
 ) where
 
-import           PlutusLedgerApi.V1.Value (flattenValue)
-import           PlutusLedgerApi.V2
-import           PlutusTx.Prelude
+import PlutusLedgerApi.V1.Value (flattenValue)
+import PlutusLedgerApi.V2
+import PlutusTx.Prelude
 
-{-# INLINABLE mkTestTokenPolicy #-}
+{-# INLINEABLE mkTestTokenPolicy #-}
 mkTestTokenPolicy :: Integer -> TokenName -> TxOutRef -> BuiltinData -> BuiltinData -> ()
 mkTestTokenPolicy amt tn utxo _ ctx'
-    | hasn'tUTxO  = traceError "UTxO not consumed"
-    | tn /= tn'   = traceError "wrong token"
-    | amt /= amt' = traceError "wrong amount"
-    | otherwise   = ()
-  where
-    ctx :: ScriptContext
-    ctx = unsafeFromBuiltinData ctx'
+  | hasn'tUTxO = traceError "UTxO not consumed"
+  | tn /= tn' = traceError "wrong token"
+  | amt /= amt' = traceError "wrong amount"
+  | otherwise = ()
+ where
+  ctx :: ScriptContext
+  ctx = unsafeFromBuiltinData ctx'
 
-    info :: TxInfo
-    info = scriptContextTxInfo ctx
+  info :: TxInfo
+  info = scriptContextTxInfo ctx
 
-    [(_, tn', amt')] = flattenValue $ txInfoMint info
+  [(_, tn', amt')] = flattenValue $ txInfoMint info
 
-    hasn'tUTxO :: Bool
-    hasn'tUTxO = all (\i -> txInInfoOutRef i /= utxo) $ txInfoInputs info
+  hasn'tUTxO :: Bool
+  hasn'tUTxO = all (\i -> txInInfoOutRef i /= utxo) $ txInfoInputs info

src-plutustx/GeniusYield/OnChain/TestToken/Compiled.hs

@@ -1,29 +1,32 @@
-{-# LANGUAGE DataKinds       #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-|
+
+{- |
 Module      : GeniusYield.OnChain.TestToken.Compiled
 Copyright   : (c) 2023 GYELD GMBH
 License     : Apache 2.0
 Maintainer  : [email protected]
 Stability   : develop
-
 -}
 module GeniusYield.OnChain.TestToken.Compiled (
-    originalTestTokenPolicy,
+  originalTestTokenPolicy,
 ) where
 
-import           GeniusYield.OnChain.TestToken
-import qualified PlutusLedgerApi.V2
-import qualified PlutusTx
+import GeniusYield.OnChain.TestToken
 import PlutusCore.Version (plcVersion100)
+import PlutusLedgerApi.V2 qualified
+import PlutusTx qualified
 
-originalTestTokenPolicy
-  :: Integer                       -- ^ Count.
-  -> PlutusLedgerApi.V2.TokenName  -- ^ Token name (e.g. @GOLD@).
-  -> PlutusLedgerApi.V2.TxOutRef   -- ^ UTxO to base token on.
-  -> PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ())
+originalTestTokenPolicy ::
+  -- | Count.
+  Integer ->
+  -- | Token name (e.g. @GOLD@).
+  PlutusLedgerApi.V2.TokenName ->
+  -- | UTxO to base token on.
+  PlutusLedgerApi.V2.TxOutRef ->
+  PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ())
 originalTestTokenPolicy count tn utxo =
-    $$(PlutusTx.compile [|| mkTestTokenPolicy ||])
+  $$(PlutusTx.compile [||mkTestTokenPolicy||])
     `PlutusTx.unsafeApplyCode` PlutusTx.liftCode plcVersion100 count
     `PlutusTx.unsafeApplyCode` PlutusTx.liftCode plcVersion100 tn
     `PlutusTx.unsafeApplyCode` PlutusTx.liftCode plcVersion100 utxo

src/GeniusYield/Api/TestTokens.hs

@@ -1,33 +1,35 @@
 -- TODO (simplify-genesis): Remove this module once user creation has been removed from test setup.
 -- See note: 'simplify-genesis'.
-{-|
+
+{- |
 Module      : GeniusYield.Api.TestTokens
 Copyright   : (c) 2023 GYELD GMBH
 License     : Apache 2.0
 Maintainer  : [email protected]
 Stability   : develop
-
 -}
 module GeniusYield.Api.TestTokens (
-    mintTestTokens,
+  mintTestTokens,
 ) where
 
-import           GeniusYield.Scripts.TestToken
-import           GeniusYield.TxBuilder
-import           GeniusYield.Types
+import GeniusYield.Scripts.TestToken
+import GeniusYield.TxBuilder
+import GeniusYield.Types
 
-mintTestTokens :: GYTxUserQueryMonad m
-               => GYTokenName
-               -> Natural
-               -> m (GYAssetClass, GYTxSkeleton 'PlutusV2)
+mintTestTokens ::
+  GYTxUserQueryMonad m =>
+  GYTokenName ->
+  Natural ->
+  m (GYAssetClass, GYTxSkeleton 'PlutusV2)
 mintTestTokens tn amt = do
-    -- utxo to base token of.
-    utxo <- someUTxO PlutusV1
+  -- utxo to base token of.
+  utxo <- someUTxO PlutusV1
 
-    let amt'   = toInteger (max 1 amt) -- mint at least 1 token.
-        policy = testTokenPolicy amt' tn utxo
+  let amt' = toInteger (max 1 amt) -- mint at least 1 token.
+      policy = testTokenPolicy amt' tn utxo
 
-    let txSkeleton = mustHaveInput (GYTxIn utxo GYTxInWitnessKey)
-                  <> mustMint (GYMintScript policy) unitRedeemer tn amt'
+  let txSkeleton =
+        mustHaveInput (GYTxIn utxo GYTxInWitnessKey)
+          <> mustMint (GYMintScript policy) unitRedeemer tn amt'
 
-    return (GYToken (mintingPolicyId policy) tn, txSkeleton)
+  return (GYToken (mintingPolicyId policy) tn, txSkeleton)