module Argo.Internal.Main where

import qualified Argo.Internal.Decode as Decode
import qualified Argo.Internal.Encode as Encode
import qualified Argo.Internal.Json.Value as Value
import qualified Argo.Internal.Type.Flag as Flag
import qualified Argo.Internal.Type.Settings as Settings
import qualified Argo.Vendor.Builder as Builder
import qualified Argo.Vendor.ByteString as ByteString
import qualified Control.Monad as Monad
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

main :: IO ()
main :: IO ()
main = do
    String
name <- IO String
Environment.getProgName
    [String]
arguments <- IO [String]
Environment.getArgs
    String -> [String] -> IO ()
mainWith String
name [String]
arguments

mainWith :: String -> [String] -> IO ()
mainWith :: String -> [String] -> IO ()
mainWith String
name [String]
arguments = do
    let (([String]
warnings, [String]
errors), [Flag]
flags) = [String] -> (([String], [String]), [Flag])
getFlags [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]
warnings
    (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]
errors
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors) IO ()
forall a. IO a
Exit.exitFailure

    String -> [Flag] -> (Settings -> IO ()) -> IO ()
withSettings String
name [Flag]
flags ((Settings -> IO ()) -> IO ()) -> (Settings -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Settings
settings -> do
        ByteString
contents <- IO ByteString
ByteString.getContents
        Value
value <- case ByteString -> Either String Value
forall a. HasCodec a => ByteString -> Either String a
Decode.decode ByteString
contents of
            Left String
e -> String -> IO Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
            Right Value
x -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
x :: 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. HasCodec a => Indent -> a -> Builder
Encode.encodeWith (Settings -> Indent
Settings.indent Settings
settings) Value
value

getFlags :: [String] -> (([String], [String]), [Flag.Flag])
getFlags :: [String] -> (([String], [String]), [Flag])
getFlags [String]
arguments =
    let
        ([Flag]
flags, [String]
xs, [String]
ys, [String]
errors) =
            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
        warnings :: [String]
warnings =
            (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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]
xs
                [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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]
ys
    in (([String]
warnings, [String]
errors), [Flag]
flags)

withSettings :: String -> [Flag.Flag] -> (Settings.Settings -> IO ()) -> IO ()
withSettings :: String -> [Flag] -> (Settings -> IO ()) -> IO ()
withSettings String
name [Flag]
flags Settings -> IO ()
callback = do
    Settings
settings <- (String -> IO Settings)
-> (Settings -> IO Settings)
-> Either String Settings
-> IO Settings
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Settings
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Settings -> IO Settings
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either String Settings -> IO Settings)
-> Either String Settings -> IO Settings
forall a b. (a -> b) -> a -> b
$ (Settings -> Flag -> Either String Settings)
-> Settings -> [Flag] -> Either String Settings
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM Settings -> Flag -> Either String Settings
Settings.applyFlag Settings
Settings.initial [Flag]
flags
    if Settings -> Bool
Settings.help Settings
settings
        then 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
        else if Settings -> Bool
Settings.version Settings
settings
            then String -> IO ()
putStrLn String
version
            else Settings -> IO ()
callback Settings
settings

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

options :: [Console.OptDescr Flag.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
Flag.Help)
        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
Flag.Version)
        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
Flag.Spaces 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
Flag.Tab)
        String
"pretty-prints the output using tabs"
    ]