blob: 5c8d949959990abf7d45bf14c5703d46519301e2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE OverloadedStrings #-}
module Conftrack.Value (Value(..), ConfigError(..), Key(..), ConfigValue(..), Origin(..), KeyPart, prefixedWith) where
import Data.Text(Text)
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 =
ConfigString BS.ByteString
| ConfigInteger Integer
| ConfigOther Text Text
| ConfigBool Bool
| ConfigNull
deriving Show
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 Text
| TypeMismatch Text Value
| NotPresent Key
| Shadowed
deriving Show
class ConfigValue a where
fromConfig :: Value -> Either ConfigError a
data Origin = Origin Key Text
deriving Show
instance ConfigValue Text where
fromConfig (ConfigString a) = Right (BS.decodeUtf8 a)
fromConfig val = Left (TypeMismatch "text" val)
instance ConfigValue Integer where
fromConfig (ConfigInteger a) = Right a
fromConfig val = Left (TypeMismatch "integer" val)
instance ConfigValue Int where
fromConfig (ConfigInteger a) = Right (fromInteger a)
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)
|
