module Argo.Main where

import qualified Argo
import qualified Argo.Encoder as Encoder
import qualified Control.Monad as Monad
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as Builder
import qualified Data.Version as Version
import qualified Paths_argo as This
import qualified System.Console.GetOpt as Console
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.IO as IO
import qualified Text.Read as Read

main :: IO ()
main :: IO ()
main = do
    String
name <- IO String
Environment.getProgName
    [String]
arguments <- IO [String]
Environment.getArgs
    let ([Flag]
flags, [String]
as, [String]
os, [String]
es) = ArgOrder Flag
-> [OptDescr Flag]
-> [String]
-> ([Flag], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
Console.getOpt' ArgOrder Flag
forall a. ArgOrder a
Console.Permute [OptDescr Flag]
options [String]
arguments
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. Monoid a => a -> a -> a
mappend String
"unknown argument " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
quote) [String]
as
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. Monoid a => a -> a -> a
mappend String
"unknown option " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
quote) [String]
os
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
IO.hPutStr Handle
IO.stderr) [String]
es
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
es) IO ()
forall a. IO a
Exit.exitFailure

    Config
config <- (String -> IO Config)
-> (Config -> IO Config) -> Either String Config -> IO Config
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Config
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Config -> IO Config)
-> Either String Config -> IO Config
forall a b. (a -> b) -> a -> b
$ (Config -> Flag -> Either String Config)
-> Config -> [Flag] -> Either String Config
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM Config -> Flag -> Either String Config
applyFlag Config
defaultConfig [Flag]
flags
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Config -> Bool
configHelp Config
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [OptDescr Flag] -> String
forall a. String -> [OptDescr a] -> String
Console.usageInfo (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" version " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
version) [OptDescr Flag]
options
        IO ()
forall a. IO a
Exit.exitSuccess
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Config -> Bool
configVersion Config
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn String
version
        IO ()
forall a. IO a
Exit.exitSuccess

    ByteString
contents <- IO ByteString
ByteString.getContents
    case ByteString -> Result Value
forall a. FromValue a => ByteString -> Result a
Argo.decode ByteString
contents of
        Argo.Failure String
e -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
        Argo.Success Value
value -> Handle -> Builder -> IO ()
Builder.hPutBuilder Handle
IO.stdout
            (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Indent -> Value -> Builder
forall a. ToValue a => Indent -> a -> Builder
Argo.encodeWith (Config -> Indent
configIndent Config
config) (Value
value :: Argo.Value)

quote :: String -> String
quote :: String -> String
quote String
x = String
"`" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"

version :: String
version :: String
version = Version -> String
Version.showVersion Version
This.version

data Flag
    = FlagHelp
    | FlagSpaces String
    | FlagTab
    | FlagVersion
    deriving (Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Int -> Flag -> String -> String
[Flag] -> String -> String
Flag -> String
(Int -> Flag -> String -> String)
-> (Flag -> String) -> ([Flag] -> String -> String) -> Show Flag
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Flag] -> String -> String
$cshowList :: [Flag] -> String -> String
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> String -> String
$cshowsPrec :: Int -> Flag -> String -> String
Show)

options :: [Console.OptDescr Flag]
options :: [OptDescr Flag]
options =
    [ String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option [Char
'h', Char
'?'] [String
"help"] (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
Console.NoArg Flag
FlagHelp) String
"shows this help message and exits"
    , String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option [Char
'v'] [String
"version"] (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
Console.NoArg Flag
FlagVersion) String
"shows the version number and exits"
    , String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option [Char
's'] [String
"spaces"] ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
Console.ReqArg String -> Flag
FlagSpaces String
"INT") String
"pretty-prints the output using INT sapces"
    , String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option [Char
't'] [String
"tab"] (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
Console.NoArg Flag
FlagTab) String
"pretty-prints the output using tabs"
    ]

data Config = Config
    { Config -> Bool
configHelp :: Bool
    , Config -> Indent
configIndent :: Encoder.Indent
    , Config -> Bool
configVersion :: Bool
    } deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> String -> String
[Config] -> String -> String
Config -> String
(Int -> Config -> String -> String)
-> (Config -> String)
-> ([Config] -> String -> String)
-> Show Config
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Config] -> String -> String
$cshowList :: [Config] -> String -> String
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> String -> String
$cshowsPrec :: Int -> Config -> String -> String
Show)

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Bool -> Indent -> Bool -> Config
Config
    { configHelp :: Bool
configHelp = Bool
False
    , configIndent :: Indent
configIndent = Int -> Indent
Encoder.Spaces Int
0
    , configVersion :: Bool
configVersion = Bool
False
    }

applyFlag :: Config -> Flag -> Either String Config
applyFlag :: Config -> Flag -> Either String Config
applyFlag Config
config Flag
flag = case Flag
flag of
    Flag
FlagHelp -> Config -> Either String Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configHelp :: Bool
configHelp = Bool
True }
    FlagSpaces String
string -> do
        Int
int <- String -> Either String Int
forall a. Read a => String -> Either String a
Read.readEither String
string
        Config -> Either String Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configIndent :: Indent
configIndent = Int -> Indent
Encoder.Spaces Int
int }
    Flag
FlagTab -> Config -> Either String Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configIndent :: Indent
configIndent = Indent
Encoder.Tab }
    Flag
FlagVersion -> Config -> Either String Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configVersion :: Bool
configVersion = Bool
True }