nested values, tests, and aeson

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)