Skip to content

Commit 8272a62

Browse files
SoupstrawSoupstraw
committed
Fourmolize again
1 parent 7f2d283 commit 8272a62

File tree

19 files changed

+2916
-2959
lines changed

19 files changed

+2916
-2959
lines changed

‎bin/Main.hs‎

Lines changed: 90 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ module Main (main) where
55
import Codec.CBOR.Cuddle.CBOR.Gen (generateCBORTerm)
66
import Codec.CBOR.Cuddle.CDDL (Name (..), sortCDDL)
77
import Codec.CBOR.Cuddle.CDDL.Resolve (
8-
fullResolveCDDL,
8+
fullResolveCDDL,
99
)
1010
import Codec.CBOR.Cuddle.Parser (pCDDL)
1111
import Codec.CBOR.Cuddle.Pretty ()
@@ -26,127 +26,124 @@ import Text.Megaparsec (ParseErrorBundle, Parsec, errorBundlePretty, runParser)
2626
data Opts = Opts Command String
2727

2828
data Command
29-
= Format FormatOpts
30-
| Validate
31-
| GenerateCBOR GenOpts
29+
= Format FormatOpts
30+
| Validate
31+
| GenerateCBOR GenOpts
3232

3333
-- | Various formats for outputtting CBOR
3434
data CBOROutputFormat
35-
= AsCBOR
36-
| AsPrettyCBOR
37-
| AsTerm
38-
| AsFlatTerm
35+
= AsCBOR
36+
| AsPrettyCBOR
37+
| AsTerm
38+
| AsFlatTerm
3939

4040
pCBOROutputFormat :: ReadM CBOROutputFormat
4141
pCBOROutputFormat = eitherReader $ \case
42-
"cbor" -> Right AsCBOR
43-
"pretty" -> Right AsPrettyCBOR
44-
"term" -> Right AsTerm
45-
"flat" -> Right AsFlatTerm
46-
s -> Left s
42+
"cbor" -> Right AsCBOR
43+
"pretty" -> Right AsPrettyCBOR
44+
"term" -> Right AsTerm
45+
"flat" -> Right AsFlatTerm
46+
s -> Left s
4747

4848
data GenOpts = GenOpts
49-
{ itemName :: T.Text
50-
, outputFormat :: CBOROutputFormat
51-
}
49+
{ itemName :: T.Text
50+
, outputFormat :: CBOROutputFormat
51+
}
5252

5353
pGenOpts :: Parser GenOpts
5454
pGenOpts =
55-
GenOpts
56-
<$> strOption
57-
( long "rule"
58-
<> short 'r'
59-
<> metavar "RULE"
60-
<> help "Name of the CDDL rule to generate a CBOR term for"
61-
)
62-
<*> option
63-
pCBOROutputFormat
64-
( long "format"
65-
<> short 'f'
66-
<> help "Output format"
67-
<> value AsCBOR
68-
)
55+
GenOpts
56+
<$> strOption
57+
( long "rule"
58+
<> short 'r'
59+
<> metavar "RULE"
60+
<> help "Name of the CDDL rule to generate a CBOR term for"
61+
)
62+
<*> option
63+
pCBOROutputFormat
64+
( long "format"
65+
<> short 'f'
66+
<> help "Output format"
67+
<> value AsCBOR
68+
)
6969

7070
newtype FormatOpts = FormatOpts
71-
{sort :: Bool}
71+
{sort :: Bool}
7272

7373
pFormatOpts :: Parser FormatOpts
7474
pFormatOpts =
75-
FormatOpts
76-
<$> switch
77-
( long "sort-rules"
78-
<> help "Sort the CDDL rule definitions before printing."
79-
)
75+
FormatOpts
76+
<$> switch
77+
( long "sort-rules"
78+
<> help "Sort the CDDL rule definitions before printing."
79+
)
8080

