module Test.Tasty.Options
(
IsOption(..)
, OptionSet
, setOption
, changeOption
, lookupOption
, OptionDescription(..)
, safeRead
) where
import Data.Typeable
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Tagged
import Data.Proxy
import Data.Monoid
import Options.Applicative
class Typeable v => IsOption v where
defaultValue :: v
parseValue :: String -> Maybe v
optionName :: Tagged v String
optionHelp :: Tagged v String
optionCLParser :: Parser v
optionCLParser =
nullOption
( reader parse
<> long name
<> value defaultValue
<> help helpString
)
where
name = untag (optionName :: Tagged v String)
helpString = untag (optionHelp :: Tagged v String)
parse =
maybe (Left (ErrorMsg $ "Could not parse " ++ name)) Right .
parseValue
data OptionValue = forall v . IsOption v => OptionValue v
newtype OptionSet = OptionSet (Map TypeRep OptionValue)
instance Monoid OptionSet where
mempty = OptionSet mempty
OptionSet a `mappend` OptionSet b =
OptionSet $ Map.unionWith (flip const) a b
setOption :: IsOption v => v -> OptionSet -> OptionSet
setOption v (OptionSet s) =
OptionSet $ Map.insert (typeOf v) (OptionValue v) s
lookupOption :: forall v . IsOption v => OptionSet -> v
lookupOption (OptionSet s) =
case Map.lookup (typeOf (undefined :: v)) s of
Just (OptionValue x) | Just v <- cast x -> v
Just {} -> error "OptionSet: broken invariant (shouldn't happen)"
Nothing -> defaultValue
changeOption :: forall v . IsOption v => (v -> v) -> OptionSet -> OptionSet
changeOption f s = setOption (f $ lookupOption s) s
data OptionDescription where
Option :: IsOption v => Proxy v -> OptionDescription
safeRead :: Read a => String -> Maybe a
safeRead s
| [(x, "")] <- reads s = Just x
| otherwise = Nothing