module Imp.Type.Flag where import qualified Control.Monad.Catch as Exception import qualified Imp.Exception.InvalidOption as InvalidOption import qualified Imp.Exception.UnexpectedArgument as UnexpectedArgument import qualified Imp.Exception.UnknownOption as UnknownOption import qualified System.Console.GetOpt as GetOpt data Flag = Alias String | Help Bool | Version Bool deriving (Flag -> Flag -> Bool (Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Flag -> Flag -> Bool == :: Flag -> Flag -> Bool $c/= :: Flag -> Flag -> Bool /= :: Flag -> Flag -> Bool Eq, Int -> Flag -> ShowS [Flag] -> ShowS Flag -> String (Int -> Flag -> ShowS) -> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Flag -> ShowS showsPrec :: Int -> Flag -> ShowS $cshow :: Flag -> String show :: Flag -> String $cshowList :: [Flag] -> ShowS showList :: [Flag] -> ShowS Show) options :: [GetOpt.OptDescr Flag] options :: [OptDescr Flag] options = [ String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a GetOpt.Option [Char 'h', Char '?'] [String "help"] (Flag -> ArgDescr Flag forall a. a -> ArgDescr a GetOpt.NoArg (Flag -> ArgDescr Flag) -> Flag -> ArgDescr Flag forall a b. (a -> b) -> a -> b $ Bool -> Flag Help Bool True) String "Prints this help message then exits.", String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a GetOpt.Option [] [String "no-help"] (Flag -> ArgDescr Flag forall a. a -> ArgDescr a GetOpt.NoArg (Flag -> ArgDescr Flag) -> Flag -> ArgDescr Flag forall a b. (a -> b) -> a -> b $ Bool -> Flag Help Bool False) String "", String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a GetOpt.Option [Char 'v'] [String "version"] (Flag -> ArgDescr Flag forall a. a -> ArgDescr a GetOpt.NoArg (Flag -> ArgDescr Flag) -> Flag -> ArgDescr Flag forall a b. (a -> b) -> a -> b $ Bool -> Flag Version Bool True) String "Prints the version number then exits.", String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a GetOpt.Option [] [String "no-version"] (Flag -> ArgDescr Flag forall a. a -> ArgDescr a GetOpt.NoArg (Flag -> ArgDescr Flag) -> Flag -> ArgDescr Flag forall a b. (a -> b) -> a -> b $ Bool -> Flag Version Bool False) String "", String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a GetOpt.Option [] [String "alias"] ((String -> Flag) -> String -> ArgDescr Flag forall a. (String -> a) -> String -> ArgDescr a GetOpt.ReqArg String -> Flag Alias String "SOURCE:TARGET") String "Adds a new alias, allowing TARGET to be used in place of SOURCE. \ \For example `--alias=Data.String:String` allows `String.words` to mean `Data.String.words`. \ \Later aliases will overwrite earlier ones." ] fromArguments :: (Exception.MonadThrow m) => [String] -> m [Flag] fromArguments :: forall (m :: * -> *). MonadThrow m => [String] -> m [Flag] fromArguments [String] arguments = do let ([Flag] flgs, [String] args, [String] opts, [String] errs) = ArgOrder Flag -> [OptDescr Flag] -> [String] -> ([Flag], [String], [String], [String]) forall a. ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String], [String]) GetOpt.getOpt' ArgOrder Flag forall a. ArgOrder a GetOpt.Permute [OptDescr Flag] options [String] arguments (String -> m Any) -> [String] -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (UnexpectedArgument -> m Any forall e a. (HasCallStack, Exception e) => e -> m a forall (m :: * -> *) e a. (MonadThrow m, HasCallStack, Exception e) => e -> m a Exception.throwM (UnexpectedArgument -> m Any) -> (String -> UnexpectedArgument) -> String -> m Any forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> UnexpectedArgument UnexpectedArgument.new) [String] args (String -> m Any) -> [String] -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (UnknownOption -> m Any forall e a. (HasCallStack, Exception e) => e -> m a forall (m :: * -> *) e a. (MonadThrow m, HasCallStack, Exception e) => e -> m a Exception.throwM (UnknownOption -> m Any) -> (String -> UnknownOption) -> String -> m Any forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> UnknownOption UnknownOption.new) [String] opts (String -> m Any) -> [String] -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (InvalidOption -> m Any forall e a. (HasCallStack, Exception e) => e -> m a forall (m :: * -> *) e a. (MonadThrow m, HasCallStack, Exception e) => e -> m a Exception.throwM (InvalidOption -> m Any) -> (String -> InvalidOption) -> String -> m Any forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> InvalidOption InvalidOption.new) [String] errs [Flag] -> m [Flag] forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure [Flag] flgs