on master help sign in
Fix #199: add -o to yaml2json, unified appearance
aeeddf1Andreas Abel
yaml/exe/json2yaml.hs+1−2
@@ -45,8 +45,7 @@ options =
45 where
45 where
46 hdoc = Just $ vcat $ map text
46 hdoc = Just $ vcat $ map text
47 [ versionText self
47 [ versionText self
48− , ""
48+ , "Convert JSON to YAML."
49− , "Reads a JSON document and writes it out as YAML document."
50 ]
49 ]
51 fdoc = Just $ text $ concat
50 fdoc = Just $ text $ concat
52 [ "The old call pattern '"
51 [ "The old call pattern '"
yaml/exe/yaml2json.hs+43−22
@@ -2,31 +2,31 @@
2{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE NamedFieldPuns #-}
3{-# LANGUAGE NamedFieldPuns #-}
4
4
5−import Prelude hiding (putStr, getContents)
6−
7import Data.Aeson (encode, Value)
5import Data.Aeson (encode, Value)
8−import Data.ByteString (getContents)
6+import qualified Data.ByteString as S (getContents)
9−import Data.ByteString.Lazy (putStr)
7+import qualified Data.ByteString.Lazy as L (putStr, writeFile)
10#if !MIN_VERSION_base(4,11,0)
8#if !MIN_VERSION_base(4,11,0)
11import Data.Semigroup (Semigroup(..))
9import Data.Semigroup (Semigroup(..))
12#endif
10#endif
13import Data.Yaml (decodeFileEither, decodeEither')
11import Data.Yaml (decodeFileEither, decodeEither')
12+import System.Exit (die)
14
13
15import Options.Applicative
14import Options.Applicative
16 ( Parser
15 ( Parser
17− , action, execParser, header, help, helper, info
16+ , action, execParser, headerDoc, help, helper, info
18− , metavar, strArgument
17+ , long, metavar, short, strArgument, strOption, value
19 )
18 )
20−
19+import Options.Applicative.Help.Pretty
21−import System.Exit
20+ ( vcat, text )
22−import System.IO (stderr, hPrint)
23
21
24import Common
22import Common
25− ( versionOption, numericVersionOption, dashToNothing )
23+ ( versionText, versionOption, numericVersionOption, dashToNothing )
26
24
27−newtype Options = Options
25+data Options = Options
28 { optInput :: Maybe FilePath
26 { optInput :: Maybe FilePath
29 -- ^ 'Nothing' means @stdin@.
27 -- ^ 'Nothing' means @stdin@.
28+ , optOutput :: Maybe FilePath
29+ -- ^ 'Nothing' means @stdout@.
30 }
30 }
31
31
32-- | Name of the executable.
32-- | Name of the executable.
@@ -40,27 +40,48 @@ options :: IO Options
40options =
40options =
41 execParser $
41 execParser $
42 info (helper <*> versionOption self <*> numericVersionOption <*> programOptions)
42 info (helper <*> versionOption self <*> numericVersionOption <*> programOptions)
43− (header "Reads given YAML document and prints it in JSON format to standard out.")
43+ (headerDoc hdoc)
44
44
45 where
45 where
46+ hdoc = Just $ vcat $ map text
47+ [ versionText self
48+ , "Convert YAML to JSON."
49+ ]
50+
46− programOptions = Options <$> oInput
51+ programOptions = Options <$> oInput <*> oOutput
47
52
48 oInput :: Parser (Maybe FilePath)
53 oInput :: Parser (Maybe FilePath)
49 oInput = dashToNothing <$> do
54 oInput = dashToNothing <$> do
50 strArgument
55 strArgument
51− $ metavar "FILE"
56+ $ metavar "IN"
57+ <> value "-"
52 <> action "file"
58 <> action "file"
53− <> help "The input file containing the YAML document; use '-' for stdin."
59+ <> help "The input file containing the YAML document; use '-' for stdin (default)."
60+
61+ oOutput :: Parser (Maybe FilePath)
62+ oOutput = dashToNothing <$> do
63+ strOption
64+ $ long "output"
65+ <> short 'o'
66+ <> value "-"
67+ <> metavar "OUT"
68+ <> action "file"
69+ <> help "The file to hold the produced JSON document; use '-' for stdout (default)."
54
70
55−showJSON :: Show a => Either a Value -> IO b
56−showJSON = \case
57− Left err -> hPrint stderr err >> exitFailure
58− Right res -> putStr (encode (res :: Value)) >> exitSuccess
59
71
60main :: IO ()
72main :: IO ()
61main = do
73main = do
62− Options{ optInput } <- options
74+ Options{ optInput, optOutput } <- options
75+
76+ -- Input YAML.
63− showJSON =<< case optInput of
77+ result <- case optInput of
64 -- strict getContents will read in all of stdin at once
78 -- strict getContents will read in all of stdin at once
65− Nothing -> decodeEither' <$> getContents
79+ Nothing -> decodeEither' <$> S.getContents
66 Just f -> decodeFileEither f
80 Just f -> decodeFileEither f
81+
82+ -- Output JSON.
83+ case result of
84+ Left err -> die $ show err
85+ Right val -> do
86+ let json = encode (val :: Value)
87+ maybe L.putStr L.writeFile optOutput json