Config.hs

{-# OPTIONS_GHC -XMultiParamTypeClasses -XFunctionalDependencies #-}

module Barrie.Config where

import Data.Typeable

data Config a = Cfg {
           cEnabled :: a -> Bool,
           cLabel   :: Maybe (a -> String)
           }

instance (Typeable a) => Typeable (Config a) where
    typeOf cfg = mkTyConApp (mkTyCon "Barrie.Config.Config")
                          [typeOf (cEnabled cfg),
                           typeOf (cLabel cfg)]

defaultConfig :: Config a
defaultConfig = Cfg { cEnabled = const True, cLabel = Nothing }

transformConfig :: (a -> b) -> Config b -> Config a
transformConfig get cfg = cfg { cEnabled = cEnabled cfg . get,
                                cLabel = label'
                              }
    where label' = case cLabel cfg of
                     Nothing -> Nothing
                     Just f  -> Just $ f . get


enabledCfg :: (a -> Bool) -> Config a -> Config a
enabledCfg f config = config { cEnabled = f }

isEnabled :: Config a -> a -> Bool
isEnabled config state = cEnabled config state

labelConfig :: (a -> String) -> Config a -> Config a
labelConfig f config = config { cLabel = Just f }

configHasLabel :: Config a -> Bool
configHasLabel Cfg { cLabel = Nothing } = False
configHasLabel _ = True

configLabel :: Config a -> a -> String
configLabel Cfg { cLabel = Just f } st = f st
configLabel _ _ =
    error "tried to get a label from a config which has none"