Skip to content

Commit d66d1db

Browse files
Gabriella439mergify[bot]
Gabriella439
authored and
mergify[bot]
committed
Fix --version flag handling for dhall-json package (#1199)
* Fix `--version` flag handling for `dhall-json` package Fixes #1198 This changes version to be a separate constructor for options parsing, in order to make invalid states unrepresentable and to fix issues like the above one. * Undo `allowImports` changed This was a change I forgot to stash while working on the fix for the `--version` flag * Fix missing `Paths_dhall_json` in `dhall-json.cabal`
1 parent ae788fd commit d66d1db

File tree

5 files changed

+175
-143
lines changed

5 files changed

+175
-143
lines changed

‎dhall-json/dhall-json.cabal

+2
Original file line numberDiff line numberDiff line change
@@ -110,6 +110,8 @@ Executable dhall-to-yaml
110110
dhall-json ,
111111
optparse-applicative ,
112112
text
113+
Other-Modules:
114+
Paths_dhall_json
113115
GHC-Options: -Wall
114116

115117
Executable json-to-dhall

‎dhall-json/dhall-to-json/Main.hs

+46-43
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@ module Main where
55

66
import Control.Applicative ((<|>), optional)
77
import Control.Exception (SomeException)
8-
import Control.Monad (when)
98
import Data.Aeson (Value)
109
import Data.Monoid ((<>))
1110
import Data.Version (showVersion)
@@ -26,26 +25,28 @@ import qualified Paths_dhall_json as Meta
2625
import qualified System.Exit
2726
import qualified System.IO
2827

29-
data Options = Options
30-
{ explain :: Bool
31-
, pretty :: Bool
32-
, omission :: Value -> Value
33-
, version :: Bool
34-
, conversion :: Conversion
35-
, approximateSpecialDoubles :: Bool
36-
, file :: Maybe FilePath
37-
}
28+
data Options
29+
= Options
30+
{ explain :: Bool
31+
, pretty :: Bool
32+
, omission :: Value -> Value
33+
, conversion :: Conversion
34+
, approximateSpecialDoubles :: Bool
35+
, file :: Maybe FilePath
36+
}
37+
| Version
3838

3939
parseOptions :: Parser Options
4040
parseOptions =
41-
Options
42-
<$> parseExplain
43-
<*> parsePretty
44-
<*> Dhall.JSON.parseOmission
45-
<*> parseVersion
46-
<*> Dhall.JSON.parseConversion
47-
<*> parseApproximateSpecialDoubles
48-
<*> optional parseFile
41+
( Options
42+
<$> parseExplain
43+
<*> parsePretty
44+
<*> Dhall.JSON.parseOmission
45+
<*> Dhall.JSON.parseConversion
46+
<*> parseApproximateSpecialDoubles
47+
<*> optional parseFile
48+
)
49+
<|> parseVersion
4950
where
5051
parseExplain =
5152
Options.switch
@@ -74,7 +75,8 @@ parseOptions =
7475
pure False
7576

7677
parseVersion =
77-
Options.switch
78+
Options.flag'
79+
Version
7880
( Options.long "version"
7981
<> Options.help "Display version"
8082
)
@@ -104,37 +106,38 @@ main :: IO ()
104106
main = do
105107
GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8
106108

107-
Options {..} <- Options.execParser parserInfo
109+
options <- Options.execParser parserInfo
108110

109-
when version $ do
110-
putStrLn (showVersion Meta.version)
111-
System.Exit.exitSuccess
111+
case options of
112+
Version -> do
113+
putStrLn (showVersion Meta.version)
112114

113-
handle $ do
114-
let config = Data.Aeson.Encode.Pretty.Config
115-
{ Data.Aeson.Encode.Pretty.confIndent = Data.Aeson.Encode.Pretty.Spaces 2
116-
, Data.Aeson.Encode.Pretty.confCompare = compare
117-
, Data.Aeson.Encode.Pretty.confNumFormat = Data.Aeson.Encode.Pretty.Generic
118-
, Data.Aeson.Encode.Pretty.confTrailingNewline = False }
119-
let encode =
120-
if pretty
121-
then Data.Aeson.Encode.Pretty.encodePretty' config
122-
else Data.Aeson.encode
115+
Options {..} -> do
116+
handle $ do
117+
let config = Data.Aeson.Encode.Pretty.Config
118+
{ Data.Aeson.Encode.Pretty.confIndent = Data.Aeson.Encode.Pretty.Spaces 2
119+
, Data.Aeson.Encode.Pretty.confCompare = compare
120+
, Data.Aeson.Encode.Pretty.confNumFormat = Data.Aeson.Encode.Pretty.Generic
121+
, Data.Aeson.Encode.Pretty.confTrailingNewline = False }
122+
let encode =
123+
if pretty
124+
then Data.Aeson.Encode.Pretty.encodePretty' config
125+
else Data.Aeson.encode
123126

124-
let explaining = if explain then Dhall.detailed else id
127+
let explaining = if explain then Dhall.detailed else id
125128

126-
let specialDoubleMode =
127-
if approximateSpecialDoubles
128-
then ApproximateWithinJSON
129-
else ForbidWithinJSON
129+
let specialDoubleMode =
130+
if approximateSpecialDoubles
131+
then ApproximateWithinJSON
132+
else ForbidWithinJSON
130133

131-
text <- case file of
132-
Nothing -> Text.IO.getContents
133-
Just path -> Text.IO.readFile path
134+
text <- case file of
135+
Nothing -> Text.IO.getContents
136+
Just path -> Text.IO.readFile path
134137

135-
json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode file text)
138+
json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode file text)
136139

