module UI.Butcher.Monadic.IO
( mainFromCmdParser
, mainFromCmdParserWithHelpDesc
)
where
#include "prelude.inc"
import Control.Monad.Free
import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
import qualified Control.Monad.Trans.MultiState.Strict as MultiStateS
import qualified Text.PrettyPrint as PP
import Data.HList.ContainsType
import UI.Butcher.Monadic.Internal.Types
import UI.Butcher.Monadic.Internal.Core
import UI.Butcher.Monadic.Pretty
import UI.Butcher.Monadic.Param
import System.IO
mainFromCmdParser :: CmdParser Identity (IO ()) () -> IO ()
mainFromCmdParser :: CmdParser Identity (IO ()) () -> IO ()
mainFromCmdParser CmdParser Identity (IO ()) ()
cmd = do
String
progName <- IO String
System.Environment.getProgName
case Maybe String
-> CmdParser Identity (IO ()) () -> Either String (CommandDesc ())
forall (f :: * -> *) out.
Maybe String
-> CmdParser f out () -> Either String (CommandDesc ())
checkCmdParser (String -> Maybe String
forall a. a -> Maybe a
Just String
progName) CmdParser Identity (IO ()) ()
cmd of
Left String
e -> do
String -> IO ()
putStrErrLn
(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
progName
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": internal error: failed sanity check for butcher main command parser!"
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"aborting."
Right CommandDesc ()
_ -> do
[String]
args <- IO [String]
System.Environment.getArgs
case Maybe String
-> Input
-> CmdParser Identity (IO ()) ()
-> (CommandDesc (), Either ParsingError (CommandDesc (IO ())))
forall out.
Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParser (String -> Maybe String
forall a. a -> Maybe a
Just String
progName) ([String] -> Input
InputArgs [String]
args) CmdParser Identity (IO ()) ()
cmd of
(CommandDesc ()
desc, Left (ParsingError [String]
mess Input
remaining)) -> do
String -> IO ()
putStrErrLn
(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
progName
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": error parsing arguments: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ case [String]
mess of
[] -> String
""
(String
m:[String]
_) -> String
m
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ case Input
remaining of
InputString String
"" -> String
"at the end of input."
InputString String
str -> case String -> String
forall a. Show a => a -> String
show String
str of
String
s | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
42 -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
String
s -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
40 String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..\"."
InputArgs [] -> String
"at the end of input"
InputArgs [String]
xs -> case [String] -> String
List.unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
xs of
String
s | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
42 -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
String
s -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
40 String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..\"."
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"usage:"
Doc -> IO ()
forall a. Show a => a -> IO ()
printErr (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandDesc () -> Doc
forall a. CommandDesc a -> Doc
ppUsage CommandDesc ()
desc
(CommandDesc ()
desc, Right CommandDesc (IO ())
out ) -> case CommandDesc (IO ()) -> Maybe (IO ())
forall out. CommandDesc out -> Maybe out
_cmd_out CommandDesc (IO ())
out of
Maybe (IO ())
Nothing -> do
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"usage:"
Doc -> IO ()
forall a. Show a => a -> IO ()
printErr (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandDesc () -> Doc
forall a. CommandDesc a -> Doc
ppUsage CommandDesc ()
desc
Just IO ()
a -> IO ()
a
mainFromCmdParserWithHelpDesc
:: (CommandDesc () -> CmdParser Identity (IO ()) ()) -> IO ()
mainFromCmdParserWithHelpDesc :: (CommandDesc () -> CmdParser Identity (IO ()) ()) -> IO ()
mainFromCmdParserWithHelpDesc CommandDesc () -> CmdParser Identity (IO ()) ()
cmdF = do
String
progName <- IO String
System.Environment.getProgName
let (Either String (CommandDesc ())
checkResult, CommandDesc ()
fullDesc)
= ( Maybe String
-> CmdParser Identity (IO ()) () -> Either String (CommandDesc ())
forall (f :: * -> *) out.
Maybe String
-> CmdParser f out () -> Either String (CommandDesc ())
checkCmdParser (String -> Maybe String
forall a. a -> Maybe a
Just String
progName) (CommandDesc () -> CmdParser Identity (IO ()) ()
cmdF CommandDesc ()
fullDesc)
, (String -> CommandDesc ())
-> (CommandDesc () -> CommandDesc ())
-> Either String (CommandDesc ())
-> CommandDesc ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CommandDesc () -> String -> CommandDesc ()
forall a b. a -> b -> a
const CommandDesc ()
forall out. CommandDesc out
emptyCommandDesc) CommandDesc () -> CommandDesc ()
forall a. a -> a
id (Either String (CommandDesc ()) -> CommandDesc ())
-> Either String (CommandDesc ()) -> CommandDesc ()
forall a b. (a -> b) -> a -> b
$ Either String (CommandDesc ())
checkResult
)
case Either String (CommandDesc ())
checkResult of
Left String
e -> do
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
progName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": internal error: failed sanity check for butcher main command parser!"
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"aborting."
Right CommandDesc ()
_ -> do
[String]
args <- IO [String]
System.Environment.getArgs
case Maybe String
-> Input
-> CmdParser Identity (IO ()) ()
-> (CommandDesc (), Either ParsingError (CommandDesc (IO ())))
forall out.
Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParser (String -> Maybe String
forall a. a -> Maybe a
Just String
progName) ([String] -> Input
InputArgs [String]
args) (CommandDesc () -> CmdParser Identity (IO ()) ()
cmdF CommandDesc ()
fullDesc) of
(CommandDesc ()
desc, Left (ParsingError [String]
mess Input
remaining)) -> do
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
progName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": error parsing arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. [a] -> a
head [String]
mess
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ case Input
remaining of
InputString String
"" -> String
"at the end of input."
InputString String
str -> case String -> String
forall a. Show a => a -> String
show String
str of
String
s | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
42 -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
String
s -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
40 String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..\"."
InputArgs [] -> String
"at the end of input"
InputArgs [String]
xs -> case [String] -> String
List.unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
xs of
String
s | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
42 -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
String
s -> String
"at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
40 String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..\"."
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"usage:"
Doc -> IO ()
forall a. Show a => a -> IO ()
printErr (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandDesc () -> Doc
forall a. CommandDesc a -> Doc
ppUsage CommandDesc ()
desc
(CommandDesc ()
desc, Right CommandDesc (IO ())
out) -> case CommandDesc (IO ()) -> Maybe (IO ())
forall out. CommandDesc out -> Maybe out
_cmd_out CommandDesc (IO ())
out of
Maybe (IO ())
Nothing -> do
String -> IO ()
putStrErrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"usage:"
Doc -> IO ()
forall a. Show a => a -> IO ()
printErr (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandDesc () -> Doc
forall a. CommandDesc a -> Doc
ppUsage CommandDesc ()
desc
Just IO ()
a -> IO ()
a
putStrErrLn :: String -> IO ()
putStrErrLn :: String -> IO ()
putStrErrLn String
s = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
s
printErr :: Show a => a -> IO ()
printErr :: forall a. Show a => a -> IO ()
printErr = String -> IO ()
putStrErrLn (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show