Skip to content

Commit 2353364

Browse files
committed
Add fourmolu code formatter
1 parent ee88b07 commit 2353364

File tree

157 files changed

+14968
-13000
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

157 files changed

+14968
-13000
lines changed

cardano-chain-gen/src/Cardano/Mock/Chain.hs

Lines changed: 65 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -2,30 +2,29 @@
22
{-# LANGUAGE RankNTypes #-}
33
{-# LANGUAGE ScopedTypeVariables #-}
44

5-
module Cardano.Mock.Chain
6-
( Chain' (..)
7-
, State
8-
, Chain
9-
, getTipState
10-
, successorBlock
11-
, pointOnChain
12-
, rollback
13-
, findFirstPointChain
14-
, pointIsAfter
15-
, findFirstPointByBlockNo
16-
, currentTipBlockNo
17-
) where
18-
19-
import Ouroboros.Consensus.Block
5+
module Cardano.Mock.Chain (
6+
Chain' (..),
7+
State,
8+
Chain,
9+
getTipState,
10+
successorBlock,
11+
pointOnChain,
12+
rollback,
13+
findFirstPointChain,
14+
pointIsAfter,
15+
findFirstPointByBlockNo,
16+
currentTipBlockNo,
17+
) where
18+
19+
import Ouroboros.Consensus.Block
2020
import qualified Ouroboros.Consensus.Ledger.Extended as Consensus
21-
2221
import qualified Ouroboros.Network.AnchoredFragment as AF
23-
import Ouroboros.Network.Block
22+
import Ouroboros.Network.Block
2423

2524
-- | This looks a lot like the 'Chain' defined in Ouroboros.Network.MockChain.Chain
2625
-- but this version includes also the ledger states.
27-
data Chain' block st =
28-
Genesis st
26+
data Chain' block st
27+
= Genesis st
2928
| Chain' block st :> (block, st)
3029
deriving (Eq, Ord, Show, Functor)
3130

@@ -39,44 +38,47 @@ getTipState :: Chain' blk st -> st
3938
getTipState (Genesis st) = st
4039
getTipState (_ :> (_, st)) = st
4140

42-
successorBlock :: forall block . HasHeader block => Point block -> Chain block -> Maybe block
41+
successorBlock :: forall block. HasHeader block => Point block -> Chain block -> Maybe block
4342
successorBlock p c0 | headPoint c0 == p = Nothing
4443
successorBlock p c0 =
45-
go c0
44+
go c0
4645
where
4746
go :: Chain block -> Maybe block
48-
go (c :> (b',st') :> (b, _)) | blockPoint b' == p = Just b
49-
| otherwise = go (c :> (b',st'))
50-
go (Genesis _ :> (b, _)) | p == genesisPoint = Just b
47+
go (c :> (b', st') :> (b, _))
48+
| blockPoint b' == p = Just b
49+
| otherwise = go (c :> (b', st'))
50+
go (Genesis _ :> (b, _)) | p == genesisPoint = Just b
5151
go _ = Nothing
5252

5353
pointOnChain :: HasHeader block => Point block -> Chain block -> Bool
54-
pointOnChain GenesisPoint _ = True
55-
pointOnChain (BlockPoint _ _) (Genesis _) = False
54+
pointOnChain GenesisPoint _ = True
55+
pointOnChain (BlockPoint _ _) (Genesis _) = False
5656
pointOnChain p@(BlockPoint pslot phash) (c :> (b, _))
57-
| pslot > blockSlot b = False
57+
| pslot > blockSlot b = False
5858
| phash == blockHash b = True
59-
| otherwise = pointOnChain p c
59+
| otherwise = pointOnChain p c
6060

6161
headPoint :: HasHeader block => Chain block -> Point block
6262
headPoint (Genesis _) = genesisPoint
63-
headPoint (_ :> (b, _)) = blockPoint b
64-
65-
findFirstPointChain
66-
:: HasHeader block
67-
=> [Point block]
68-
-> Chain block
69-
-> Maybe (Point block)
70-
findFirstPointChain [] _ = Nothing
71-
findFirstPointChain (p:ps) c
72-
| pointOnChain p c = Just p
73-
| otherwise = findFirstPointChain ps c
63+
headPoint (_ :> (b, _)) = blockPoint b
64+
65+
findFirstPointChain ::
66+
HasHeader block =>
67+
[Point block] ->
68+
Chain block ->
69+
Maybe (Point block)
70+
findFirstPointChain [] _ = Nothing
71+
findFirstPointChain (p : ps) c
72+
| pointOnChain p c = Just p
73+
| otherwise = findFirstPointChain ps c
7474

7575
rollback :: HasHeader block => Chain block -> Point block -> Maybe (Chain block)
76-
rollback (c :> (b, st)) p | blockPoint b == p = Just (c :> (b, st))
77-
| otherwise = rollback c p
78-
rollback (Genesis st) p | p == genesisPoint = Just (Genesis st)
79-
| otherwise = Nothing
76+
rollback (c :> (b, st)) p
77+
| blockPoint b == p = Just (c :> (b, st))
78+
| otherwise = rollback c p
79+
rollback (Genesis st) p
80+
| p == genesisPoint = Just (Genesis st)
81+
| otherwise = Nothing
8082

8183
-- | Check whether the first point is after the second point on the chain.
8284
-- Usually, this can simply be checked using the 'SlotNo's, but some blocks
@@ -85,16 +87,21 @@ rollback (Genesis st) p | p == genesisPoint = Just (Genesis st)
8587
-- When the first point equals the second point, the answer will be 'False'.
8688
--
8789
-- PRECONDITION: both points are on the chain.
88-
pointIsAfter :: HasHeader block
89-
=> Point block -> Point block -> Chain block -> Bool
90+
pointIsAfter ::
91+
HasHeader block =>
92+
Point block ->
93+
Point block ->
94+
Chain block ->
95+
Bool
9096
pointIsAfter pt1 pt2 c =
91-
case pointSlot pt1 `compare` pointSlot pt2 of
92-
LT -> False
93-
GT -> True
94-
EQ | Just (_, afterPt2) <- AF.splitAfterPoint (toAnchoredFragment c) pt2
95-
-> AF.pointOnFragment pt1 afterPt2
96-
| otherwise
97-
-> False
97+
case pointSlot pt1 `compare` pointSlot pt2 of
98+
LT -> False
99+
GT -> True
100+
EQ
101+
| Just (_, afterPt2) <- AF.splitAfterPoint (toAnchoredFragment c) pt2 ->
102+
AF.pointOnFragment pt1 afterPt2
103+
| otherwise ->
104+
False
98105

99106
-- * Conversions to/from 'AnchoredFragment'
100107

@@ -109,19 +116,18 @@ toOldestFirst :: Chain block -> [block]
109116
toOldestFirst = reverse . toNewestFirst
110117

111118
-- | Produce the list of blocks, from most recent back to genesis
112-
--
113119
toNewestFirst :: Chain block -> [block]
114120
toNewestFirst = foldChain (flip (:)) []
115121

116122
foldChain :: (a -> b -> a) -> a -> Chain b -> a
117123
foldChain _blk gen (Genesis _st) = gen
118-
foldChain blk gen (c :> (b, _)) = blk (foldChain blk gen c) b
124+
foldChain blk gen (c :> (b, _)) = blk (foldChain blk gen c) b
119125

120-
findFirstPointByBlockNo
121-
:: HasHeader block
122-
=> Chain block
123-
-> BlockNo
124-
-> Maybe (Point block)
126+
findFirstPointByBlockNo ::
127+
HasHeader block =>
128+
Chain block ->
129+
BlockNo ->
130+
Maybe (Point block)
125131
findFirstPointByBlockNo c blkNo = case c of
126132
Genesis _ -> Nothing
127133
(_ :> (b, _)) | blockNo b == blkNo -> Just $ blockPoint b

cardano-chain-gen/src/Cardano/Mock/ChainDB.hs

Lines changed: 20 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -4,28 +4,26 @@
44
{-# LANGUAGE MonoLocalBinds #-}
55
{-# LANGUAGE UndecidableInstances #-}
66

7-
module Cardano.Mock.ChainDB
8-
( ChainDB (..)
9-
, initChainDB
10-
, headTip
11-
, currentState
12-
, replaceGenesisDB
13-
, extendChainDB
14-
, findFirstPoint
15-
, rollbackChainDB
16-
, findPointByBlockNo
17-
, currentBlockNo
18-
) where
19-
20-
import Ouroboros.Consensus.Block
21-
import Ouroboros.Consensus.Config
22-
import Ouroboros.Consensus.Ledger.Abstract
7+
module Cardano.Mock.ChainDB (
8+
ChainDB (..),
9+
initChainDB,
10+
headTip,
11+
currentState,
12+
replaceGenesisDB,
13+
extendChainDB,
14+
findFirstPoint,
15+
rollbackChainDB,
16+
findPointByBlockNo,
17+
currentBlockNo,
18+
) where
19+
20+
import Cardano.Mock.Chain
21+
import Ouroboros.Consensus.Block
22+
import Ouroboros.Consensus.Config
23+
import Ouroboros.Consensus.Ledger.Abstract
2324
import qualified Ouroboros.Consensus.Ledger.Extended as Consensus
24-
import Ouroboros.Consensus.Ledger.SupportsProtocol
25-
26-
import Ouroboros.Network.Block (Tip (..))
27-
28-
import Cardano.Mock.Chain
25+
import Ouroboros.Consensus.Ledger.SupportsProtocol
26+
import Ouroboros.Network.Block (Tip (..))
2927

3028
-- | Thin layer around 'Chain' that knows how to apply blocks and maintain
3129
-- new and old states. The state here, which is the 'Chain', is not a MVar,
@@ -73,7 +71,7 @@ findFirstPoint points chainDB = findFirstPointChain points (cchain chainDB)
7371
rollbackChainDB :: HasHeader block => ChainDB block -> Point block -> Maybe (ChainDB block)
7472
rollbackChainDB chainDB p = do
7573
chain <- rollback (cchain chainDB) p
76-
Just $ chainDB { cchain = chain}
74+
Just $ chainDB {cchain = chain}
7775

7876
findPointByBlockNo :: HasHeader block => ChainDB block -> BlockNo -> Maybe (Point block)
7977
findPointByBlockNo chainDB =

0 commit comments

Comments
 (0)