summaryrefslogtreecommitdiff
path: root/src/Conftrack/Value.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Conftrack/Value.hs')
-rw-r--r--src/Conftrack/Value.hs54
1 files changed, 46 insertions, 8 deletions
diff --git a/src/Conftrack/Value.hs b/src/Conftrack/Value.hs
index c5768cc..f934d51 100644
--- a/src/Conftrack/Value.hs
+++ b/src/Conftrack/Value.hs
@@ -3,24 +3,40 @@
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE OverloadedStrings #-}
-module Conftrack.Value (Value(..), ConfigError(..), Key(..), ConfigValue(..), Origin(..)) where
+module Conftrack.Value (Value(..), ConfigError(..), Key(..), ConfigValue(..), Origin(..), KeyPart, prefixedWith) where
import Data.Text(Text)
-import Data.List.NonEmpty (NonEmpty)
+import qualified Data.Text as T
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LB
+import Data.List.NonEmpty (NonEmpty, prependList)
+import System.OsPath (OsPath, encodeUtf)
+import qualified Data.Text.Encoding as BS
data Value =
- ConfigText Text
+ ConfigString BS.ByteString
| ConfigInteger Integer
| ConfigOther Text Text
+ | ConfigBool Bool
+ | ConfigNull
deriving Show
-newtype Key = Key (NonEmpty Text)
+type KeyPart = Text
+
+newtype Key = Key (NonEmpty KeyPart)
deriving newtype (Eq, Ord, Show)
+prefixedWith :: Key -> [KeyPart] -> Key
+prefixedWith (Key key) prefix = Key (prependList prefix key)
+
data ConfigError =
- ParseError
+ ParseError Text
+ | TypeMismatch Text Value
| NotPresent
+ | Shadowed
deriving Show
class ConfigValue a where
@@ -30,9 +46,31 @@ data Origin = Origin Key Text
deriving Show
instance ConfigValue Text where
- fromConfig (ConfigText a) = Right a
- fromConfig _ = Left ParseError
+ fromConfig (ConfigString a) = Right (BS.decodeUtf8 a)
+ fromConfig val = Left (TypeMismatch "text" val)
instance ConfigValue Integer where
fromConfig (ConfigInteger a) = Right a
- fromConfig _ = Left ParseError
+ fromConfig val = Left (TypeMismatch "integer" val)
+
+instance ConfigValue Bool where
+ fromConfig (ConfigBool b) = Right b
+ fromConfig val = Left (TypeMismatch "bool" val)
+
+instance ConfigValue a => ConfigValue (Maybe a) where
+ fromConfig ConfigNull = Right Nothing
+ fromConfig just = fmap Just (fromConfig just)
+
+instance ConfigValue OsPath where
+ fromConfig (ConfigString text) = case encodeUtf (T.unpack (BS.decodeUtf8 text)) of
+ Right path -> Right path
+ Left err -> Left (ParseError (T.pack $ show err))
+ fromConfig val = Left (TypeMismatch "path" val)
+
+instance ConfigValue LB.ByteString where
+ fromConfig (ConfigString strict) = Right (LB.fromStrict strict)
+ fromConfig val = Left (TypeMismatch "string" val)
+
+instance ConfigValue BS.ByteString where
+ fromConfig (ConfigString string) = Right string
+ fromConfig val = Left (TypeMismatch "string" val)