Skip to content

Commit 6fbfe64

Browse files
zeme-wanazeme-wana
committed
Apply fourmolu to the codebase
1 parent ac7745e commit 6fbfe64

File tree

864 files changed

+63548
-56858
lines changed

Some content is hidden

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

864 files changed

+63548
-56858
lines changed

‎.stylish-haskell.yaml‎

Lines changed: 0 additions & 33 deletions
This file was deleted.

‎cardano-constitution/src/Cardano/Constitution/Config.hs‎

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,12 @@
1-
{-# LANGUAGE LambdaCase #-}
2-
{-# LANGUAGE RankNTypes #-}
1+
{-# LANGUAGE LambdaCase #-}
2+
{-# LANGUAGE RankNTypes #-}
33
{-# LANGUAGE TemplateHaskell #-}
4-
module Cardano.Constitution.Config
5-
( defaultConstitutionConfig
6-
, defaultPredMeanings
7-
, module Export
8-
) where
4+
5+
module Cardano.Constitution.Config (
6+
defaultConstitutionConfig,
7+
defaultPredMeanings,
8+
module Export,
9+
) where
910

1011
import Cardano.Constitution.Config.Instance.FromJSON ()
1112
import Cardano.Constitution.Config.Instance.TxLift ()
@@ -19,12 +20,12 @@ import Data.Aeson.THReader as Aeson
1920
-- | The default config read from "data/defaultConstitution.json"
2021
defaultConstitutionConfig :: ConstitutionConfig
2122
defaultConstitutionConfig = $$(Aeson.readJSONFromFile DFP.defaultConstitutionConfigFile)
22-
{-# INLINABLE defaultConstitutionConfig #-}
23+
{-# INLINEABLE defaultConstitutionConfig #-}
2324

2425
-- | NOTE: **BE CAREFUL** of the ordering. Expected value is first arg, Proposed Value is second arg
2526
defaultPredMeanings :: PredKey -> PredMeaning a
2627
defaultPredMeanings = \case
27-
MinValue -> (Tx.<=)
28-
MaxValue -> (Tx.>=)
29-
NotEqual -> (Tx./=)
30-
{-# INLINABLE defaultPredMeanings #-}
28+
MinValue -> (Tx.<=)
29+
MaxValue -> (Tx.>=)
30+
NotEqual -> (Tx./=)
31+
{-# INLINEABLE defaultPredMeanings #-}

‎cardano-constitution/src/Cardano/Constitution/Config/Instance/FromJSON.hs‎

Lines changed: 100 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,10 @@
1+
{-# LANGUAGE LambdaCase #-}
12
-- editorconfig-checker-disable-file
23
{-# LANGUAGE OverloadedStrings #-}
3-
{-# LANGUAGE TypeApplications #-}
4+
{-# LANGUAGE TypeApplications #-}
5+
{-# LANGUAGE ViewPatterns #-}
46
{-# OPTIONS_GHC -Wno-orphans #-}
5-
{-# LANGUAGE LambdaCase #-}
6-
{-# LANGUAGE ViewPatterns #-}
7+
78
module Cardano.Constitution.Config.Instance.FromJSON () where
89

910
import Cardano.Constitution.Config.Types
@@ -24,135 +25,141 @@ import Text.Regex.TDFA as Rx
2425

2526
-- | Replica ADTs of ParamValue & ConstitutionConfig , specialised only for FromJSON.
2627
-- Alternatively, we could generalise the aforementationed ADTs (needs barbies, breaks TxLifting)
27-
data RawParamValue =
28-
RawParamInteger (Predicates Integer)
29-
| RawParamRational (Predicates Tx.Rational)
30-
| RawParamList (M.Map Integer RawParamValue)
31-
| RawParamAny
28+
data RawParamValue
29+
= RawParamInteger (Predicates Integer)
30+
| RawParamRational (Predicates Tx.Rational)
31+
| RawParamList (M.Map Integer RawParamValue)
32+
| RawParamAny
33+
3234
newtype RawConstitutionConfig = RawConstitutionConfig (M.Map Integer RawParamValue)
3335

3436
-- TODO: move to deriving-aeson
3537
instance FromJSON PredKey where
36-
parseJSON = genericParseJSON (defaultOptions { constructorTagModifier = lowerInitialChar })
38+
parseJSON = genericParseJSON (defaultOptions {constructorTagModifier = lowerInitialChar})
3739

3840
-- TODO: move to deriving-aeson
3941
instance Aeson.FromJSONKey PredKey where
40-
fromJSONKey = genericFromJSONKey (defaultJSONKeyOptions { keyModifier = lowerInitialChar })
42+
fromJSONKey = genericFromJSONKey (defaultJSONKeyOptions {keyModifier = lowerInitialChar})
4143

4244
instance FromJSON a => FromJSON (Predicates a) where
43-
parseJSON val = do
44-
-- TODO: ugly code, refactor
45-
ms <- parseJSON @[Object] val
46-
-- filter out "$comment" from all keymaps
47-
let ms' = fmap (Object . Aeson.delete commentKey) ms
48-
-- re-parse correctly this time
49-
m <- parseJSON @[M.Map PredKey a] (Aeson.Array $ fromList ms')
50-
when (any ((/= 1) . length) m) $
51-
fail "Only one predicate-key per predicate inside the predicate list"
52-
pure $ Predicates $
53-
-- using toAscList here ensures that the inner map is sorted
54-
M.toAscList
55-
-- combine the duplicate predicates into a list of predicate values
56-
-- entries with same key combine their values with (++)
57-
$ M.unionsWith (<>)
58-
$ fmap (fmap pure) m
45+
parseJSON val = do
46+
-- TODO: ugly code, refactor
47+
ms <- parseJSON @[Object] val
48+
-- filter out "$comment" from all keymaps
49+
let ms' = fmap (Object . Aeson.delete commentKey) ms
50+
-- re-parse correctly this time
51+
m <- parseJSON @[M.Map PredKey a] (Aeson.Array $ fromList ms')
52+
when (any ((/= 1) . length) m) $
53+
fail "Only one predicate-key per predicate inside the predicate list"
54+
pure $
55+
Predicates $
56+
-- using toAscList here ensures that the inner map is sorted
57+
M.toAscList
58+
-- combine the duplicate predicates into a list of predicate values
59+
-- entries with same key combine their values with (++)
60+
$
61+
M.unionsWith (<>) $
62+
fmap (fmap pure) m
5963

6064
instance FromJSON ConstitutionConfig where
61-
parseJSON =
62-
parseJSON -- first pass, parse raw
63-
>=>
64-
fromRaw -- second pass, flatten maps to lists, and check for contiguity
65+
parseJSON =
66+
parseJSON -- first pass, parse raw
67+
>=> fromRaw -- second pass, flatten maps to lists, and check for contiguity
6568

6669
-- 1st pass
6770
instance FromJSON RawConstitutionConfig where
68-
parseJSON = fmap RawConstitutionConfig
69-
. withObject "RawConstitutionConfig" (foldlM insertParam mempty . Aeson.toAscList)
71+
parseJSON =
72+
fmap RawConstitutionConfig
73+
. withObject "RawConstitutionConfig" (foldlM insertParam mempty . Aeson.toAscList)
7074
where
7175
insertParam acc (outerKey, outerValue) = do
72-
(index, msubIndex) <- parseParamKey outerKey
73-
when (index < 0) $ fail "Negative Integer ParamKey given"
74-
paramValue <- parseParamValue msubIndex outerValue
75-
-- flipped version of Lens.at
76-
M.alterF (\case
77-
Nothing -> pure $ Just paramValue
78-
Just paramValue' -> Just <$> mergeParamValues paramValue' paramValue
79-
) index acc
76+
(index, msubIndex) <- parseParamKey outerKey
77+
when (index < 0) $ fail "Negative Integer ParamKey given"
78+
paramValue <- parseParamValue msubIndex outerValue
79+
-- flipped version of Lens.at
80+
M.alterF
81+
( \case
82+
Nothing -> pure $ Just paramValue
83+
Just paramValue' -> Just <$> mergeParamValues paramValue' paramValue
84+
)
85+
index
86+
acc
8087

8188
-- second pass, flatten maps to lists, and check for contiguity
8289
fromRaw :: MonadFail m => RawConstitutionConfig -> m ConstitutionConfig
8390
fromRaw (RawConstitutionConfig rc) = ConstitutionConfig . M.toAscList <$> traverse flattenParamValue rc
8491
where
8592
flattenParamValue :: MonadFail m => RawParamValue -> m ParamValue
8693
flattenParamValue = \case
87-
RawParamList m -> do
88-
-- This is the CONTIGUOUS check.
89-
when (not $ M.keys m `isPrefixOf` [0..]) $ fail "The sub-indices are not in order."
90-
-- the M.elems will be in ascending order
91-
ParamList <$> traverse flattenParamValue (M.elems m)
92-
-- boilerplate follows
93-
RawParamInteger x -> pure $ ParamInteger x
94-
RawParamRational x -> pure $ ParamRational x
95-
RawParamAny -> pure ParamAny
94+
RawParamList m -> do
95+
-- This is the CONTIGUOUS check.
96+
when (not $ M.keys m `isPrefixOf` [0 ..]) $ fail "The sub-indices are not in order."
97+
-- the M.elems will be in ascending order
98+
ParamList <$> traverse flattenParamValue (M.elems m)
99+
-- boilerplate follows
100+
RawParamInteger x -> pure $ ParamInteger x
101+
RawParamRational x -> pure $ ParamRational x
102+
RawParamAny -> pure ParamAny
96103

97104
-- MAYBE: use instead attoparsec-aeson.jsonWith/jsonNoDup to fail on parsing duplicate Keys,
98105
-- because right now Aeson silently ignores duplicated param entries (arbitrarily picks the last of duplicates)
99106
parseParamKey :: Aeson.Key -> Aeson.Parser (Integer, Maybe Integer)
100107
parseParamKey (Aeson.toString -> s) = do
101-
-- MAYBE: fetch the regex pattern from the schema itself, it is easy
102-
[[_, indexS,_,subIndexS]] :: [[String]] <- s Rx.=~~ ("^(0|[1-9][0-9]*)(\\[(0|[1-9][0-9]*)\\])?$" :: String)
103-
indexI <- either fail pure $ readEitherSafe indexS
104-
mSubIndexI <-
105-
if null subIndexS
106-
then pure Nothing
107-
else Just <$> either fail pure (readEitherSafe subIndexS)
108-
pure (indexI,mSubIndexI)
108+
-- MAYBE: fetch the regex pattern from the schema itself, it is easy
109+
[[_, indexS, _, subIndexS]] :: [[String]] <- s Rx.=~~ ("^(0|[1-9][0-9]*)(\\[(0|[1-9][0-9]*)\\])?$" :: String)
110+
indexI <- either fail pure $ readEitherSafe indexS
111+
mSubIndexI <-
112+
if null subIndexS
113+
then pure Nothing
114+
else Just <$> either fail pure (readEitherSafe subIndexS)
115+
pure (indexI, mSubIndexI)
109116

110117
-- | If there is a subkey given, treat the param as a paramlist
111118
-- Otherwise, parse it based on the json's "type"
112119
parseParamValue :: Maybe ParamKey -> Value -> Parser RawParamValue
113120
parseParamValue = \case
114-
Nothing -> parseTypedParamValue
115-
-- if we parsed a sub-index, treat the param value as a `M.singleton subIndex value`
116-
Just subIndex -> fmap (RawParamList . M.singleton subIndex) . parseTypedParamValue
121+
Nothing -> parseTypedParamValue
122+
-- if we parsed a sub-index, treat the param value as a `M.singleton subIndex value`
123+
Just subIndex -> fmap (RawParamList . M.singleton subIndex) . parseTypedParamValue
117124
where
118-
parseTypedParamValue :: Value -> Parser RawParamValue
119-
parseTypedParamValue = withObject "RawParamValue" $ \o -> do
120-
ty <- o .: typeKey
121-
parseSynonymType ty o
122-
123-
-- the base types we support
124-
parseBaseType :: Key -> Object -> Parser RawParamValue
125-
parseBaseType ty o = case ty of
126-
"integer" -> RawParamInteger <$> (o .: predicatesKey)
127-
-- NOTE: even if the Tx.Ratio.Rational constructor is not exposed, the 2 arguments to the constructor
128-
-- will be normalized (co-primed) when Tx.lift is called on them.
129-
-- SO there is no speed benefit to statically co-prime them ourselves for efficiency.
130-
"rational" -> RawParamRational <$> (o .: predicatesKey)
131-
"any" -> pure RawParamAny
132-
_ -> fail "invalid type tag"
133-
134-
-- synonyms to ease the transition from cddl
135-
parseSynonymType = \case
136-
"coin" -> parseBaseType "integer"
137-
"uint.size4" -> parseBaseType "integer"
138-
"uint.size2" -> parseBaseType "integer"
139-
"uint" -> parseBaseType "integer" -- For ex units
140-
"epoch_interval" -> parseBaseType "integer" -- Rename of uint.size4
141-
"unit_interval" -> parseBaseType "rational"
142-
"nonnegative_interval" -> parseBaseType "rational"
143-
"costMdls" -> parseBaseType "any"
144-
x -> parseBaseType x -- didn't find synonym, try as basetype
125+
parseTypedParamValue :: Value -> Parser RawParamValue
126+
parseTypedParamValue = withObject "RawParamValue" $ \o -> do
127+
ty <- o .: typeKey
128+
parseSynonymType ty o
129+
130+
-- the base types we support
131+
parseBaseType :: Key -> Object -> Parser RawParamValue
132+
parseBaseType ty o = case ty of
133+
"integer" -> RawParamInteger <$> (o .: predicatesKey)
134+
-- NOTE: even if the Tx.Ratio.Rational constructor is not exposed, the 2 arguments to the constructor
135+
-- will be normalized (co-primed) when Tx.lift is called on them.
136+
-- SO there is no speed benefit to statically co-prime them ourselves for efficiency.
137+
"rational" -> RawParamRational <$> (o .: predicatesKey)
138+
"any" -> pure RawParamAny
139+
_ -> fail "invalid type tag"
140+
141+
-- synonyms to ease the transition from cddl
142+
parseSynonymType = \case
143+
"coin" -> parseBaseType "integer"
144+
"uint.size4" -> parseBaseType "integer"
145+
"uint.size2" -> parseBaseType "integer"
146+
"uint" -> parseBaseType "integer" -- For ex units
147+
"epoch_interval" -> parseBaseType "integer" -- Rename of uint.size4
148+
"unit_interval" -> parseBaseType "rational"
149+
"nonnegative_interval" -> parseBaseType "rational"
150+
"costMdls" -> parseBaseType "any"
151+
x -> parseBaseType x -- didn't find synonym, try as basetype
145152

146153
-- | It is like an `mappend` when both inputs are ParamList's.
147154
mergeParamValues :: MonadFail m => RawParamValue -> RawParamValue -> m RawParamValue
148155
mergeParamValues (RawParamList m1) = \case
149-
RawParamList m2 -> pure $ RawParamList $ m1 <> m2
150-
_ -> fail "param matched with subparam"
156+
RawParamList m2 -> pure $ RawParamList $ m1 <> m2
157+
_ -> fail "param matched with subparam"
151158
mergeParamValues _ = \case
152-
RawParamList _ -> fail "param matched with subparam"
153-
-- in reality this cannot be triggered, because we would then have duplicate params
154-
-- , which default aeson and json allow
155-
_ -> fail "this should not happen"
159+
RawParamList _ -> fail "param matched with subparam"
160+
-- in reality this cannot be triggered, because we would then have duplicate params
161+
-- , which default aeson and json allow
162+
_ -> fail "this should not happen"
156163

157164
predicatesKey, typeKey, commentKey :: Aeson.Key
158165
predicatesKey = "predicates"

‎cardano-constitution/src/Cardano/Constitution/Config/Instance/TxLift.hs‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
1+
{-# LANGUAGE TemplateHaskell #-}
12
{-# LANGUAGE NoImplicitPrelude #-}
2-
{-# LANGUAGE TemplateHaskell #-}
33
{-# OPTIONS_GHC -Wno-orphans #-}
4+
45
module Cardano.Constitution.Config.Instance.TxLift () where
56

67
import Cardano.Constitution.Config.Types
@@ -14,8 +15,9 @@ import PlutusTx.Lift.Class as Tx
1415

1516
Tx.makeLift ''PredKey
1617

17-
deriving newtype instance (Tx.Typeable Tx.DefaultUni predValue, Tx.Lift Tx.DefaultUni predValue)
18-
=> Tx.Lift Tx.DefaultUni (Predicates predValue)
18+
deriving newtype instance
19+
(Tx.Typeable Tx.DefaultUni predValue, Tx.Lift Tx.DefaultUni predValue) =>
20+
Tx.Lift Tx.DefaultUni (Predicates predValue)
1921

2022
Tx.makeTypeable (TH.ConT ''Tx.DefaultUni) ''Predicates
2123
Tx.makeLift ''ParamValue

0 commit comments

Comments
 (0)