Merge pull request #513 from IntersectMBO/ldan/consistent-formatting

Format the codebase

.git-blame-ignore-revs

@@ -0,0 +1,8 @@
+### NOTE
+# Run `git config blame.ignoreRevsFile .git-blame-ignore-revs`
+# from the repository's root to tell `git blame` to ignore
+# the commits below.
+
+# `fourmolize`
+# CommitDate: Wed Nov 20 18:01:24 2024 +0100
+db87b19be6ff702d3bf37cef259de456c48b7ffe

.github/PULL_REQUEST_TEMPLATE.md

@@ -14,4 +14,5 @@ to the issue. -->
       [versioning process](https://github.com/intersectmbo/cardano-base/blob/master/RELEASING.md#versioning-process).
 - [ ] The version bounds in `.cabal` files for all affected packages are updated.
       **_If you change the bounds in a cabal file, that package itself must have a version increase._** (See [RELEASING.md](https://github.com/intersectmbo/cardano-base/blob/master/RELEASING.md#versioning-process))
+- [ ] Commits that only contain large amounts of formatting changes were added to `.git-blame-ignore-revs`
 - [ ] Self-reviewed the diff

.github/workflows/haskell.yml

@@ -191,3 +191,27 @@ jobs:
       uses: input-output-hk/actions/cache@latest
       with:
         ghc_version: ${{ matrix.ghc == '8.10.7' && 'ghc810' || matrix.ghc == '9.6.6' && 'ghc96' }}
+
+  fourmolu:
+    runs-on: ubuntu-latest
+
+    defaults:
+      run:
+        shell: bash
+
+    strategy:
+      fail-fast: false
+
+    steps:
+    - uses: actions/checkout@v4
+
+    - name: Install fourmolu
+      run: |
+        FOURMOLU_VERSION="0.16.2.0"
+        mkdir -p "$HOME/.local/bin"
+        curl -sL "https://github.com/fourmolu/fourmolu/releases/download/v${FOURMOLU_VERSION}/fourmolu-${FOURMOLU_VERSION}-linux-x86_64" -o "$HOME/.local/bin/fourmolu"
+        chmod a+x "$HOME/.local/bin/fourmolu"
+        echo "$HOME/.local/bin" >> $GITHUB_PATH
+
+    - name: Run fourmolu
+      run: ./scripts/fourmolize.sh

CONTRIBUTING.md

@@ -25,6 +25,25 @@ infrastructure:
 We use trunk based developement. Normal development will branch off of master and be
 merged back to master.
 
+### Recommended `git` configuration
+
+Once you cloned the repository, it is recommended to run the following
+from the repository's root:
+```bash
+git config blame.ignoreRevsFile .git-blame-ignore-revs
+```
+This way `git blame` will ignore the commits specified in the `.git-blame-ignore-revs`
+file. This can come in handy if you want to exclude large commits
+with only formatting changes.
+You can ignore the above however, if you tend to look at `git blame`
+through GitHub. In that case, you don't have to do anything,
+as GitHub will pick up `.git-blame-ignore-revs` automatically and ignore
+the specified commits.
+
+If you want to add further revisions to the `ignore-revs` file,
+just prepend the full commit hash that you want `git blame` to ignore
+and add the commit's title and date as a comment for clarity.
+
 ### Releasing and versioning
 
 Packages from `cardano-base` are released to

base-deriving-via/src/Data/DerivingVia.hs

@@ -1,19 +1,19 @@
-{-# LANGUAGE ConstraintKinds            #-}
-{-# LANGUAGE DerivingStrategies         #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures             #-}
-{-# LANGUAGE UndecidableInstances       #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 -- | Newtype wrappers for us in @deriving via@ clauses that " should " have
 -- been defined in @base@ and other packages we depend on but do not control
 --
 -- We expected variations of these to eventually be defined upstream, but we'd
 -- like to use these concepts before that happens.
-module Data.DerivingVia
-  ( InstantiatedAt (..)
-  )
+module Data.DerivingVia (
+  InstantiatedAt (..),
+)
 where
 
 import Data.Kind (Constraint, Type)
@@ -37,11 +37,15 @@ infix 0 `InstantiatedAt`
 newtype InstantiatedAt (c :: Type -> Constraint) a = InstantiatedAt a
   deriving newtype (Eq, Ord, Show)
 
-instance (Generic a, GSemigroup (Rep a))
-      => Semigroup (InstantiatedAt Generic a) where
+instance
+  (Generic a, GSemigroup (Rep a)) =>
+  Semigroup (InstantiatedAt Generic a)
+  where
   InstantiatedAt l <> InstantiatedAt r =
     InstantiatedAt $ to $ gsappend (from l) (from r)
 
-instance (Generic a, GSemigroup (Rep a), GMonoid (Rep a))
-      => Monoid (InstantiatedAt Generic a) where
+instance
+  (Generic a, GSemigroup (Rep a), GMonoid (Rep a)) =>
+  Monoid (InstantiatedAt Generic a)
+  where
   mempty = InstantiatedAt $ to gmempty

base-deriving-via/src/Data/DerivingVia/GHC/Generics/Monoid.hs

@@ -1,15 +1,15 @@
-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE FlexibleContexts     #-}
-{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS -Wno-unticked-promoted-constructors #-}
 
 -- | "GHC.Generics" definition of 'mempty'
-module Data.DerivingVia.GHC.Generics.Monoid
-  ( GMonoid (..)
-  )
+module Data.DerivingVia.GHC.Generics.Monoid (
+  GMonoid (..),
+)
 where
 
 import GHC.Generics
@@ -33,10 +33,13 @@ instance GMonoid U1 where
 instance (GMonoid l, GMonoid r) => GMonoid (l :*: r) where
   gmempty = gmempty :*: gmempty
 
-instance TypeError (     Text "No Generics definition of "
-                    :<>: ShowType Monoid
-                    :<>: Text " for types with multiple constructors "
-                    :<>: ShowType (l :+: r)
-                   )
-      => GMonoid (l :+: r) where
+instance
+  TypeError
+    ( Text "No Generics definition of "
+        :<>: ShowType Monoid
+        :<>: Text " for types with multiple constructors "
+        :<>: ShowType (l :+: r)
+    ) =>
+  GMonoid (l :+: r)
+  where
   gmempty = error "GMonoid :+:"

base-deriving-via/src/Data/DerivingVia/GHC/Generics/Semigroup.hs

@@ -1,17 +1,17 @@
-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE EmptyCase            #-}
-{-# LANGUAGE FlexibleContexts     #-}
-{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE LambdaCase           #-}
-{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS -Wno-unticked-promoted-constructors #-}
 
 -- | "GHC.Generics" definition of '<>'
-module Data.DerivingVia.GHC.Generics.Semigroup
-  ( GSemigroup (..)
-  )
+module Data.DerivingVia.GHC.Generics.Semigroup (
+  GSemigroup (..),
+)
 where
 
 import GHC.Generics
@@ -35,10 +35,13 @@ instance GSemigroup U1 where
 instance (GSemigroup l, GSemigroup r) => GSemigroup (l :*: r) where
   gsappend (l1 :*: r1) (l2 :*: r2) = gsappend l1 l2 :*: gsappend r1 r2
 
-instance TypeError (     Text "No Generics definition of "
-                    :<>: ShowType Semigroup
-                    :<>: Text " for types with multiple constructors "
-                    :<>: ShowType (l :+: r)
-                   )
-      => GSemigroup (l :+: r) where
+instance
+  TypeError
+    ( Text "No Generics definition of "
+        :<>: ShowType Semigroup
+        :<>: Text " for types with multiple constructors "
+        :<>: ShowType (l :+: r)
+    ) =>
+  GSemigroup (l :+: r)
+  where
   gsappend = error "GSemigroup :+:"

cardano-binary/src/Cardano/Binary.hs

@@ -1,9 +1,9 @@
-module Cardano.Binary
-  ( module X
-  )
+module Cardano.Binary (
+  module X,
+)
 where
 
 import Cardano.Binary.Deserialize as X
-import Cardano.Binary.ToCBOR as X
-import Cardano.Binary.Serialize as X
 import Cardano.Binary.FromCBOR as X
+import Cardano.Binary.Serialize as X
+import Cardano.Binary.ToCBOR as X

cardano-binary/src/Cardano/Binary/Deserialize.hs

@@ -1,30 +1,28 @@
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- | Deserialization primitives built on top of the @FromCBOR@ typeclass
-
-module Cardano.Binary.Deserialize
-  (
+module Cardano.Binary.Deserialize (
   -- * Unsafe deserialization
-    unsafeDeserialize
-  , unsafeDeserialize'
-  , CBOR.Write.toStrictByteString
+  unsafeDeserialize,
+  unsafeDeserialize',
+  CBOR.Write.toStrictByteString,
 
   -- * Decoding
-  , decodeFull
-  , decodeFull'
-  , decodeFullDecoder
-  , decodeFullDecoder'
+  decodeFull,
+  decodeFull',
+  decodeFullDecoder,
+  decodeFullDecoder',
 
   -- * CBOR in CBOR
-  , decodeNestedCbor
-  , decodeNestedCborBytes
-  )
+  decodeNestedCbor,
+  decodeNestedCborBytes,
+)
 where
 
 import qualified Codec.CBOR.Decoding as D
@@ -37,11 +35,10 @@ import Data.Bifunctor (bimap)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.ByteString.Lazy.Internal as BSL
-import Data.Proxy (Proxy(Proxy))
+import Data.Proxy (Proxy (Proxy))
 import Data.Text (Text)
 
-import Cardano.Binary.FromCBOR (DecoderError(..), FromCBOR(..), cborError, toCborError)
-
+import Cardano.Binary.FromCBOR (DecoderError (..), FromCBOR (..), cborError, toCborError)
 
 -- | Deserialize a Haskell value from the external binary representation
 --   (which must have been made using 'serialize' or related function).
@@ -61,58 +58,58 @@ unsafeDeserialize' = unsafeDeserialize . BSL.fromStrict
 --   failing if there are leftovers. In a nutshell, the `full` here implies
 --   the contract of this function is that what you feed as input needs to
 --   be consumed entirely.
-decodeFull :: forall a . FromCBOR a => BSL.ByteString -> Either DecoderError a
+decodeFull :: forall a. FromCBOR a => BSL.ByteString -> Either DecoderError a
 decodeFull = decodeFullDecoder (label $ Proxy @a) fromCBOR
 
-decodeFull' :: forall a . FromCBOR a => BS.ByteString -> Either DecoderError a
+decodeFull' :: forall a. FromCBOR a => BS.ByteString -> Either DecoderError a
 decodeFull' = decodeFull . BSL.fromStrict
 
-decodeFullDecoder
-  :: Text
-  -- ^ Label for error reporting
-  -> (forall s . D.Decoder s a)
-  -- ^ The parser for the @ByteString@ to decode. It should decode the given
+decodeFullDecoder ::
+  -- | Label for error reporting
+  Text ->
+  -- | The parser for the @ByteString@ to decode. It should decode the given
   -- @ByteString@ into a value of type @a@
-  -> BSL.ByteString
-  -- ^ The @ByteString@ to decode
-  -> Either DecoderError a
+  (forall s. D.Decoder s a) ->
+  -- | The @ByteString@ to decode
+  BSL.ByteString ->
+  Either DecoderError a
 decodeFullDecoder lbl decoder bs0 = case deserialiseDecoder decoder bs0 of
-  Right (x, leftover) -> if BS.null leftover
-    then pure x
-    else Left $ DecoderErrorLeftover lbl leftover
+  Right (x, leftover) ->
+    if BS.null leftover
+      then pure x
+      else Left $ DecoderErrorLeftover lbl leftover
   Left (e, _) -> Left $ DecoderErrorDeserialiseFailure lbl e
 
-decodeFullDecoder'
-  :: Text
-  -- ^ Label for error reporting
-  -> (forall s . D.Decoder s a)
-  -- ^ The parser for the @ByteString@ to decode. It should decode the given
+decodeFullDecoder' ::
+  -- | Label for error reporting
+  Text ->
+  -- | The parser for the @ByteString@ to decode. It should decode the given
   -- @ByteString@ into a value of type @a@
-  -> BS.ByteString
-  -- ^ The @ByteString@ to decode
-  -> Either DecoderError a
+  (forall s. D.Decoder s a) ->
+  -- | The @ByteString@ to decode
+  BS.ByteString ->
+  Either DecoderError a
 decodeFullDecoder' lbl decoder = decodeFullDecoder lbl decoder . BSL.fromStrict
 
 -- | Deserialise a 'LByteString' incrementally using the provided 'Decoder'
-deserialiseDecoder
-  :: (forall s . D.Decoder s a)
-  -> BSL.ByteString
-  -> Either (Read.DeserialiseFailure, BS.ByteString) (a, BS.ByteString)
+deserialiseDecoder ::
+  (forall s. D.Decoder s a) ->
+  BSL.ByteString ->
+  Either (Read.DeserialiseFailure, BS.ByteString) (a, BS.ByteString)
 deserialiseDecoder decoder bs0 =
   runST (supplyAllInput bs0 =<< Read.deserialiseIncremental decoder)
 
-supplyAllInput
-  :: BSL.ByteString
-  -> Read.IDecode s a
-  -> ST s (Either (Read.DeserialiseFailure, BS.ByteString) (a, BS.ByteString))
+supplyAllInput ::
+  BSL.ByteString ->
+  Read.IDecode s a ->
+  ST s (Either (Read.DeserialiseFailure, BS.ByteString) (a, BS.ByteString))
 supplyAllInput bs' (Read.Done bs _ x) =
   return (Right (x, bs <> BSL.toStrict bs'))
 supplyAllInput bs (Read.Partial k) = case bs of
   BSL.Chunk chunk bs' -> k (Just chunk) >>= supplyAllInput bs'
-  BSL.Empty           -> k Nothing >>= supplyAllInput BSL.Empty
+  BSL.Empty -> k Nothing >>= supplyAllInput BSL.Empty
 supplyAllInput _ (Read.Fail bs _ exn) = return (Left (exn, bs))
 
-
 --------------------------------------------------------------------------------
 -- Nested CBOR-in-CBOR
 -- https://tools.ietf.org/html/rfc7049#section-2.4.4.1
@@ -123,9 +120,11 @@ supplyAllInput _ (Read.Fail bs _ exn) = return (Left (exn, bs))
 decodeNestedCborTag :: D.Decoder s ()
 decodeNestedCborTag = do
   t <- D.decodeTag
-  when (t /= 24) $ cborError $ DecoderErrorUnknownTag
-    "decodeNestedCborTag"
-    (fromIntegral t)
+  when (t /= 24) $
+    cborError $
+      DecoderErrorUnknownTag
+        "decodeNestedCborTag"
+        (fromIntegral t)
 
 -- | Remove the the semantic tag 24 from the enclosed CBOR data item,
 -- decoding back the inner `ByteString` as a proper Haskell type.