137-
Data.ByteString.Char8.putStrLn $ Data.ByteString.Lazy.toStrict $ encode json
140+
Data.ByteString.Char8.putStrLn $ Data.ByteString.Lazy.toStrict $ encode json
138141

139142
handle :: IO a -> IO a
140143
handle = Control.Exception.handle handler

‎dhall-json/dhall-to-yaml/Main.hs

+33-16
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
{-# LANGUAGE RecordWildCards #-}
33
module Main where
44

5-
import Control.Applicative (optional)
5+
import Control.Applicative (optional, (<|>))
66
import Control.Exception (SomeException)
77
import Data.Monoid ((<>))
88
import Dhall.JSON (parseOmission, parseConversion)
@@ -12,20 +12,25 @@ import Options.Applicative (Parser, ParserInfo)
1212
import qualified Control.Exception
1313
import qualified Data.ByteString
1414
import qualified Data.Text.IO as Text.IO
15+
import qualified Data.Version
1516
import qualified GHC.IO.Encoding
1617
import qualified Options.Applicative as Options
18+
import qualified Paths_dhall_json as Meta
1719
import qualified System.Exit
1820
import qualified System.IO
1921

20-
parseOptions :: Parser Options
22+
parseOptions :: Parser (Maybe Options)
2123
parseOptions =
22-
Options
23-
<$> parseExplain
24-
<*> Dhall.JSON.parseOmission
25-
<*> parseDocuments
26-
<*> parseQuoted
27-
<*> Dhall.JSON.parseConversion
28-
<*> optional parseFile
24+
Just
25+
<$> ( Options
26+
<$> parseExplain
27+
<*> Dhall.JSON.parseOmission
28+
<*> parseDocuments
29+
<*> parseQuoted
30+
<*> Dhall.JSON.parseConversion
31+
<*> optional parseFile
32+
)
33+
<|> parseVersion
2934
where
3035
parseExplain =
3136
Options.switch
@@ -40,7 +45,14 @@ parseOptions =
4045
<> Options.metavar "FILE"
4146
)
4247

43-
parserInfo :: ParserInfo Options
48+
parseVersion =
49+
Options.flag'
50+
Nothing
51+
( Options.long "version"
52+
<> Options.help "Display version"
53+
)
54+
55+
parserInfo :: ParserInfo (Maybe Options)
4456
parserInfo =
4557
Options.info
4658
(Options.helper <*> parseOptions)
@@ -52,14 +64,19 @@ main :: IO ()
5264
main = do
5365
GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8
5466

55-
options@Options {..} <- Options.execParser parserInfo
67+
maybeOptions <- Options.execParser parserInfo
68+
69+
case maybeOptions of
70+
Nothing -> do
71+
putStrLn (Data.Version.showVersion Meta.version)
5672

57-
handle $ do
58-
contents <- case file of
59-
Nothing -> Text.IO.getContents
60-
Just path -> Text.IO.readFile path
73+
Just options@(Options {..}) -> do
74+
handle $ do
75+
contents <- case file of
76+
Nothing -> Text.IO.getContents
77+
Just path -> Text.IO.readFile path
6178

62-
Data.ByteString.putStr =<< dhallToYaml options file contents
79+
Data.ByteString.putStr =<< dhallToYaml options file contents
6380

6481
handle :: IO a -> IO a
6582
handle = Control.Exception.handle handler

‎dhall-json/json-to-dhall/Main.hs

+50-44
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,8 @@
88

99
module Main where
1010

