cardano-tools: (styling) disappear .. wildcards from project code

ouroboros-consensus-cardano-tools/app/DBAnalyser/Parsers.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE ApplicativeDo   #-}
-{-# LANGUAGE RecordWildCards #-}
 
 module DBAnalyser.Parsers (parseCmdLine) where
 
@@ -164,10 +163,9 @@ parseMaybe parser = asum [Just <$> parser, pure Nothing]
 -------------------------------------------------------------------------------}
 
 parseCardanoArgs :: Parser CardanoBlockArgs
-parseCardanoArgs = do
-    configFile           <- parseConfigFile
-    threshold            <- parsePBftSignatureThreshold
-    pure CardanoBlockArgs {..}
+parseCardanoArgs = CardanoBlockArgs
+    <$> parseConfigFile
+    <*> parsePBftSignatureThreshold
 
 parseShelleyArgs :: Parser ShelleyBlockArgs
 parseShelleyArgs = ShelleyBlockArgs

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBAnalyser/Analysis.hs

@@ -632,7 +632,7 @@ processAllChainDB ::
   -> st
   -> (st -> b -> IO (NextStep, st))
   -> IO st
-processAllChainDB chainDB registry blockComponent (ExtLedgerState {..}) limit initState callback = do
+processAllChainDB chainDB registry blockComponent ExtLedgerState{headerState} limit initState callback = do
     itr <- case headerStateTip headerState of
       Origin           -> ChainDB.streamAll
                              chainDB
@@ -667,7 +667,7 @@ processAllImmutableDB ::
   -> st
   -> (st -> b -> IO (NextStep, st))
   -> IO st
-processAllImmutableDB immutableDB registry blockComponent (ExtLedgerState {..}) limit initState callback = do
+processAllImmutableDB immutableDB registry blockComponent ExtLedgerState{headerState} limit initState callback = do
     itr <- case headerStateTip headerState of
       Origin           -> ImmutableDB.streamAll
                              immutableDB

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBAnalyser/Block/Byron.hs

@@ -48,9 +48,9 @@ instance HasProtocolInfo ByronBlock where
         , genesisHash          :: Maybe (Crypto.Hash Raw)
         , threshold            :: Maybe PBftSignatureThreshold
         }
-    mkProtocolInfo ByronBlockArgs {..} = do
-      config <- openGenesisByron configFile genesisHash requiresNetworkMagic
-      return $ mkByronProtocolInfo config threshold
+    mkProtocolInfo args = do
+      config <- openGenesisByron (configFile args) (genesisHash args) (requiresNetworkMagic args)
+      return $ mkByronProtocolInfo config (threshold args)
 
 type ByronBlockArgs = Args ByronBlock
 
@@ -65,9 +65,9 @@ aBlockOrBoundary fromBoundary fromRegular blk = case blk of
       -> fromRegular regularBlk
 
 countTxOutputsByron :: Chain.ABlock ByteString -> Int
-countTxOutputsByron Chain.ABlock{..} = countTxPayload bodyTxPayload
+countTxOutputsByron Chain.ABlock{ blockBody } = countTxPayload bodyTxPayload
   where
-    Chain.ABody { bodyTxPayload } = blockBody
+    Chain.ABody{ bodyTxPayload } = blockBody
 
     countTxPayload :: Chain.ATxPayload a -> Int
     countTxPayload = sum

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBAnalyser/Block/Cardano.hs

@@ -5,9 +5,9 @@
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
@@ -124,24 +124,25 @@ instance HasProtocolInfo (CardanoBlock StandardCrypto) where
         , threshold            :: Maybe PBftSignatureThreshold
         }
 
-  mkProtocolInfo CardanoBlockArgs {..} = do
+  mkProtocolInfo CardanoBlockArgs{configFile, threshold} = do
     relativeToConfig :: (FilePath -> FilePath) <-
         (</>) . takeDirectory <$> makeAbsolute configFile
 
-    CardanoConfig {..} <- either (error . show) (return . adjustFilePaths relativeToConfig) =<<
-      Aeson.eitherDecodeFileStrict' configFile
+    cc :: CardanoConfig <-
+      either (error . show) (return . adjustFilePaths relativeToConfig) =<<
+        Aeson.eitherDecodeFileStrict' configFile
 
     genesisByron   <-
