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" ]