{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Conferer.Types where
import Data.String
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Map (Map)
import qualified Data.Map as Map
import Control.Exception
import Data.Typeable
import GHC.Generics
data Source =
Source
{ getKeyInSource :: Key -> IO (Maybe Text)
}
newtype Key
= Path { unKey :: [Text] }
deriving (Show, Eq, Ord)
instance IsString Key where
fromString s = Path $ filter (/= mempty) $ Text.split (== '.') $ fromString s
keyName :: Key -> Text
keyName = Text.intercalate "." . unKey
data Config =
Config
{ sources :: [Source]
, defaults :: Map Key Text
}
type SourceCreator = Config -> IO Source
keyNotPresentError :: forall a. (Typeable a) => Key -> Proxy a -> FailedToFetchError
keyNotPresentError key =
throw $ FailedToFetchError key $ typeRep (Proxy :: Proxy a)
class DefaultConfig a where
configDef :: a
class FromConfig a where
updateFromConfig :: Key -> Config -> a -> IO a
default updateFromConfig :: (Generic a, Typeable a, FromConfigG (Rep a)) => Key -> Config -> a -> IO a
updateFromConfig k c a = to <$> updateFromConfigG k c (from a)
fetchFromConfig :: Key -> Config -> IO (Maybe a)
default fetchFromConfig :: (Generic a, FromConfigG (Rep a)) => Key -> Config -> IO (Maybe a)
fetchFromConfig k c = fmap to <$> fetchFromConfigG k c
class FromConfigG f where
updateFromConfigG :: Key -> Config -> f a -> IO (f a)
fetchFromConfigG :: Key -> Config -> IO (Maybe (f a))
data ConfigParsingError =
ConfigParsingError Key Text TypeRep
deriving (Typeable, Eq)
instance Show ConfigParsingError where
show (ConfigParsingError key value typeRep) =
concat
[ "Couldn't parse value '"
, Text.unpack value
, "' from key '"
, Text.unpack (keyName key)
, "' as "
, show typeRep
]
instance Exception ConfigParsingError
data FailedToFetchError =
FailedToFetchError Key TypeRep
deriving (Typeable, Eq)
instance Show FailedToFetchError where
show (FailedToFetchError key typeRep) =
concat
[ "Couldn't get a "
, show typeRep
, " from key '"
, Text.unpack (keyName key)
, "'"
]
instance Exception FailedToFetchError