-      BlockByron.openGenesisByron byronGenesisPath byronGenesisHash requiresNetworkMagic
+      BlockByron.openGenesisByron (byronGenesisPath cc) (byronGenesisHash cc) (requiresNetworkMagic cc)
     genesisShelley <- either (error . show) return =<<
-      Aeson.eitherDecodeFileStrict' shelleyGenesisPath
+      Aeson.eitherDecodeFileStrict' (shelleyGenesisPath cc)
     genesisAlonzo  <- either (error . show) return =<<
-      Aeson.eitherDecodeFileStrict' alonzoGenesisPath
+      Aeson.eitherDecodeFileStrict' (alonzoGenesisPath cc)
 
-    initialNonce <- case shelleyGenesisHash of
+    initialNonce <- case shelleyGenesisHash cc of
       Just h  -> pure h
       Nothing -> do
-        content <- BS.readFile shelleyGenesisPath
+        content <- BS.readFile (shelleyGenesisPath cc)
         pure
           $ Nonce
           $ CryptoClass.castHash
@@ -155,7 +156,7 @@ instance HasProtocolInfo (CardanoBlock StandardCrypto) where
           genesisShelley
           genesisAlonzo
           initialNonce
-          hardForkTriggers
+          (hardForkTriggers cc)
 
 data CardanoConfig = CardanoConfig {
     -- | @RequiresNetworkMagic@ field
@@ -179,11 +180,11 @@ data CardanoConfig = CardanoConfig {
   }
 
 instance AdjustFilePaths CardanoConfig where
-    adjustFilePaths f cc@CardanoConfig{..} =
+    adjustFilePaths f cc =
         cc {
-            byronGenesisPath    = f byronGenesisPath
-          , shelleyGenesisPath  = f shelleyGenesisPath
-          , alonzoGenesisPath   = f alonzoGenesisPath
+            byronGenesisPath    = f $ byronGenesisPath cc
+          , shelleyGenesisPath  = f $ shelleyGenesisPath cc
+          , alonzoGenesisPath   = f $ alonzoGenesisPath cc
           }
 
 -- | Shelley transition arguments
@@ -240,7 +241,15 @@ instance Aeson.FromJSON CardanoConfig where
            "if the Cardano config file sets a Test*HardForkEpoch,"
         <> " it must also set it for all previous eras."
 
-    pure $ CardanoConfig{..}
+    pure $ CardanoConfig
+      { requiresNetworkMagic = requiresNetworkMagic
+      , byronGenesisPath = byronGenesisPath
+      , byronGenesisHash = byronGenesisHash
+      , shelleyGenesisPath = shelleyGenesisPath
+      , shelleyGenesisHash = shelleyGenesisHash
+      , alonzoGenesisPath = alonzoGenesisPath
+      , hardForkTriggers = hardForkTriggers
+      }
 
 instance (HasAnnTip (CardanoBlock StandardCrypto), GetPrevHash (CardanoBlock StandardCrypto)) => HasAnalysis (CardanoBlock StandardCrypto) where
   countTxOutputs = analyseBlock countTxOutputs

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBAnalyser/Block/Shelley.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE RecordWildCards      #-}
+{-# LANGUAGE NamedFieldPuns       #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeApplications     #-}
 {-# LANGUAGE TypeFamilies         #-}
@@ -89,7 +89,7 @@ instance HasProtocolInfo (ShelleyBlock (TPraos StandardCrypto) StandardShelley)
       }
     deriving (Show)
 
-  mkProtocolInfo ShelleyBlockArgs {..}  = do
+  mkProtocolInfo ShelleyBlockArgs{configFileShelley, initialNonce} = do
     config <- either (error . show) return =<<
       Aeson.eitherDecodeFileStrict' configFileShelley
     return $ mkShelleyProtocolInfo config initialNonce

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBAnalyser/Run.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Tools.DBAnalyser.Run (analyse) where
@@ -56,7 +55,7 @@ analyse ::
   => DBAnalyserConfig
   -> Args blk
   -> IO (Maybe AnalysisResult)
-analyse DBAnalyserConfig {..} args =
+analyse DBAnalyserConfig{analysis, confLimit, dbDir, selectDB, validation, verbose} args =
     withRegistry $ \registry -> do
 
       chainDBTracer  <- mkTracer verbose
@@ -96,7 +95,7 @@ analyse DBAnalyserConfig {..} args =
               , db = Left immutableDB
               , registry
               , ledgerDbFS = ledgerDbFS
-              , limit = limit
+              , limit = confLimit
               , tracer = analysisTracer
               }
             tipPoint <- atomically $ ImmutableDB.getTipPoint immutableDB
@@ -110,7 +109,7 @@ analyse DBAnalyserConfig {..} args =
               , db = Right chainDB
               , registry
               , ledgerDbFS = ledgerDbFS
-              , limit = limit
+              , limit = confLimit
               , tracer = analysisTracer
               }
             tipPoint <- atomically $ ChainDB.getTipPoint chainDB

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBAnalyser/Types.hs

