Apply hlint --refactor everywhere and add hlint CI job

.github/workflows/formatting.yaml

@@ -27,3 +27,7 @@ jobs:
     - name: 📐 Check code formatting
       run: |
         nix develop .#fmt --command treefmt --fail-on-change
+
+    - name: 📐 Check hlint
+      run: |
+        nix develop .#fmt --command hlint .

.hlint.yaml

@@ -0,0 +1,2 @@
+- ignore: {name: Redundant <$>, within: [Hydra.Contract.HeadTokens]}
+- ignore: {name: Redundant compare, within: [Hydra.PartySpec]}

hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs

@@ -26,5 +26,4 @@ hashScriptInAnyLang (ScriptInAnyLang _ script) =
 
 instance Arbitrary ScriptHash where
   arbitrary = do
-    plutusScript <- arbitrary
-    pure $ hashScript (PlutusScript PlutusScriptV2 plutusScript)
+    hashScript . PlutusScript PlutusScriptV2 <$> arbitrary

hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs

@@ -167,7 +167,7 @@ fromPlutusTxOut ::
   Plutus.TxOut ->
   Maybe (TxOut CtxUTxO era)
 fromPlutusTxOut network out = do
-  value <- shelleyBasedEraConstraints (shelleyBasedEra @era) $ TxOutValueShelleyBased (shelleyBasedEra @era) <$> (toLedgerValue (maryEraOnwards @era) <$> fromPlutusValue plutusValue)
+  value <- shelleyBasedEraConstraints (shelleyBasedEra @era) (TxOutValueShelleyBased (shelleyBasedEra @era) . toLedgerValue (maryEraOnwards @era) <$> fromPlutusValue plutusValue)
   pure $ TxOut addressInEra value datum ReferenceScriptNone
  where
   addressInEra = fromPlutusAddress network plutusAddress

hydra-cluster/bench/Main.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 
 module Main where
 

hydra-cluster/src/Hydra/Cluster/Mithril.hs

@@ -52,14 +52,14 @@ downloadLatestSnapshotTo tracer network directory = do
 
   genesisKeyURLForNetwork :: KnownNetwork -> Maybe String
   genesisKeyURLForNetwork = \case
-    Mainnet -> Just $ "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-mainnet/genesis.vkey"
-    Preproduction -> Just $ "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-preprod/genesis.vkey"
-    Preview -> Just $ "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/pre-release-preview/genesis.vkey"
-    Sanchonet -> Just $ "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/testing-sanchonet/genesis.vkey"
+    Mainnet -> Just "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-mainnet/genesis.vkey"
+    Preproduction -> Just "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-preprod/genesis.vkey"
+    Preview -> Just "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/pre-release-preview/genesis.vkey"
+    Sanchonet -> Just "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/testing-sanchonet/genesis.vkey"
 
   aggregatorEndpointForNetwork :: KnownNetwork -> Maybe String
   aggregatorEndpointForNetwork = \case
-    Mainnet -> Just $ "https://aggregator.release-mainnet.api.mithril.network/aggregator"
-    Preproduction -> Just $ "https://aggregator.release-preprod.api.mithril.network/aggregator"
-    Preview -> Just $ "https://aggregator.pre-release-preview.api.mithril.network/aggregator"
-    Sanchonet -> Just $ "https://aggregator.testing-sanchonet.api.mithril.network/aggregator"
+    Mainnet -> Just "https://aggregator.release-mainnet.api.mithril.network/aggregator"
+    Preproduction -> Just "https://aggregator.release-preprod.api.mithril.network/aggregator"
+    Preview -> Just "https://aggregator.pre-release-preview.api.mithril.network/aggregator"
+    Sanchonet -> Just "https://aggregator.testing-sanchonet.api.mithril.network/aggregator"

hydra-cluster/test/Test/Hydra/Cluster/CardanoCliSpec.hs

@@ -42,15 +42,15 @@ spec =
       it "query protocol-parameters is compatible with our FromJSON instance" $ \tracer ->
         withTempDir "hydra-cluster" $ \tmpDir -> do
           withCardanoNodeDevnet tracer tmpDir $ \RunningNode{nodeSocket, networkId} -> do
-            protocolParameters <- cliQueryProtocolParameters nodeSocket (networkId)
-            case (parseEither pparamsFromJson protocolParameters) of
+            protocolParameters <- cliQueryProtocolParameters nodeSocket networkId
+            case parseEither pparamsFromJson protocolParameters of
               Left e -> failure $ "Failed to decode JSON: " <> e <> "\n" <> show protocolParameters
               Right _ -> pure ()
 
       it "query protocol-parameters matches our schema" $ \tracer ->
         withJsonSpecifications $ \tmpDir ->
           withCardanoNodeDevnet tracer tmpDir $ \RunningNode{nodeSocket, networkId} -> do
