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
    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
    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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors) forall a. IO a
Exit.exitFailure

    String -> [Flag] -> (Settings -> IO ()) -> IO ()
withSettings String
name [Flag]
flags forall a b. (a -> b) -> a -> b
$ \Settings
settings -> do
        ByteString
contents <- IO ByteString
ByteString.getContents
        Value
value <- case forall a. HasCodec a => ByteString -> Either String a
Decode.decode ByteString
contents of
            Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
            Right Value
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
x :: Value.Value)
        Handle -> Builder -> IO ()
Builder.hPutBuilder Handle
IO.stdout
            forall a b. (a -> b) -> a -> b
$ 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) =
            forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
Console.getOpt' forall a. ArgOrder a
Console.Permute [OptDescr Flag]
options [String]
arguments
        warnings :: [String]
warnings =
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend String
"unknown argument " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
quote) [String]
xs
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend String
"unknown option " 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 <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure
        forall a b. (a -> b) -> a -> b
$ 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
            forall a b. (a -> b) -> a -> b
$ forall a. String -> [OptDescr a] -> String
Console.usageInfo (String
name forall a. Semigroup a => a -> a -> a
<> String
" version " 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
"`" forall a. Semigroup a => a -> a -> a
<> String
x 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 =
    [ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
        [Char
'h', Char
'?']
        [String
"help"]
        (forall a. a -> ArgDescr a
Console.NoArg Flag
Flag.Help)
        String
"shows this help message and exits"
    , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
        [Char
'v']
        [String
"version"]
        (forall a. a -> ArgDescr a
Console.NoArg Flag
Flag.Version)
        String
"shows the version number and exits"
    , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
        [Char
's']
        [String
"spaces"]
        (forall a. (String -> a) -> String -> ArgDescr a
Console.ReqArg String -> Flag
Flag.Spaces String
"INT")
        String
"pretty-prints the output using INT sapces"
    , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
        [Char
't']
        [String
"tab"]
        (forall a. a -> ArgDescr a
Console.NoArg Flag
Flag.Tab)
        String
"pretty-prints the output using tabs"
    ]