module System.Console.CmdArgs.Type where
import Data.Dynamic
import Data.Data
import Data.List
import Data.Maybe
import Data.Char
import Data.Function
data Mode a = Mode
{modeVal :: a
,modeName :: String
,modeText :: String
,modeHelpSuffix :: [String]
,modeExplicit :: Bool
,modeDef :: Bool
,modeProg :: Maybe String
,modeFlags :: [Flag]
}
deriving Show
modeDefault = Mode{modeText="",modeHelpSuffix=[],modeExplicit=False,modeDef=False,modeProg=Nothing}
data Flag = Flag
{flagName :: String
,flagKey :: String
,flagArgs :: Maybe (Maybe Int)
,flagType :: FlagType
,flagVal :: Dynamic
,flagOpt :: Maybe String
,flagTyp :: String
,flagText :: String
,flagFlag :: [String]
,flagUnknown :: Bool
,flagExplicit :: Bool
}
deriving Show
flagDefault = Flag{flagArgs=Nothing,flagOpt=Nothing,flagTyp="",flagText="",flagFlag=[],flagUnknown=False,flagExplicit=False}
isFlagFlag = not . isFlagArgs
isFlagArgs = isJust . flagArgs
isFlagBool x = case flagType x of FlagBool{} -> True; _ -> False
isFlagOpt = isJust . flagOpt
flagTypDef def x = case flagTyp x of "" -> def; y -> y
data FlagType
= FlagBool Dynamic
| FlagItem (String -> Maybe (Dynamic -> Dynamic))
instance Show FlagType where
show (FlagBool x) = "FlagBool " ++ show x
show (FlagItem x) = "FlagItem <function>"
toFlagType :: TypeRep -> Maybe FlagType
toFlagType typ
| typ == typeOf True = Just $ FlagBool $ toDyn True
| Just r <- toFlagTypeRead False typ = Just $ FlagItem r
| a == typeRepTyCon (typeOf ""), Just r <- toFlagTypeRead True (head b) = Just $ FlagItem r
where (a,b) = splitTyConApp typ
toFlagTypeRead :: Bool -> TypeRep -> Maybe (String -> Maybe (Dynamic -> Dynamic))
toFlagTypeRead list x
| x == typeOf "" = with (\x -> [(x,"")])
| x == typeOf (0 :: Int) = with (reads :: ReadS Int)
| x == typeOf (0 :: Integer) = with (reads :: ReadS Integer)
| x == typeOf (0 :: Float) = with (reads :: ReadS Float)
| x == typeOf (0 :: Double) = with (reads :: ReadS Double)
| otherwise = Nothing
where
with :: forall a . Typeable a => ReadS a -> Maybe (String -> Maybe (Dynamic -> Dynamic))
with r = Just $ \x -> case r x of
[(v,"")] -> Just $ \old -> if list then toDyn $ fromJust (fromDynamic old) ++ [v] else toDyn v
_ -> Nothing