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