diff options
Diffstat (limited to 'Data')
-rw-r--r-- | Data/ConfigManager.hs | 6 | ||||
-rw-r--r-- | Data/ConfigManager/Instances.hs | 24 | ||||
-rw-r--r-- | Data/ConfigManager/Parser/Duration.hs | 36 | ||||
-rw-r--r-- | Data/ConfigManager/Types.hs | 2 | ||||
-rw-r--r-- | Data/ConfigManager/Types/Internal.hs | 9 |
5 files changed, 73 insertions, 4 deletions
diff --git a/Data/ConfigManager.hs b/Data/ConfigManager.hs index 37da8b6..a13457c 100644 --- a/Data/ConfigManager.hs +++ b/Data/ConfigManager.hs @@ -34,7 +34,6 @@ module Data.ConfigManager ) where import Prelude hiding (lookup) -import Text.Read (readMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -42,6 +41,7 @@ import qualified Data.HashMap.Strict as M import qualified Data.ConfigManager.Reader as R import Data.ConfigManager.Types +import Data.ConfigManager.Instances () -- | Load a 'Config' from a given 'FilePath'. @@ -50,13 +50,13 @@ readConfig = R.readConfig Required -- | Lookup for the value associated to a name. -lookup :: Read a => Name -> Config -> Either Text a +lookup :: Configured a => Name -> Config -> Either Text a lookup name config = case M.lookup name (hashMap config) of Nothing -> Left . T.concat $ ["Value not found for Key ", name] Just value -> - case readMaybe . T.unpack $ value of + case convert value of Nothing -> Left . T.concat $ ["Reading error for key ", name] Just result -> Right result diff --git a/Data/ConfigManager/Instances.hs b/Data/ConfigManager/Instances.hs new file mode 100644 index 0000000..0855117 --- /dev/null +++ b/Data/ConfigManager/Instances.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE IncoherentInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Data.ConfigManager.Instances + () where + +import qualified Data.Text as T +import Data.Time.Clock (DiffTime, NominalDiffTime) + +import Text.Read (readMaybe) + +import Data.ConfigManager.Types.Internal +import Data.ConfigManager.Parser.Duration (parseDuration) + +instance Configured DiffTime where + convert value = parseDuration value + +instance Configured NominalDiffTime where + convert value = realToFrac <$> parseDuration value + +instance Read a => Configured a where + convert = readMaybe . T.unpack diff --git a/Data/ConfigManager/Parser/Duration.hs b/Data/ConfigManager/Parser/Duration.hs new file mode 100644 index 0000000..f169c55 --- /dev/null +++ b/Data/ConfigManager/Parser/Duration.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.ConfigManager.Parser.Duration + ( parseDuration + ) where + +import Control.Applicative ((<|>)) + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Clock (DiffTime) +import qualified Data.Time.Clock as Time + +import Text.Read (readMaybe) + +parseDuration :: Text -> Maybe DiffTime +parseDuration input = + case T.splitOn " " input of + [count, unit] -> do + n <- readMaybe . T.unpack $ count + let matchDuration singularUnit pluralUnit seconds = + if ((n == 0 || n == 1) && unit == singularUnit) || (n > 1 && unit == pluralUnit) + then Just . Time.secondsToDiffTime $ n * seconds + else Nothing + (matchDuration "second" "seconds" second) + <|> (matchDuration "minute" "minutes" minute) + <|> (matchDuration "hour" "hours" hour) + <|> (matchDuration "day" "days" day) + <|> (matchDuration "week" "weeks" week) + _ -> Nothing + where + second = 1 + minute = 60 * second + hour = 60 * minute + day = 24 * hour + week = 7 * day diff --git a/Data/ConfigManager/Types.hs b/Data/ConfigManager/Types.hs index ea2691f..8939713 100644 --- a/Data/ConfigManager/Types.hs +++ b/Data/ConfigManager/Types.hs @@ -12,6 +12,8 @@ module Data.ConfigManager.Types , Name , Value , Requirement(..) + , Configured + , convert ) where import Data.ConfigManager.Types.Internal diff --git a/Data/ConfigManager/Types/Internal.hs b/Data/ConfigManager/Types/Internal.hs index c4d5d0e..4459b01 100644 --- a/Data/ConfigManager/Types/Internal.hs +++ b/Data/ConfigManager/Types/Internal.hs @@ -4,10 +4,11 @@ module Data.ConfigManager.Types.Internal , Name , Value , Requirement(..) + , Configured + , convert ) where import Data.Text (Text) - import Data.HashMap.Strict -- | Configuration data. @@ -37,3 +38,9 @@ data Requirement = Required | Optional deriving (Eq, Read, Show) + +-- | This class represents types that can be converted /from/ a value /to/ a +-- destination type + +class Configured a where + convert :: Value -> Maybe a |