8181
opts :: Parser Opts
8282
opts =
83-
Opts
84-
<$> subparser
85-
( command
86-
"format"
87-
( info
88-
(Format <$> pFormatOpts)
89-
( progDesc "Format the provided CDDL file"
90-
)
91-
)
92-
<> command
93-
"validate"
94-
( info
95-
(pure Validate)
96-
( progDesc "Validate the provided CDDL file"
97-
)
98-
)
99-
<> command
100-
"gen"
101-
( info
102-
(GenerateCBOR <$> pGenOpts)
103-
( progDesc "Generate a CBOR term matching the schema"
104-
)
105-
)
83+
Opts
84+
<$> subparser
85+
( command
86+
"format"
87+
( info
88+
(Format <$> pFormatOpts)
89+
(progDesc "Format the provided CDDL file")
90+
)
91+
<> command
92+
"validate"
93+
( info
94+
(pure Validate)
95+
(progDesc "Validate the provided CDDL file")
96+
)
97+
<> command
98+
"gen"
99+
( info
100+
(GenerateCBOR <$> pGenOpts)
101+
(progDesc "Generate a CBOR term matching the schema")
106102
)
107-
<*> argument str (metavar "CDDL_FILE")
103+
)
104+
<*> argument str (metavar "CDDL_FILE")
108105

109106
main :: IO ()
110107
main = do
111-
options <-
112-
execParser $
113-
info
114-
(opts <**> helper)
115-
( fullDesc
116-
<> progDesc "Manipulate CDDL files"
117-
<> header "cuddle"
118-
)
119-
run options
108+
options <-
109+
execParser $
110+
info
111+
(opts <**> helper)
112+
( fullDesc
113+
<> progDesc "Manipulate CDDL files"
114+
<> header "cuddle"
115+
)
116+
run options
120117

121118
run :: Opts -> IO ()
122119
run (Opts cmd cddlFile) = do
123-
parseFromFile pCDDL cddlFile >>= \case
124-
Left err -> do
125-
putStrLnErr $ errorBundlePretty err
126-
exitFailure
127-
Right res -> case cmd of
128-
Format fOpts ->
129-
let defs = if sort fOpts then sortCDDL res else res
130-
in putDocW 80 $ pretty defs
131-
Validate -> case fullResolveCDDL res of
132-
Left err -> putStrLnErr (show err) >> exitFailure
133-
Right _ -> exitSuccess
134-
(GenerateCBOR x) -> case fullResolveCDDL res of
135-
Left err -> putStrLnErr (show err) >> exitFailure
136-
Right mt -> do
137-
stdGen <- getStdGen
138-
let term = generateCBORTerm mt (Name $ itemName x) stdGen
139-
in case outputFormat x of
140-
AsTerm -> print term
141-
AsFlatTerm -> print $ toFlatTerm (encodeTerm term)
142-
AsCBOR -> print . toStrictByteString $ encodeTerm term
143-
AsPrettyCBOR -> putStrLn . prettyHexEnc $ encodeTerm term
120+
parseFromFile pCDDL cddlFile >>= \case
121+
Left err -> do
122+
putStrLnErr $ errorBundlePretty err
123+
exitFailure
124+
Right res -> case cmd of
125+
Format fOpts ->
126+
let defs = if sort fOpts then sortCDDL res else res
127+
in putDocW 80 $ pretty defs
128+
Validate -> case fullResolveCDDL res of
129+
Left err -> putStrLnErr (show err) >> exitFailure
130+
Right _ -> exitSuccess
131+
(GenerateCBOR x) -> case fullResolveCDDL res of
132+
Left err -> putStrLnErr (show err) >> exitFailure
133+
Right mt -> do
134+
stdGen <- getStdGen
135+
let term = generateCBORTerm mt (Name $ itemName x) stdGen
136+
in case outputFormat x of
137+
AsTerm -> print term
138+
AsFlatTerm -> print $ toFlatTerm (encodeTerm term)
139+
AsCBOR -> print . toStrictByteString $ encodeTerm term
140+
AsPrettyCBOR -> putStrLn . prettyHexEnc $ encodeTerm term
144141

145142
putStrLnErr :: String -> IO ()
146143
putStrLnErr = hPutStrLn stderr
147144

148145
parseFromFile ::
149-
Parsec e T.Text a ->
150-
String ->
151-
IO (Either (ParseErrorBundle T.Text e) a)
146+
Parsec e T.Text a ->
147+
String ->
148+
IO (Either (ParseErrorBundle T.Text e) a)
152149
parseFromFile p file = runParser p file <$> T.readFile file

0 commit comments

Comments
 (0)