-            pparamsValue <- cliQueryProtocolParameters nodeSocket (networkId)
+            pparamsValue <- cliQueryProtocolParameters nodeSocket networkId
             validateJSON
               (tmpDir </> "api.json")
               (key "components" . key "schemas" . key "ProtocolParameters")

hydra-node/exe/hydra-net/Main.hs

@@ -183,7 +183,7 @@ injectReqSn peer snapshotNumber hydraKeyFile fakeHydraKeyFile = do
       traceWith tracer $ ConnectedTo sockAddr
       runClient iomgr (mkApplication sk party tracer) sock
  where
-  runClient iomgr app sock =
+  runClient iomgr app =
     connectToNodeSocket
       iomgr
       unversionedHandshakeCodec
@@ -192,7 +192,6 @@ injectReqSn peer snapshotNumber hydraKeyFile fakeHydraKeyFile = do
       networkConnectTracers
       (HandshakeCallbacks acceptableVersion queryVersion)
       (unversionedProtocol app)
-      sock
 
   networkConnectTracers =
     NetworkConnectTracers
@@ -207,17 +206,17 @@ injectReqSn peer snapshotNumber hydraKeyFile fakeHydraKeyFile = do
       _ -> die "getAdrrInfo failed"
 
   mkApplication sk party tracer =
