aboutsummaryrefslogtreecommitdiff
path: root/Data
diff options
context:
space:
mode:
Diffstat (limited to 'Data')
-rw-r--r--Data/ConfigManager.hs6
-rw-r--r--Data/ConfigManager/Instances.hs24
-rw-r--r--Data/ConfigManager/Parser/Duration.hs36
-rw-r--r--Data/ConfigManager/Types.hs2
-rw-r--r--Data/ConfigManager/Types/Internal.hs9
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