diff options
Diffstat (limited to '')
-rw-r--r-- | src/Conftrack/Value.hs | 54 |
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) |