@@ -1,22 +1,78 @@
1−import qualified Data.Aeson as J
2−import qualified Data.ByteString as S
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE NamedFieldPuns #-}
3+
4+import qualified Data.Aeson as J
5+import qualified Data.ByteString as S
36import qualified Data.ByteString.Lazy as L
4−import System.Environment (getArgs)
7+import qualified Data.Yaml as Y
8+#if !MIN_VERSION_base(4,11,0)
9+import Data.Semigroup ( Semigroup(..) )
10+#endif
11+
12+import Options.Applicative
13+ ( Parser
14+ , action, execParser, header, help, helper, info
15+ , metavar, strArgument, value
16+ )
17+
18+import System.Exit ( die )
19+
20+import Common ( dashToNothing, versionOption, numericVersionOption )
21+
22+data Options = Options
23+ { optInput :: Maybe FilePath
24+ -- ^ 'Nothing' means @stdin@.
25+ , optOutput :: Maybe FilePath
26+ -- ^ 'Nothing' means @stdout@.
27+ }
28+
29+-- | Name of the executable.
30+
31+self :: String
32+self = "json2yaml"
33+
34+-- | Parse options; handle parse errors, @--help@, @--version@.
535
6−import qualified Data.Yaml as Y
36+options :: IO Options
37+options =
38+ execParser $
39+ info (helper <*> versionOption self <*> numericVersionOption <*> programOptions)
40+ (header "Reads a JSON document and writes it out as YAML document.")
41+
42+ where
43+ programOptions = Options <$> oInput <*> oOutput
44+
45+ oInput :: Parser (Maybe FilePath)
46+ oInput = dashToNothing <$> do
47+ strArgument
48+ $ metavar "IN"
49+ <> value "-"
50+ <> action "file"
51+ <> help "The input file containing the JSON document; use '-' for stdin."
52+
53+ oOutput :: Parser (Maybe FilePath)
54+ oOutput = dashToNothing <$> do
55+ strArgument
56+ $ metavar "OUT"
57+ <> value "-"
58+ <> action "file"
59+ <> help "The file to hold the produced YAML document; use '-' for stdout."
60+
61+-- | Exit with 'self'-stamped error message.
62+
63+abort :: String -> IO a
64+abort msg = die $ concat [ self, ": ", msg ]
765
866main :: IO ()
967main = do
10− args <- getArgs
11− (input, output) <- case args ++ replicate (2 - length args) "-" of
12− [i, o] -> return (i, o)
13− _ -> fail "Usage: json2yaml [in] [out]"
14− mval <- fmap J.decode $
15− case input of
16− "-" -> L.getContents
17− _ -> L.readFile input
18− case mval of
19− Nothing -> error "Invalid input JSON"
20− Just val -> case output of
21− "-" -> S.putStr $ Y.encode (val :: Y.Value)
22− _ -> Y.encodeFile output val
68+ Options{ optInput, optOutput } <- options
69+
70+ -- Read JSON.
71+ mval <- J.decode <$> maybe L.getContents L.readFile optInput
72+
73+ -- Write YAML.
74+ case mval of
75+ Nothing -> abort "Invalid input JSON"
76+ Just val -> case optOutput of
77+ Nothing -> S.putStr $ Y.encode (val :: Y.Value)
78+ Just f -> Y.encodeFile f val