Skip to content

Commit 3e697d1

Browse files
SoupstrawSoupstraw
committed
Fourmolize
1 parent 121410d commit 3e697d1

File tree

19 files changed

+2867
-2817
lines changed

19 files changed

+2867
-2817
lines changed

‎bin/Main.hs‎

Lines changed: 95 additions & 95 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,10 @@
33
module Main (main) where
44

55
import Codec.CBOR.Cuddle.CBOR.Gen (generateCBORTerm)
6-
import Codec.CBOR.Cuddle.CDDL (Name (..))
7-
import Codec.CBOR.Cuddle.CDDL.Resolve
8-
( fullResolveCDDL,
9-
)
6+
import Codec.CBOR.Cuddle.CDDL (Name (..), sortCDDL)
7+
import Codec.CBOR.Cuddle.CDDL.Resolve (
8+
fullResolveCDDL,
9+
)
1010
import Codec.CBOR.Cuddle.Parser (pCDDL)
1111
import Codec.CBOR.Cuddle.Pretty ()
1212
import Codec.CBOR.FlatTerm (toFlatTerm)
@@ -22,131 +22,131 @@ import System.Exit (exitFailure, exitSuccess)
2222
import System.IO (hPutStrLn, stderr)
2323
import System.Random (getStdGen)
2424
import Text.Megaparsec (ParseErrorBundle, Parsec, errorBundlePretty, runParser)
25-
import Codec.CBOR.Cuddle.CDDL (sortCDDL)
2625

2726
data Opts = Opts Command String
2827

2928
data Command
30-
= Format FormatOpts
31-
| Validate
32-
| GenerateCBOR GenOpts
29+
= Format FormatOpts
30+
| Validate
31+
| GenerateCBOR GenOpts
3332

3433
-- | Various formats for outputtting CBOR
3534
data CBOROutputFormat
36-
= AsCBOR
37-
| AsPrettyCBOR
38-
| AsTerm
39-
| AsFlatTerm
35+
= AsCBOR
36+
| AsPrettyCBOR
37+
| AsTerm
38+
| AsFlatTerm
4039

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

4948
data GenOpts = GenOpts
50-
{ itemName :: T.Text,
51-
outputFormat :: CBOROutputFormat
52-
}
49+
{ itemName :: T.Text
50+
, outputFormat :: CBOROutputFormat
51+
}
5352

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

7170
newtype FormatOpts = FormatOpts
72-
{sort :: Bool}
71+
{sort :: Bool}
7372

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

8281
opts :: Parser Opts
8382
opts =
84-
Opts
85-
<$> subparser
86-
( command
87-
"format"
88-
( info
89-
( Format <$> pFormatOpts)
90-
( progDesc "Format the provided CDDL file"
91-
)
92-
)
93-
<> command
94-
"validate"
95-
( info
96-
(pure Validate)
97-
( progDesc "Validate the provided CDDL file"
83+
Opts
84+
<$> subparser
85+
( command
86+
"format"
87+
( info
88+
(Format <$> pFormatOpts)
89+
( progDesc "Format the provided CDDL file"
90+
)
9891
)
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+
)
99106
)
100-
<> command
101-
"gen"
102-
( info
103-
(GenerateCBOR <$> pGenOpts)
104-
( progDesc "Generate a CBOR term matching the schema"
105-
)
106-
)
107-
)
108-
<*> argument str (metavar "CDDL_FILE")
107+
<*> argument str (metavar "CDDL_FILE")
109108

110109
main :: IO ()
111110
main = do
112-
options <-
113-
execParser $
114-
info
115-
(opts <**> helper)
116-
( fullDesc
117-
<> progDesc "Manipulate CDDL files"
118-
<> header "cuddle"
119-
)
120-
run options
111+
options <-
112+
execParser $
113+
info
114+
(opts <**> helper)
115+
( fullDesc
116+
<> progDesc "Manipulate CDDL files"
117+
<> header "cuddle"
118+
)
119+
run options
121120

122121
run :: Opts -> IO ()
123122
run (Opts cmd cddlFile) = do
124-
parseFromFile pCDDL cddlFile >>= \case
125-
Left err -> do
126-
putStrLnErr $ errorBundlePretty err
127-
exitFailure
128-
Right res -> case cmd of
129-
Format fOpts -> let defs = if sort fOpts then sortCDDL res else res in
130-
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
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
144144

145145
putStrLnErr :: String -> IO ()
146146
putStrLnErr = hPutStrLn stderr
147147

148148
parseFromFile ::
149-
Parsec e T.Text a ->
150-
String ->
151-
IO (Either (ParseErrorBundle T.Text e) a)
149+
Parsec e T.Text a ->
150+
String ->
151+
IO (Either (ParseErrorBundle T.Text e) a)
152152
parseFromFile p file = runParser p file <$> T.readFile file

0 commit comments

Comments
 (0)