11-
import Control.Applicative (optional)
11+
import Control.Applicative (optional, (<|>))
1212
import Control.Exception (SomeException, throwIO)
13-
import Control.Monad (when)
1413
import Data.Monoid ((<>))
1514
import Data.Text (Text)
1615
import Data.Version (showVersion)
@@ -45,23 +44,28 @@ parserInfo = Options.info
4544
)
4645

4746
-- | All the command arguments and options
48-
data Options = Options
49-
{ version :: Bool
50-
, schema :: Text
51-
, conversion :: Conversion
52-
, file :: Maybe FilePath
53-
, ascii :: Bool
54-
, plain :: Bool
55-
} deriving Show
47+
data Options
48+
= Options
49+
{ schema :: Text
50+
, conversion :: Conversion
51+
, file :: Maybe FilePath
52+
, ascii :: Bool
53+
, plain :: Bool
54+
}
55+
| Version
56+
deriving Show
5657

5758
-- | Parser for all the command arguments and options
5859
parseOptions :: Parser Options
59-
parseOptions = Options <$> parseVersion
60-
<*> parseSchema
61-
<*> parseConversion
62-
<*> optional parseFile
63-
<*> parseASCII
64-
<*> parsePlain
60+
parseOptions =
61+
( Options
62+
<$> parseSchema
63+
<*> parseConversion
64+
<*> optional parseFile
65+
<*> parseASCII
66+
<*> parsePlain
67+
)
68+
<|> parseVersion
6569
where
6670
parseSchema =
6771
Options.strArgument
@@ -70,7 +74,8 @@ parseOptions = Options <$> parseVersion
7074
)
7175

7276
parseVersion =
73-
Options.switch
77+
Options.flag'
78+
Version
7479
( Options.long "version"
7580
<> Options.short 'V'
7681
<> Options.help "Display version"
@@ -103,45 +108,46 @@ main :: IO ()
103108
main = do
104109
GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8
105110

106-
Options {..} <- Options.execParser parserInfo
111+
options <- Options.execParser parserInfo
107112

108-
let characterSet = case ascii of
109-
True -> ASCII
110-
False -> Unicode
113+
case options of
114+
Version -> do
115+
putStrLn (showVersion Meta.version)
111116

112-
when version $ do
113-
putStrLn (showVersion Meta.version)
114-
System.Exit.exitSuccess
117+
Options {..} -> do
118+
let characterSet = case ascii of
119+
True -> ASCII
120+
False -> Unicode
115121

116-
handle $ do
117-
bytes <- case file of
118-
Nothing -> ByteString.getContents
119-
Just path -> ByteString.readFile path
122+
handle $ do
123+
bytes <- case file of
124+
Nothing -> ByteString.getContents
125+
Just path -> ByteString.readFile path
120126

121-
value :: Aeson.Value <- case Aeson.eitherDecode bytes of
122-
Left err -> throwIO (userError err)
123-
Right v -> pure v
127+
value :: Aeson.Value <- case Aeson.eitherDecode bytes of
128+
Left err -> throwIO (userError err)
129+
Right v -> pure v
124130

125-
expr <- typeCheckSchemaExpr id =<< resolveSchemaExpr schema
131+
expr <- typeCheckSchemaExpr id =<< resolveSchemaExpr schema
126132

127-
result <- case dhallFromJSON conversion expr value of
128-
Left err -> throwIO err
129-
Right result -> return result
133+
result <- case dhallFromJSON conversion expr value of
134+
Left err -> throwIO err
135+
Right result -> return result
130136

131-
let document = Dhall.Pretty.prettyCharacterSet characterSet result
137+
let document = Dhall.Pretty.prettyCharacterSet characterSet result
132138

133-
let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document
139+
let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document
134140

135-
supportsANSI <- ANSI.hSupportsANSI IO.stdout
141+
supportsANSI <- ANSI.hSupportsANSI IO.stdout
136142

137-
let ansiStream =
138-
if supportsANSI && not plain
139-
then fmap Dhall.Pretty.annToAnsiStyle stream
140-
else Pretty.unAnnotateS stream
143+
let ansiStream =
144+
if supportsANSI && not plain
145+
then fmap Dhall.Pretty.annToAnsiStyle stream
146+
else Pretty.unAnnotateS stream
141147

142-
Pretty.Terminal.renderIO IO.stdout ansiStream
148+
Pretty.Terminal.renderIO IO.stdout ansiStream
143149

144-
Text.IO.putStrLn ""
150+
Text.IO.putStrLn ""
145151

146152
handle :: IO a -> IO a
147153
handle = Control.Exception.handle handler

0 commit comments

Comments
 (0)