yaml-streamly-0.12.0: exe/json2yaml.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}

import qualified Data.Aeson           as J
import qualified Data.ByteString      as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Yaml            as Y
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ( Semigroup(..) )
#endif

import Options.Applicative
  ( Parser, (<|>)
  , action, execParser, footerDoc, headerDoc, help, helper, hidden, info
  , long, metavar, short, strArgument, strOption, value
  )
import Options.Applicative.Help.Pretty
  ( vcat, text )

import System.Exit    ( die )

import Common         ( dashToNothing, versionText, versionOption, numericVersionOption )

data Options = Options
  { optInput  :: Maybe FilePath
      -- ^ 'Nothing' means @stdin@.
  , optOutput :: Maybe FilePath
      -- ^ 'Nothing' means @stdout@.
  }

-- | Name of the executable.

self :: String
self = "json2yaml"

-- | Parse options; handle parse errors, @--help@, @--version@.

options :: IO Options
options =
  execParser $
    info (helper <*> versionOption self <*> numericVersionOption <*> programOptions)
      $  headerDoc hdoc
      <> footerDoc fdoc

  where
  hdoc = Just $ vcat $ map text
    [ versionText self
    , "Convert JSON to YAML."
    ]
  fdoc = Just $ text $ concat
    [ "The old call pattern '"
    , self
    , " IN OUT' is also accepted, but deprecated."
    ]

  programOptions :: Parser Options
  programOptions = Options <$> oInput <*> oOutput

  oInput :: Parser (Maybe FilePath)
  oInput = dashToNothing <$> do
    strArgument
      $  metavar "IN"
      <> value "-"
      <> action "file"
      <> help "The input file containing the JSON document; use '-' for stdin (default)."

  oOutput :: Parser (Maybe FilePath)
  oOutput = dashToNothing <$> do
    oOutputExplicit <|> oOutputImplicit

  oOutputExplicit :: Parser FilePath
  oOutputExplicit =
    strOption
      $  long "output"
      <> short 'o'
      <> metavar "OUT"
      <> action "file"
      -- <> help "The file to hold the produced YAML document; use '-' for stdout (default)."

  oOutputImplicit :: Parser FilePath
  oOutputImplicit =
    strArgument
      $  metavar "OUT"
      <> value "-"
      <> action "file"
      <> hidden
      <> help "The file to hold the produced YAML document; use '-' for stdout (default)."

-- | Exit with 'self'-stamped error message.

abort :: String -> IO a
abort msg = die $ concat [ self, ": ", msg ]

main :: IO ()
main = do
  Options{ optInput, optOutput } <- options

  -- Read JSON.
  mval <- J.decode <$> maybe L.getContents L.readFile optInput

  -- Write YAML.
  case mval of
    Nothing  -> abort "Invalid input JSON"
    Just val -> case optOutput of
      Nothing -> S.putStr $ Y.encode (val :: Y.Value)
      Just f  -> Y.encodeFile f val