{-# LANGUAGE LambdaCase #-}
module BishBosh.Input.CommandLineOption(
Flag,
CommandLineOption(
),
longFlagPrefix,
categorise,
getArgs,
readArg,
readBoundedIntegral,
mkConfigLocationParameter,
mkIOAction,
mkContextualIOAction,
mkOptionsMutator
) where
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Input.CategorisedCommandLineOptions as Input.CategorisedCommandLineOptions
import qualified BishBosh.Property.Empty as Property.Empty
import qualified Control.Exception
import qualified Data.List
import qualified System.FilePath
type Flag = String
data CommandLineOption options
= ConfigLocationParameter System.FilePath.FilePath
| IOAction Input.CategorisedCommandLineOptions.IOAction
| ContextualIOAction (Input.CategorisedCommandLineOptions.ContextualIOAction options)
| OptionsMutator (Input.CategorisedCommandLineOptions.OptionsMutator options)
mkConfigLocationParameter :: System.FilePath.FilePath -> CommandLineOption options
mkConfigLocationParameter :: FilePath -> CommandLineOption options
mkConfigLocationParameter = FilePath -> CommandLineOption options
forall options. FilePath -> CommandLineOption options
ConfigLocationParameter
mkIOAction :: Input.CategorisedCommandLineOptions.IOAction -> CommandLineOption options
mkIOAction :: IOAction -> CommandLineOption options
mkIOAction = IOAction -> CommandLineOption options
forall options. IOAction -> CommandLineOption options
IOAction
mkContextualIOAction :: Input.CategorisedCommandLineOptions.ContextualIOAction options -> CommandLineOption options
mkContextualIOAction :: ContextualIOAction options -> CommandLineOption options
mkContextualIOAction = ContextualIOAction options -> CommandLineOption options
forall options.
ContextualIOAction options -> CommandLineOption options
ContextualIOAction
mkOptionsMutator :: Input.CategorisedCommandLineOptions.OptionsMutator options -> CommandLineOption options
mkOptionsMutator :: OptionsMutator options -> CommandLineOption options
mkOptionsMutator = OptionsMutator options -> CommandLineOption options
forall options. OptionsMutator options -> CommandLineOption options
OptionsMutator
categorise :: [CommandLineOption options] -> Input.CategorisedCommandLineOptions.CategorisedCommandLineOptions options
categorise :: [CommandLineOption options]
-> CategorisedCommandLineOptions options
categorise = (CommandLineOption options
-> CategorisedCommandLineOptions options
-> CategorisedCommandLineOptions options)
-> CategorisedCommandLineOptions options
-> [CommandLineOption options]
-> CategorisedCommandLineOptions options
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\case
ConfigLocationParameter FilePath
f -> FilePath
-> CategorisedCommandLineOptions options
-> CategorisedCommandLineOptions options
forall options. FilePath -> Transformation options
Input.CategorisedCommandLineOptions.setConfigLocation FilePath
f
IOAction IOAction
a -> IOAction
-> CategorisedCommandLineOptions options
-> CategorisedCommandLineOptions options
forall options. IOAction -> Transformation options
Input.CategorisedCommandLineOptions.prependIOAction IOAction
a
ContextualIOAction ContextualIOAction options
a -> ContextualIOAction options
-> CategorisedCommandLineOptions options
-> CategorisedCommandLineOptions options
forall options.
ContextualIOAction options -> Transformation options
Input.CategorisedCommandLineOptions.prependContextualIOAction ContextualIOAction options
a
OptionsMutator OptionsMutator options
m -> OptionsMutator options
-> CategorisedCommandLineOptions options
-> CategorisedCommandLineOptions options
forall options. OptionsMutator options -> Transformation options
Input.CategorisedCommandLineOptions.prependOptionsMutator OptionsMutator options
m
) CategorisedCommandLineOptions options
forall a. Empty a => a
Property.Empty.empty
longFlagPrefix :: Flag
longFlagPrefix :: FilePath
longFlagPrefix = FilePath
"--"
getArgs
:: [Flag]
-> [String]
-> [String]
getArgs :: [FilePath] -> [FilePath] -> [FilePath]
getArgs [FilePath]
flags = [FilePath] -> [FilePath]
slave where
slave :: [FilePath] -> [FilePath]
slave [] = []
slave (FilePath
x : [FilePath]
xs)
| FilePath
x FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
flags = case [FilePath]
xs of
FilePath
s : [FilePath]
remainder -> FilePath
s FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
slave [FilePath]
remainder
[] -> Exception -> [FilePath]
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> [FilePath])
-> (FilePath -> Exception) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Exception
Data.Exception.mkInsufficientData (FilePath -> Exception)
-> (FilePath -> FilePath) -> FilePath -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
"option " (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows FilePath
x FilePath
" requires an argument."
| (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
(FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`Data.List.isPrefixOf` FilePath
x) (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"=")
) [FilePath]
flags = case (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') FilePath
x of
Char
_ : FilePath
remainder -> FilePath
remainder FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
slave [FilePath]
xs
[] -> Exception -> [FilePath]
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> [FilePath])
-> (FilePath -> Exception) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Exception
Data.Exception.mkNullDatum (FilePath -> Exception)
-> (FilePath -> FilePath) -> FilePath -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
"option " (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows FilePath
x FilePath
" requires a non-null argument."
| Bool
otherwise = [FilePath] -> [FilePath]
slave [FilePath]
xs
read' :: Read a => String -> String -> a
read' :: FilePath -> FilePath -> a
read' FilePath
errorMessage FilePath
s = case ReadS a
forall a. Read a => ReadS a
reads FilePath
s of
[(a
x, FilePath
"")] -> a
x
[(a, FilePath)]
_ -> Exception -> a
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> a) -> (FilePath -> Exception) -> FilePath -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Exception
Data.Exception.mkParseFailure (FilePath -> Exception)
-> (FilePath -> FilePath) -> FilePath -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
errorMessage (FilePath -> a) -> FilePath -> a
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows FilePath
s FilePath
"."
readArg :: Read a => String -> a
readArg :: FilePath -> a
readArg = FilePath -> FilePath -> a
forall a. Read a => FilePath -> FilePath -> a
read' FilePath
"failed to parse command-line argument "
readBoundedIntegral :: Integral i => String -> i
readBoundedIntegral :: FilePath -> i
readBoundedIntegral FilePath
s
| i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
bounded Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
unbounded = Exception -> i
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> i) -> (FilePath -> Exception) -> FilePath -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Exception
Data.Exception.mkOutOfBounds (FilePath -> Exception)
-> (FilePath -> FilePath) -> FilePath -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
"BishBosh.Input.CommandLineOption.readBoundedIntegral:\tintegral value exceeds permissible bounds; " (FilePath -> i) -> FilePath -> i
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows Integer
unbounded FilePath
"."
| Bool
otherwise = i
bounded
where
unbounded :: Integer
unbounded = FilePath -> Integer
forall a. Read a => FilePath -> a
readArg FilePath
s
bounded :: i
bounded = Integer -> i
forall a. Num a => Integer -> a
fromInteger Integer
unbounded