-    OuroborosApplication $
+    OuroborosApplication
       [ MiniProtocol
           { miniProtocolNum = MiniProtocolNum 42
           , miniProtocolLimits = MiniProtocolLimits{maximumIngressQueue = maxBound}
           , miniProtocolRun =
               InitiatorProtocolOnly
                 ( mkMiniProtocolCbFromPeer
-                    ( \_ ->
-                        ( (contramap TraceSendRecv tracer)
+                    ( const
+                        ( contramap TraceSendRecv tracer
                         , codecFireForget
-                        , (fireForgetClientPeer $ client tracer sk party)
+                        , fireForgetClientPeer $ client tracer sk party
                         )
                     )
                 )

hydra-node/src/Hydra/API/ServerOutput.hs

@@ -156,7 +156,7 @@ instance
 data WithUTxO = WithUTxO | WithoutUTxO
   deriving stock (Eq, Show)
 
-data ServerOutputConfig = ServerOutputConfig
+newtype ServerOutputConfig = ServerOutputConfig
   { utxoInSnapshot :: WithUTxO
   }
   deriving stock (Eq, Show)

hydra-node/src/Hydra/Chain/CardanoClient.hs

@@ -171,7 +171,7 @@ submitTransaction networkId socket tx =
 -- safely constructed through 'buildTransaction'.
 data SubmitTransactionException
   = SubmitEraMismatch EraMismatch
-  | SubmitTxValidationError (TxValidationErrorInCardanoMode)
+  | SubmitTxValidationError TxValidationErrorInCardanoMode
   deriving stock (Show)
 
 instance Exception SubmitTransactionException
@@ -240,7 +240,7 @@ querySystemStart networkId socket queryPoint =
 -- Throws at least 'QueryException' if query fails.
 queryEraHistory :: NetworkId -> SocketPath -> QueryPoint -> IO EraHistory
 queryEraHistory networkId socket queryPoint =
-  runQuery networkId socket queryPoint $ QueryEraHistory
+  runQuery networkId socket queryPoint QueryEraHistory
 
 -- | Query the current epoch number.
 --

hydra-node/src/Hydra/Crypto.hs

@@ -85,8 +85,7 @@ instance SerialiseAsRawBytes (Hash HydraKey) where
   serialiseToRawBytes (HydraKeyHash vkh) = hashToBytes vkh
 
   deserialiseFromRawBytes (AsHash AsHydraKey) bs =
-    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") Right $
-      HydraKeyHash <$> hashFromBytes bs
+    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") (Right . HydraKeyHash) (hashFromBytes bs)
 
 instance Key HydraKey where
   -- Hydra verification key, which can be used to 'verify' signed messages.
@@ -135,8 +134,7 @@ instance SerialiseAsRawBytes (SigningKey HydraKey) where
     rawSerialiseSignKeyDSIGN sk
 
   deserialiseFromRawBytes (AsSigningKey AsHydraKey) bs =
-    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") Right $
-      HydraSigningKey <$> rawDeserialiseSignKeyDSIGN bs
+    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") (Right . HydraSigningKey) (rawDeserialiseSignKeyDSIGN bs)
 
 instance HasTextEnvelope (SigningKey HydraKey) where
   textEnvelopeType _ =
@@ -151,8 +149,7 @@ instance SerialiseAsRawBytes (VerificationKey HydraKey) where
     rawSerialiseVerKeyDSIGN vk
 
   deserialiseFromRawBytes (AsVerificationKey AsHydraKey) bs =
-    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") Right $
-      HydraVerificationKey <$> rawDeserialiseVerKeyDSIGN bs
+    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") (Right . HydraVerificationKey) (rawDeserialiseVerKeyDSIGN bs)
 
 instance ToJSON (VerificationKey HydraKey) where
   toJSON = toJSON . serialiseToRawBytesHexText

hydra-node/src/Hydra/HeadLogic/Error.hs

@@ -15,8 +15,8 @@ import Hydra.Snapshot (SnapshotNumber)
 -- | Preliminary type for collecting errors occurring during 'update'.
 -- TODO: Try to merge this (back) into 'Outcome'.
 data LogicError tx
-  = InvalidEvent {invalidEvent :: (Event tx), currentHeadState :: (HeadState tx)}
-  | RequireFailed {requirementFailure :: (RequirementFailure tx)}
+  = InvalidEvent {invalidEvent :: Event tx, currentHeadState :: HeadState tx}
+  | RequireFailed {requirementFailure :: RequirementFailure tx}
   | NotOurHead {ourHeadId :: HeadId, otherHeadId :: HeadId}
   deriving stock (Generic)
 

hydra-node/src/Hydra/Ledger/Cardano.hs

@@ -132,8 +132,8 @@ instance ToJSON Tx where
   toJSON tx =
     let TextEnvelopeType envelopeType = textEnvelopeType (proxyToAsType (Proxy @Tx))
      in object
-          [ "cborHex" .= (Aeson.String $ decodeUtf8 $ Base16.encode $ serialiseToCBOR tx)
-          , "txId" .= (txId tx)
+          [ "cborHex" .= Aeson.String (decodeUtf8 $ Base16.encode $ serialiseToCBOR tx)
+          , "txId" .= txId tx
           , "type" .= envelopeType
           , "description" .= Aeson.String mempty
           ]
@@ -153,7 +153,7 @@ instance FromJSON Tx where
           (o .:? "txId") >>= \case
             Nothing -> pure tx
             Just txid' -> do
-              guard (txid' == (txId tx))
+              guard (txid' == txId tx)
               pure tx
 
 instance Arbitrary Tx where
@@ -362,8 +362,8 @@ genTxOut =
     `suchThat` notByronAddress
  where
   gen =
-    fmap (modifyTxOutValue (<> (lovelaceToValue $ Lovelace 10_000_000))) $
-      oneof
+    modifyTxOutValue (<> (lovelaceToValue $ Lovelace 10_000_000))
+      <$> oneof
         [ fromLedgerTxOut <$> arbitrary
         , notMultiAsset . fromLedgerTxOut <$> arbitrary
         ]
@@ -429,7 +429,7 @@ genAddressInEra networkId =
   mkVkAddress networkId <$> genVerificationKey
 
 genValue :: Gen Value
-genValue = liftA2 (<>) (pure $ lovelaceToValue $ Lovelace 10_000_000) (scale (`div` 10) $ fromLedgerValue <$> arbitrary)
+genValue = fmap ((lovelaceToValue $ Lovelace 10_000_000) <>) (scale (`div` 10) $ fromLedgerValue <$> arbitrary)
 
 -- | Generate UTXO entries that do not contain any assets. Useful to test /
 -- measure cases where

hydra-node/src/Hydra/Network/Ouroboros/Server.hs

@@ -29,9 +29,8 @@ fireForgetServerPeer ::
   Peer (FireForget msg) 'AsServer 'StIdle m a
 fireForgetServerPeer FireForgetServer{recvMsg, recvMsgDone} =
   -- In the 'StIdle' the server is awaiting a request message
-  Await (ClientAgency TokIdle) $ \msg ->
+  Await (ClientAgency TokIdle) $ \case
     -- The client got to choose between two messages and we have to handle
     -- either of them
-    case msg of
-      MsgSend payload -> Effect $ fireForgetServerPeer <$> recvMsg payload
-      MsgDone -> Effect $ Done TokDone <$> recvMsgDone
+    MsgSend payload -> Effect $ fireForgetServerPeer <$> recvMsg payload
+    MsgDone -> Effect $ Done TokDone <$> recvMsgDone

hydra-node/src/Hydra/Options.hs

@@ -886,7 +886,7 @@ genDirPath = do
   pure $ intercalate "/" path
 
 genChainPoint :: Gen ChainPoint
-genChainPoint = ChainPoint <$> (SlotNo <$> arbitrary) <*> someHeaderHash
+genChainPoint = (ChainPoint . SlotNo <$> arbitrary) <*> someHeaderHash
  where
   someHeaderHash = do
     bytes <- vectorOf 32 arbitrary

hydra-node/src/Hydra/Party.hs

@@ -29,7 +29,7 @@ instance ToJSONKey Party where
   toJSONKey = toJSONKeyText (serialiseToRawBytesHexText . vkey)
 
 instance FromJSONKey Party where
-  fromJSONKey = FromJSONKeyTextParser $ partyFromHexText
+  fromJSONKey = FromJSONKeyTextParser partyFromHexText
    where
     partyFromHexText :: MonadFail m => Text -> m Party
     partyFromHexText t =

hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs

@@ -399,11 +399,9 @@ data CloseInitialMutation
 -- right away.
 genCloseInitialMutation :: (Tx, UTxO) -> Gen SomeMutation
 genCloseInitialMutation (tx, _utxo) =
-  oneof
-    [ SomeMutation (Just $ toErrorCode IncorrectClosedContestationDeadline) MutateCloseContestationDeadline' <$> do
-        mutatedDeadline <- genMutatedDeadline
-        pure $ ChangeOutput 0 $ modifyInlineDatum (replaceContestationDeadline mutatedDeadline) headTxOut
-    ]
+  SomeMutation (Just $ toErrorCode IncorrectClosedContestationDeadline) MutateCloseContestationDeadline' <$> do
+    mutatedDeadline <- genMutatedDeadline
+    pure $ ChangeOutput 0 $ modifyInlineDatum (replaceContestationDeadline mutatedDeadline) headTxOut
  where
   headTxOut = fromJust $ txOuts' tx !!? 0
 

hydra-node/test/Hydra/Chain/Direct/Contract/Init.hs

@@ -137,7 +137,7 @@ genInitMutation (tx, _utxo) =
         out
 
   removeInitialOutputDatum ix out =
-    ChangeOutput ix $ modifyTxOutDatum (const $ TxOutDatumNone) out
+    ChangeOutput ix $ modifyTxOutDatum (const TxOutDatumNone) out
 
   changeInitialOutputToNotAHeadId ix out =
     ChangeOutput ix $ modifyTxOutDatum (const $ TxOutDatumInline $ toScriptData (42 :: Integer)) out

hydra-node/test/Hydra/Chain/Direct/TxSpec.hs

@@ -81,7 +81,7 @@ spec =
             genericCoverTable [transition] $
               counterexample (show transition) $
                 let utxo = getKnownUTxO st
-                 in case (observeHeadTx testNetworkId utxo tx) of
+                 in case observeHeadTx testNetworkId utxo tx of
                       NoHeadTx -> property False
                       Init{} -> transition === Transition.Init
                       Abort{} -> transition === Transition.Abort

hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs

@@ -275,7 +275,7 @@ genChainPoint =
 -- | Generate a chain point at given slot with a likely invalid block header hash.
 genChainPointAt :: SlotNo -> Gen ChainPoint
 genChainPointAt s =
-  ChainPoint s <$> (HeaderHash <$> arbitrary)
+  ChainPoint s . HeaderHash <$> arbitrary
 
 -- | Generate an arbitrary list of transactions from a UTXO set such that,
 -- transactions may *sometimes* consume given UTXO and produce new ones. The

hydra-node/test/Hydra/JSONSchemaSpec.hs

@@ -19,12 +19,12 @@ spec = do
         validateJSON (dir </> "api.json") id Null
 
     it "fails on non-existing schema file" $
-      validateJSON ("does-not-exist.json") id Null
+      validateJSON "does-not-exist.json" id Null
         `shouldThrow` exceptionContaining @IOException "does-not-exist.json"
 
     it "fails with missing tool" $ do
       withClearedPATH $
-        validateJSON ("does-not-matter.json") id Null
+        validateJSON "does-not-matter.json" id Null
           `shouldThrow` exceptionContaining @IOException "installed"
 
     it "selects a sub-schema correctly" $

hydra-node/test/Hydra/Network/ReliabilitySpec.hs

@@ -173,7 +173,7 @@ spec = parallel $ do
         let networkMessagesFile = tmpDir <> "/network-messages"
 
         Persistence{load, save} <- createPersistence $ tmpDir <> "/acks"
-        PersistenceIncremental{loadAll, append} <- createPersistenceIncremental $ networkMessagesFile
+        PersistenceIncremental{loadAll, append} <- createPersistenceIncremental networkMessagesFile
 
         let messagePersistence =
               MessagePersistence

hydra-plutus-extras/src/Hydra/Plutus/Orphans.hs

@@ -47,7 +47,7 @@ instance Arbitrary a => Arbitrary (UpperBound a) where
   arbitrary = upperBound <$> arbitrary
 
 instance ToJSON PubKeyHash where
-  toJSON = \kh ->
+  toJSON kh =
     object
       [ "tag" .= Aeson.String "PubKeyHash"
       , "keyHash" .= Aeson.String (decodeUtf8 $ Base16.encode $ fromBuiltin $ getPubKeyHash kh)

hydra-plutus/exe/inspect-script/Main.hs

@@ -108,7 +108,7 @@ main = do
     , (abortDatum, "abortDatum")
     ]
 
-  headDatum = toData $ Head.Initial 1_000_000_000_000 [] (toPlutusCurrencySymbol $ HeadTokens.headPolicyId $ someTxIn) (toPlutusTxOutRef someTxIn)
+  headDatum = toData $ Head.Initial 1_000_000_000_000 [] (toPlutusCurrencySymbol $ HeadTokens.headPolicyId someTxIn) (toPlutusTxOutRef someTxIn)
 
   someTxIn = TxIn (TxId $ unsafeHashFromBytes "01234567890123456789012345678901") (TxIx 1)
 

hydra-plutus/src/Hydra/Contract/Error.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 -- | Error codes to be used in plutus scripts.
 --
 -- Define a new type and instantiate 'ToErrorCode' for error cases you want to

hydra-plutus/src/Hydra/Contract/Initial.hs

@@ -117,9 +117,9 @@ checkCommit commitValidator headId committedRefs context =
     go = \case
       ([], []) ->
         True
-      ([], (_ : _)) ->
+      ([], _ : _) ->
         traceError $(errorCode MissingCommittedTxOutInOutputDatum)
-      ((_ : _), []) ->
+      (_ : _, []) ->
         traceError $(errorCode CommittedTxOutMissingInOutputDatum)
       (TxInInfo{txInInfoOutRef, txInInfoResolved} : restCommitted, Commit{input, preSerializedOutput} : restCommits) ->
         Builtins.serialiseData (toBuiltinData txInInfoResolved) == preSerializedOutput

hydra-test-utils/src/Test/Network/Ports.hs

@@ -35,4 +35,4 @@ withFreePort action = getRandomPort >>= action
 randomUnusedTCPPorts :: Int -> IO [Int]
 randomUnusedTCPPorts count =
   fmap fromIntegral
-    <$> replicateM count (withFreePort (\port -> return port))
+    <$> replicateM count (withFreePort return)

nix/hydra/shell.nix

@@ -16,6 +16,8 @@ let
 
   fourmolu = pkgs.haskell-nix.tool compiler "fourmolu" "0.14.0.0";
   cabal-fmt = pkgs.haskell-nix.tool compiler "cabal-fmt" "0.1.9";
+  hlint = pkgs.haskell-nix.tool compiler "hlint" "3.8";
+  apply-refact = pkgs.haskell-nix.tool compiler "apply-refact" "0.14.0.0";
 
   # Build HLS form our fork (see flake.nix)
   haskell-language-server = pkgs.haskell-nix.tool compiler "haskell-language-server" rec {
@@ -45,6 +47,8 @@ let
     fourmolu
     cabal-fmt
     pkgs.nixpkgs-fmt
+    hlint
+    apply-refact
     # For validating JSON instances against a pre-defined schema
     pkgs.check-jsonschema
     # For generating plantuml drawings
@@ -155,6 +159,8 @@ let
       fourmolu
       cabal-fmt
       pkgs.nixpkgs-fmt
+      hlint
+      apply-refact
     ];
   };
 

plutus-cbor/test/Plutus/Codec/CBOR/EncodingSpec.hs

@@ -236,7 +236,7 @@ genInteger =
 
 genByteString :: Gen ByteString
 genByteString = do
-  (\n -> BS.pack <$> vector n) =<< elements [0, 8, 16, 28, 32]
+  fmap BS.pack . vector =<< elements [0, 8, 16, 28, 32]
 
 shrinkByteString :: ByteString -> [ByteString]
 shrinkByteString =