module Console.Options.Types
( Argument(..)
, Command(..)
, CommandHier(..)
, Action
, UnnamedIndex
, Flag(..)
, FlagLevel(..)
, FlagParam(..)
, FlagMany(..)
, Arg(..)
, ArgRemaining(..)
, Params(..)
, Param
, getParams
) where
import Console.Options.Flags (FlagDesc)
import Console.Options.Nid
data Argument =
Argument
{ argumentName :: String
, argumentDescription :: String
, argumentValidate :: String -> Maybe String
}
| ArgumentCatchAll
{ argumentName :: String
, argumentDescription :: String
}
data Flag a where
Flag :: Nid -> Flag Bool
data FlagLevel a where
FlagLevel :: Nid -> FlagLevel Int
data FlagParam a where
FlagParamOpt :: Nid -> a -> (String -> a) -> FlagParam a
FlagParam :: Nid -> (String -> a) -> FlagParam a
newtype FlagMany a = FlagMany (FlagParam a)
data Arg a where
Arg :: UnnamedIndex -> (String -> a) -> Arg a
data ArgRemaining a where
ArgsRemaining :: ArgRemaining [String]
type UnnamedIndex = Int
data Command r = Command
{ getCommandHier :: CommandHier r
, getCommandDescription :: String
, getCommandOptions :: [FlagDesc]
, getCommandAction :: Maybe (Action r)
}
data CommandHier r =
CommandTree [(String, Command r)]
| CommandLeaf [Argument]
data Params = Params
{ paramsFlags :: [(Nid, Maybe String)]
, paramsPinnedArgs :: [String]
, paramsRemainingArgs :: [String]
}
type Action r = (forall a p . Param p => p a -> Ret p a) -> r
class Param p where
type Ret p a :: *
getParams :: Params -> (forall a . p a -> Ret p a)
instance Param Flag where
type Ret Flag a = Bool
getParams (Params flagArgs _ _) (Flag nid) =
maybe False (const True) $ lookup nid flagArgs
instance Param FlagLevel where
type Ret FlagLevel a = Int
getParams (Params flagArgs _ _) (FlagLevel nid) =
length $ filter ((== nid) . fst) flagArgs
instance Param FlagParam where
type Ret FlagParam a = Maybe a
getParams (Params flagArgs _ _) (FlagParamOpt nid a p) =
case lookup nid flagArgs of
Just (Just param) -> Just (p param)
Just Nothing -> Just a
Nothing -> Nothing
getParams (Params flagArgs _ _) (FlagParam nid p) =
case lookup nid flagArgs of
Just Nothing -> error "internal error: parameter is missing"
Just (Just param) -> Just (p param)
Nothing -> Nothing
instance Param FlagMany where
type Ret FlagMany a = [a]
getParams (Params flagArgs _ _) (FlagMany (FlagParamOpt nid a p)) =
let margs = map snd $ filter ((== nid) . fst) flagArgs
in map (maybe a p) margs
getParams (Params flagArgs _ _) (FlagMany (FlagParam nid p)) =
let margs = map snd $ filter ((== nid) . fst) flagArgs
in map (maybe (error "") p) margs
instance Param Arg where
type Ret Arg a = a
getParams (Params _ unnamedArgs _) (Arg index p) =
p (unnamedArgs !! index)
instance Param ArgRemaining where
type Ret ArgRemaining a = [String]
getParams (Params _ _ otherArgs) _ = otherArgs