fourmolu everything

Author: nfrisby

analysis/sims/trace-processor/src/Leios/Tracing/Cpu.hs

@@ -21,8 +21,7 @@ import System.IO (IOMode (WriteMode), hClose, hPutStrLn, openFile)
 
 import qualified Data.Text as T (unpack)
 
-data ItemKey
-  = ItemKey
+data ItemKey = ItemKey
   { slot :: Int
   , node :: Text
   , task :: Text

analysis/sims/trace-processor/src/Leios/Tracing/Lifecycle.hs

@@ -28,15 +28,13 @@ import qualified Data.Map.Strict as M (elems, fromList, insertWith, restrictKeys
 import qualified Data.Set as S (map, singleton)
 import qualified Data.Text as T (unpack)
 
-data ItemKey
-  = ItemKey
+data ItemKey = ItemKey
   { kind :: Text
   , item :: Text
   }
   deriving (Eq, Ord, Show)
 
-data ItemInfo
-  = ItemInfo
+data ItemInfo = ItemInfo
   { size :: Minimum Int
   , references :: Sum Int
   , created :: Minimum Double

analysis/sims/trace-processor/src/Leios/Tracing/Receipt.hs

@@ -26,15 +26,13 @@ import System.IO (IOMode (WriteMode), hClose, hPutStrLn, openFile)
 import qualified Data.Map.Strict as M (insertWith, (!))
 import qualified Data.Text as T (unpack)
 
-data ItemKey
-  = ItemKey
+data ItemKey = ItemKey
   { kind :: Text
   , item :: Text
   }
   deriving (Eq, Ord, Show)
 
-data ItemInfo
-  = ItemInfo
+data ItemInfo = ItemInfo
   { producer :: Text
   , sent :: Minimum Double
   , size :: Maximum Double

analysis/sims/trace-processor/src/Leios/Tracing/Resource.hs

@@ -25,15 +25,13 @@ import Leios.Tracing.Util (Maximum (..))
 import qualified Data.Map.Strict as M (insertWith, map, mapKeysWith, toList)
 import qualified Data.Text as T (unpack)
 
-data ItemKey'
-  = ItemKey'
+data ItemKey' = ItemKey'
   { slot' :: Int
   , node' :: Text
   }
   deriving (Eq, Ord, Show)
 
-data ItemInfo'
-  = ItemInfo'
+data ItemInfo' = ItemInfo'
   { egress' :: Sum Double
   , disk' :: Sum Double
   , cpu' :: Sum Double
@@ -58,14 +56,12 @@ instance Monoid ItemInfo' where
 
 type Index' = Map ItemKey' ItemInfo'
 
-newtype ItemKey
-  = ItemKey
+newtype ItemKey = ItemKey
   { node :: Text
   }
   deriving (Eq, Ord, Show)
 
-data ItemInfo
-  = ItemInfo
+data ItemInfo = ItemInfo
   { egress :: Sum Double
   , disk :: Sum Double
   , totalCpu :: Sum Double

leios-trace-verifier/hs-src/test/Spec/Transition.hs

@@ -23,8 +23,7 @@ import qualified Data.Set as S
 import qualified Data.Text as T
 import qualified Spec.Scenario as Scenario (config, idOther, idSut)
 
-data TracingContext
-  = TracingContext
+data TracingContext = TracingContext
   { _clock :: Time
   , _slotNo :: SlotNo
   , _rbs :: Map Text Text

simulation/src/Chan/Mux.hs

@@ -28,9 +28,9 @@ import Control.Monad (forM_, forever)
 import Control.Monad.Class.MonadFork (MonadFork (forkIO))
 import Control.Tracer (Tracer (Tracer), traceWith)
 import Data.Array (Array, listArray, (!))
-import Data.Kind
 import Data.Foldable (traverse_)
 import Data.Functor.Const (Const (Const), getConst)
+import Data.Kind
 import STMCompat
 
 class ConnectionBundle bundle where
@@ -48,8 +48,7 @@ class ConnectionBundle bundle where
 -- 'toBundleMsg'. For example, a valid implementation would be:
 --
 -- > ToFromBundleMsg toDynamic (fromJust . fromDynamic)
-data ToFromBundleMsg mm a
-  = ToFromBundleMsg
+data ToFromBundleMsg mm a = ToFromBundleMsg
   { toBundleMsg :: a -> mm
   , fromBundleMsg :: mm -> a
   }
@@ -68,9 +67,10 @@ data BorneMsg a = BorneMsg !Int a
 -- The mini protocols never see this, so this type is not exported. It does
 -- occur in the argument types of some exported functions, but the caller
 -- should be using parametric functions to generate those arguments.
-data BearerMsg a = BearerMsg !Bytes [BorneMsg a]
-  -- ^ the cumulative size of the slices the borne messages whose /final/ slice
-  -- is in this message
+data BearerMsg a
+  = -- | the cumulative size of the slices the borne messages whose /final/ slice
+    -- is in this message
+    BearerMsg !Bytes [BorneMsg a]
 
 instance MessageSize (BearerMsg a) where
   messageSizeBytes (BearerMsg sz _) = 1 + sz
@@ -140,7 +140,7 @@ newMuxChanSingle
             takeMVar sendLock
             atomically $
               writeTQueue sendQueue $
-              (sendLock, messageSizeBytes bundleMsg, muxmsg)
+                (sendLock, messageSizeBytes bundleMsg, muxmsg)
         }
 
 data RecvQueue m mm where
@@ -167,20 +167,20 @@ muxer ::
   TQueue m (MVar m (), Bytes, BorneMsg (BundleMsg bundle)) ->
   m ()
 muxer bearer sendQueue =
-    forever $ do
-      x <- atomically (readTQueue sendQueue)
-      (muxmsg, locks) <- go 0 [] [] x
-      mapM_ (flip putMVar ()) locks
-      writeChan bearer muxmsg
-  where
-    --- from ouroboros-network's @Network.Mux.Bearer.makeSocketBearer'@
-    sliceBytes = 12288
-    loafBytes = 131072
-
-    go !accBytes acc locks (lock, bytes, msg) = do
-      let !accBytes' = accBytes + min sliceBytes bytes
-      (acc', locks') <-
-        if bytes <= sliceBytes
+  forever $ do
+    x <- atomically (readTQueue sendQueue)
+    (muxmsg, locks) <- go 0 [] [] x
+    mapM_ (flip putMVar ()) locks
+    writeChan bearer muxmsg
+ where
+  --- from ouroboros-network's @Network.Mux.Bearer.makeSocketBearer'@
+  sliceBytes = 12288
+  loafBytes = 131072
+
+  go !accBytes acc locks (lock, bytes, msg) = do
+    let !accBytes' = accBytes + min sliceBytes bytes
+    (acc', locks') <-
+      if bytes <= sliceBytes
         then do
           -- We do not release the lock before finalizing the loaf because a
           -- single loaf should include slices from at most one borne message
@@ -192,8 +192,10 @@ muxer bearer sendQueue =
           atomically $ writeTQueue sendQueue (lock, bytes', msg)
           pure (acc, locks)
 
-      let result = (BearerMsg accBytes' acc', locks')
-      if accBytes' >= loafBytes then pure result else do
+    let result = (BearerMsg accBytes' acc', locks')
+    if accBytes' >= loafBytes
+      then pure result
+      else do
         atomically (tryReadTQueue sendQueue) >>= \case
           Nothing -> pure result
           Just x -> go accBytes' acc' locks' x

simulation/src/Chan/TCP.hs

@@ -38,8 +38,8 @@ data LabelTcpDir e = DirClientToServer e | DirServerToClient e
 
 lensLabelTcpDir :: Functor f => (a -> f b) -> LabelTcpDir a -> f (LabelTcpDir b)
 lensLabelTcpDir f = \case
-    DirClientToServer x -> DirClientToServer <$> f x
-    DirServerToClient x -> DirServerToClient <$> f x
+  DirClientToServer x -> DirClientToServer <$> f x
+  DirServerToClient x -> DirServerToClient <$> f x
 
 -- | Class for messages to be sent over a simulated TCP connection.
 -- To correctly model the timing of the messages sent over the connection we

simulation/src/LeiosProtocol/RelayBuffer.hs

@@ -22,8 +22,7 @@ import Data.Word (Word64)
 ---- Relay Buffer
 --------------------------------
 
-data RelayBuffer key value
-  = RelayBuffer
+data RelayBuffer key value = RelayBuffer
   { entries :: !(FingerTree TicketRange (EntryWithTicket key value))
   , index :: !(Map key Ticket)
   , nextTicket :: !Ticket

simulation/src/LeiosProtocol/Short.hs

@@ -96,7 +96,10 @@ data RelayDiffusionConfig = RelayDiffusionConfig
   , maxBodiesToRequest :: !Word16
   }
 
-data LeiosConfig = forall p. IsPipeline p => LeiosConfig
+data LeiosConfig
+  = forall p.
+  IsPipeline p =>
+  LeiosConfig
   { praos :: PraosConfig RankingBlockBody
   , pipeline :: SingPipeline p
   , sliceLength :: Int
@@ -230,7 +233,8 @@ convertConfig disk =
   certificateSize (Certificate votesMap) =
     fromIntegral $
       disk.certSizeBytesConstant
-        + disk.certSizeBytesPerNode `forEachKey` votesMap
+        + disk.certSizeBytesPerNode
+          `forEachKey` votesMap
   sizes =
     SizesConfig
       { inputBlockHeader = fromIntegral disk.ibHeadSizeBytes
@@ -240,27 +244,32 @@ convertConfig disk =
       , endorseBlock = \eb ->
           fromIntegral $
             disk.ebSizeBytesConstant
-              + disk.ebSizeBytesPerIb `forEach` eb.inputBlocks
+              + disk.ebSizeBytesPerIb
+                `forEach` eb.inputBlocks
               -- TODO: make it a per-ref field.
-              + disk.ebSizeBytesPerIb `forEach` eb.endorseBlocksEarlierPipeline
+              + disk.ebSizeBytesPerIb
+                `forEach` eb.endorseBlocksEarlierPipeline
       , voteMsg = \vt ->
           fromIntegral $
             disk.voteBundleSizeBytesConstant
-              + disk.voteBundleSizeBytesPerEb `forEach` vt.endorseBlocks
+              + disk.voteBundleSizeBytesPerEb
+                `forEach` vt.endorseBlocks
       , certificate = \_cert ->
           fromIntegral $
-            assert (0 == disk.certSizeBytesPerNode) $   -- TODO
+            assert (0 == disk.certSizeBytesPerNode) $ -- TODO
               disk.certSizeBytesConstant
       , rankingBlockLegacyPraosPayloadAvgSize = fromIntegral disk.rbBodyLegacyPraosPayloadAvgSizeBytes
       }
   certificateGeneration (Certificate votesMap) =
     durationMsToDiffTime $
       disk.certGenerationCpuTimeMsConstant
-        + disk.certGenerationCpuTimeMsPerNode `forEachKey` votesMap
+        + disk.certGenerationCpuTimeMsPerNode
+          `forEachKey` votesMap
   certificateValidation (Certificate votesMap) =
     durationMsToDiffTime $
       disk.certValidationCpuTimeMsConstant
-        + disk.certValidationCpuTimeMsPerNode `forEachKey` votesMap
+        + disk.certValidationCpuTimeMsPerNode
+          `forEachKey` votesMap
   delays =
     LeiosDelays
       { inputBlockGeneration = const $ durationMsToDiffTime disk.ibGenerationCpuTimeMs
@@ -282,13 +291,14 @@ convertConfig disk =
             durationMsToDiffTime $
               sum
                 [ disk.voteGenerationCpuTimeMsConstant
-                  + disk.voteGenerationCpuTimeMsPerIb `forEach` eb.inputBlocks
+                  + disk.voteGenerationCpuTimeMsPerIb
+                    `forEach` eb.inputBlocks
                 | eb <- ebs
                 ]
       , linearVoteMsgGeneration = \vm ibs ->
           assert (1 == length vm.endorseBlocks) $
             assert (vm.endorseBlocks == map (convertLinearId . (.id)) ibs) $
-              assert (0 == disk.voteGenerationCpuTimeMsPerTx) $   -- TODO
+              assert (0 == disk.voteGenerationCpuTimeMsPerTx) $ -- TODO
                 durationMsToDiffTime $
                   disk.voteGenerationCpuTimeMsConstant `forEach` ibs
       , voteMsgValidation = \vm ->
@@ -343,12 +353,12 @@ delaysAndSizesAsFull cfg@LeiosConfig{pipeline, voteSendStage} =
     , let EndorseBlock{..} = fullEB
     ]
   fullLinearEBsVotedFor =
-    [ InputBlock {
-        body = fullIB.body
-        , header =
+    [ InputBlock
+      { body = fullIB.body
+      , header =
           let InputBlockHeader{..} = fullIB.header
-          in InputBlockHeader {id = unconvertLinearId id', ..}
-        }
+           in InputBlockHeader{id = unconvertLinearId id', ..}
+      }
     | id' <- fullVT.endorseBlocks
     ]
   fullRB = mockFullRankingBlock cfg

simulation/src/LeiosProtocol/Short/Generate.hs

@@ -38,10 +38,11 @@ data BuffersView m = BuffersView
   }
 
 data Role :: Type -> Type where
-  Base :: Role (Either (Chain RankingBlock, RankingBlock) InputBlock)
-  -- ^ For Linear Leios, we have two 'Base' roles: one for 'Left' and one for 'Right'.
-  --
-  -- In Short or Full Leios, it's only the 'Left' role.
+  Base ::
+    -- | For Linear Leios, we have two 'Base' roles: one for 'Left' and one for 'Right'.
+    --
+    -- In Short or Full Leios, it's only the 'Left' role.
+    Role (Either (Chain RankingBlock, RankingBlock) InputBlock)
   Propose :: {ibSlot :: Maybe SlotNo, delay :: Maybe DiffTime} -> Role InputBlock
   Endorse :: Role EndorseBlock
   Vote :: Role VoteMsg