@@ -2,31 +2,31 @@
22{-# LANGUAGE LambdaCase #-}
33{-# LANGUAGE NamedFieldPuns #-}
44
5−import Prelude hiding (putStr, getContents)
6−
75import Data.Aeson (encode, Value)
8−import Data.ByteString (getContents)
9−import Data.ByteString.Lazy (putStr)
6+import qualified Data.ByteString as S (getContents)
7+import qualified Data.ByteString.Lazy as L (putStr, writeFile)
108#if !MIN_VERSION_base(4,11,0)
119import Data.Semigroup (Semigroup(..))
1210#endif
1311import Data.Yaml (decodeFileEither, decodeEither')
12+import System.Exit (die)
1413
1514import Options.Applicative
1615 ( Parser
17− , action, execParser, header, help, helper, info
18− , metavar, strArgument
16+ , action, execParser, headerDoc, help, helper, info
17+ , long, metavar, short, strArgument, strOption, value
1918 )
20−
21−import System.Exit
22−import System.IO (stderr, hPrint)
19+import Options.Applicative.Help.Pretty
20+ ( vcat, text )
2321
2422import Common
25− ( versionOption, numericVersionOption, dashToNothing )
23+ ( versionText, versionOption, numericVersionOption, dashToNothing )
2624
27−newtype Options = Options
25+data Options = Options
2826 { optInput :: Maybe FilePath
2927 -- ^ 'Nothing' means @stdin@.
28+ , optOutput :: Maybe FilePath
29+ -- ^ 'Nothing' means @stdout@.
3030 }
3131
3232-- | Name of the executable.
@@ -40,27 +40,48 @@ options :: IO Options
4040options =
4141 execParser $
4242 info (helper <*> versionOption self <*> numericVersionOption <*> programOptions)
43− (header "Reads given YAML document and prints it in JSON format to standard out.")
43+ (headerDoc hdoc)
4444
4545 where
46− programOptions = Options <$> oInput
46+ hdoc = Just $ vcat $ map text
47+ [ versionText self
48+ , "Convert YAML to JSON."
49+ ]
50+
51+ programOptions = Options <$> oInput <*> oOutput
4752
4853 oInput :: Parser (Maybe FilePath)
4954 oInput = dashToNothing <$> do
5055 strArgument
51− $ metavar "FILE"
56+ $ metavar "IN"
57+ <> value "-"
5258 <> 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)."
5470
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
5971
6072main :: IO ()
6173main = do
62− Options{ optInput } <- options
63− showJSON =<< case optInput of
74+ Options{ optInput, optOutput } <- options
75+
76+ -- Input YAML.
77+ result <- case optInput of
6478 -- strict getContents will read in all of stdin at once
65− Nothing -> decodeEither' <$> getContents
79+ Nothing -> decodeEither' <$> S.getContents
6680 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