{-# LANGUAGE FlexibleInstances #-}
module Conferer.FetchFromConfig.Basics where
import Conferer.Types
import Conferer.Core (getKey, (/.))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.ByteString (ByteString)
import Data.String (IsString, fromString)
import Text.Read (readMaybe)
instance FetchFromConfig Int where
fetch = fetchFromConfigByRead
instance FetchFromConfig Integer where
fetch = fetchFromConfigByRead
instance FetchFromConfig Float where
fetch = fetchFromConfigByRead
fetchFromConfigByRead :: Read a => Key -> Config -> IO (Either Text a)
fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack)
instance FetchFromConfig ByteString where
fetch = fetchFromConfigWith (Just . Text.encodeUtf8)
instance FetchFromConfig a => FetchFromConfig (Maybe a) where
fetch k c = do
v <- getKey k c
if v == Right ""
then return (Right Nothing)
else fmap Just <$> fetch k c
instance FetchFromConfig String where
fetch = fetchFromConfigWith (Just . Text.unpack)
instance FetchFromConfig Text where
fetch = fetchFromConfigWith (Just)
instance FetchFromConfig Bool where
fetch = fetchFromConfigWith parseBool
where
parseBool text =
case Text.toLower text of
"false" -> Just False
"true" -> Just True
_ -> Nothing
fromValueWith :: (Text -> Maybe a) -> Key -> Text -> Either Text a
fromValueWith parseValue key valueAsText = case parseValue valueAsText of
Just value -> Right value
Nothing -> Left ("Key " `Text.append` keyName key `Text.append` " could not be parsed correctly")
fetchFromConfigWith :: (Text -> Maybe a) -> Key -> Config -> IO (Either Text a)
fetchFromConfigWith parseValue key config =
(fromValueWith parseValue key =<<) <$> getKey key config
findKeyAndApplyConfig ::
FetchFromConfig newvalue
=> Config
-> Key
-> Key
-> (newvalue -> config -> config)
-> Either Text config
-> IO (Either Text config)
findKeyAndApplyConfig config k relativeKey f (Right customConfig) =
fetch (k /. relativeKey) config
>>= \case
Left a -> return $ Right customConfig
Right a -> return $ Right $ f a customConfig
findKeyAndApplyConfig config k relativeKey f (Left e) = return $ Left e