@@ -24,7 +24,7 @@ data DBAnalyserConfig = DBAnalyserConfig {
   , validation :: Maybe ValidateBlocks
   , blockType  :: BlockType
   , analysis   :: AnalysisName
-  , limit      :: Limit
+  , confLimit  :: Limit
   }
 
 data ValidateBlocks = ValidateAllBlocks | MinimumBlockValidation

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBSynthesizer/Forging.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 
@@ -46,9 +45,9 @@ import           Cardano.Tools.DBSynthesizer.Types (ForgeLimit (..),
 
 data ForgeState =
   ForgeState {
-    currentSlot  :: {-# UNPACK #-} !SlotNo
-  , forged       :: {-# UNPACK #-} !Word64
-  , currentEpoch :: {-# UNPACK #-} !Word64
+    currentSlot  :: !SlotNo
+  , forged       :: !Word64
+  , currentEpoch :: !Word64
   }
 
 initialForgeState :: ForgeState
@@ -76,14 +75,14 @@ runForge
 runForge epochSize_ opts chainDB blockForging cfg = do
     putStrLn $ "--> epoch size: " ++ show epochSize_
     putStrLn $ "--> will process until: " ++ show opts
-    ForgeState{..} <- go initialForgeState
-    putStrLn $ "--> forged and adopted " ++ show forged ++ " blocks; reached " ++ show currentSlot
-    pure $ ForgeResult $ fromIntegral forged
+    endState <- go initialForgeState
+    putStrLn $ "--> forged and adopted " ++ show (forged endState) ++ " blocks; reached " ++ show (currentSlot endState)
+    pure $ ForgeResult $ fromIntegral $ forged endState
   where
     epochSize = unEpochSize epochSize_
 
     go :: ForgeState -> IO ForgeState
-    go forgeState@ForgeState{..}
+    go forgeState@ForgeState{currentSlot, forged, currentEpoch}
       | forgingDone opts forgeState = pure forgeState
       | otherwise =
         let

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBSynthesizer/Orphans.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE GADTs             #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -32,20 +31,20 @@ instance FromJSON NodeConfigStub where
             <*> v .: "ByronGenesisFile"
 
 instance AdjustFilePaths NodeConfigStub where
-    adjustFilePaths f nc@NodeConfigStub{..} =
+    adjustFilePaths f nc =
         nc {
-            ncsAlonzoGenesisFile    = f ncsAlonzoGenesisFile
-          , ncsShelleyGenesisFile   = f ncsShelleyGenesisFile
-          , ncsByronGenesisFile     = f ncsByronGenesisFile
+            ncsAlonzoGenesisFile    = f $ ncsAlonzoGenesisFile nc
+          , ncsShelleyGenesisFile   = f $ ncsShelleyGenesisFile nc
+          , ncsByronGenesisFile     = f $ ncsByronGenesisFile nc
           }
 
 instance AdjustFilePaths NodeCredentials where
-    adjustFilePaths f nc@NodeCredentials{..} =
+    adjustFilePaths f nc =
         nc {
-            credCertFile  = f <$> credCertFile
-          , credVRFFile   = f <$> credVRFFile
-          , credKESFile   = f <$> credKESFile
-          , credBulkFile  = f <$> credBulkFile
+            credCertFile  = f <$> credCertFile nc
+          , credVRFFile   = f <$> credVRFFile nc
+          , credKESFile   = f <$> credKESFile nc
+          , credBulkFile  = f <$> credBulkFile nc
           }
 
 -- DUPLICATE: mirroring parsers from cardano-node/src/Cardano/Node/Configuration/POM.hs

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBSynthesizer/Run.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE NamedFieldPuns      #-}
-{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Tools.DBSynthesizer.Run (
@@ -50,7 +49,7 @@ initialize
     -> NodeCredentials
     -> DBSynthesizerOptions
     -> IO (Either String (DBSynthesizerConfig, SomeConsensusProtocol))
-initialize NodeFilePaths{..} NodeCredentials{..} synthOptions = do
+initialize NodeFilePaths{nfpConfig, nfpChainDB} creds synthOptions = do
     relativeToConfig :: (FilePath -> FilePath) <-
         (</>) . takeDirectory <$> makeAbsolute nfpConfig
     runExceptT $ do
@@ -60,23 +59,25 @@ initialize NodeFilePaths{..} NodeCredentials{..} synthOptions = do
   where
     initConf :: (FilePath -> FilePath) -> ExceptT String IO DBSynthesizerConfig
     initConf relativeToConfig = do
-        inp                 <- handleIOExceptT show (BS.readFile nfpConfig)
-        confConfigStub      <- adjustFilePaths relativeToConfig <$> readJson inp
-        confShelleyGenesis  <- readFileJson $ ncsShelleyGenesisFile confConfigStub
-        _                   <- hoistEither $ validateGenesis confShelleyGenesis
+        inp             <- handleIOExceptT show (BS.readFile nfpConfig)
+        configStub      <- adjustFilePaths relativeToConfig <$> readJson inp
+        shelleyGenesis  <- readFileJson $ ncsShelleyGenesisFile configStub
+        _               <- hoistEither $ validateGenesis shelleyGenesis
         let
-            confProtocolCredentials = ProtocolFilepaths {
+            protocolCredentials = ProtocolFilepaths {
               byronCertFile         = Nothing
             , byronKeyFile          = Nothing
-            , shelleyKESFile        = credKESFile
-            , shelleyVRFFile        = credVRFFile
-            , shelleyCertFile       = credCertFile
-            , shelleyBulkCredsFile  = credBulkFile
+            , shelleyKESFile        = credKESFile creds
+            , shelleyVRFFile        = credVRFFile creds
+            , shelleyCertFile       = credCertFile creds
+            , shelleyBulkCredsFile  = credBulkFile creds
             }
         pure DBSynthesizerConfig {
-              confDbDir     = nfpChainDB
-            , confOptions   = synthOptions
-            , ..
+              confConfigStub            = configStub
+            , confOptions               = synthOptions
+            , confProtocolCredentials   = protocolCredentials
+            , confShelleyGenesis        = shelleyGenesis
+            , confDbDir                 = nfpChainDB
             }
 
     initProtocol :: (FilePath -> FilePath) -> DBSynthesizerConfig -> ExceptT String IO SomeConsensusProtocol
@@ -110,7 +111,7 @@ eitherParseJson v = case fromJSON v of
     Success a -> Right a
 
 synthesize :: DBSynthesizerConfig -> SomeConsensusProtocol -> IO ForgeResult
-synthesize DBSynthesizerConfig{confOptions = DBSynthesizerOptions {..}, ..} (SomeConsensusProtocol _ runP) =
+synthesize DBSynthesizerConfig{confOptions, confShelleyGenesis, confDbDir} (SomeConsensusProtocol _ runP) =
     withRegistry $ \registry -> do
         let
             epochSize   = sgEpochLength confShelleyGenesis
@@ -135,6 +136,10 @@ synthesize DBSynthesizerConfig{confOptions = DBSynthesizerOptions {..}, ..} (Som
                 putStrLn "--> no forgers found; leaving possibly existing ChainDB untouched"
                 pure $ ForgeResult 0
   where
+    DBSynthesizerOptions
+        { synthForceDBRemoval
+        , synthLimit
+        } = confOptions
     ProtocolInfo
         { pInfoConfig
         , pInfoBlockForging

ouroboros-consensus-cardano-tools/test/Main.hs

@@ -48,7 +48,7 @@ testAnalyserConfig =
     , validation  = Just ValidateAllBlocks
     , blockType   = CardanoBlock (Cardano.CardanoBlockArgs nodeConfig Nothing)
     , analysis    = CountBlocks
-    , limit       = Unlimited
+    , confLimit   = Unlimited
     }
 
 multiStepTest :: (String -> IO ()) -> Assertion