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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
-- | Functions for producing sources reading from json strings or files, using the aeson library.
module Conftrack.Source.Aeson (mkJsonSource, mkJsonSourceWith, mkJsonFileSource, JsonSource(..)) where
import Conftrack.Value (Key (..), ConfigError(..), Value (..), KeyPart)
import Conftrack.Source (SomeSource(..), ConfigSource (..))
import Prelude hiding (readFile)
import qualified Data.Aeson as A
import Control.Monad.State (get, modify, MonadState (..))
import Data.Function ((&))
import Data.Text (Text)
import qualified Data.Aeson.Text as A
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Aeson.Types as A
import qualified Data.Aeson.Key as A
import Data.Aeson.Types (unexpected)
import qualified Data.List.NonEmpty as NonEmpty
import Control.Monad ((>=>))
import Data.Functor ((<&>))
import System.OsPath (OsPath)
import qualified System.OsPath as OS
import System.File.OsPath (readFile)
import qualified Data.Aeson.KeyMap as A
import qualified Data.Text.Encoding as BS
data JsonSource = JsonSource
{ jsonSourceValue :: A.Value
, jsonSourceDescription :: Text
} deriving (Show)
-- | Make a source from an aeson value
mkJsonSource :: A.Value -> SomeSource
mkJsonSource value = mkJsonSourceWith ("JSON string " <> LT.toStrict (A.encodeToLazyText value)) value
-- | same as 'mkJsonSource', but with an additional description to be shown
-- in output of 'Conftrack.Pretty.printConfigOrigins'.
mkJsonSourceWith :: Text -> A.Value -> SomeSource
mkJsonSourceWith description value = SomeSource (source, [])
where source = JsonSource value description
-- | Make a source from a json file.
mkJsonFileSource :: OsPath -> IO (Maybe SomeSource)
mkJsonFileSource path = do
bytes <- readFile path
pathAsText <- OS.decodeUtf path <&> LT.toStrict . LT.pack
pure $ A.decode bytes
<&> mkJsonSourceWith ("JSON file " <> pathAsText)
instance ConfigSource JsonSource where
type SourceState JsonSource = [Key]
fetchValue key@(Key parts) JsonSource{..} = do
case A.parseEither (lookupJsonPath (NonEmpty.toList parts) >=> parseJsonValue) jsonSourceValue of
Left a -> pure $ Left (ParseError (T.pack a))
Right val -> do
modify (key :)
pure $ Right (val, jsonSourceDescription)
leftovers JsonSource{..} = do
used <- get
allJsonPaths jsonSourceValue
& filter (`notElem` used)
& Just
& pure
-- | this is essentially a FromJSON instance for Value, but not written as one
-- so as to not introduce an orphan
parseJsonValue :: A.Value -> A.Parser Value
parseJsonValue = \case
(A.String bytes) -> pure $ ConfigString (BS.encodeUtf8 bytes)
(A.Number num) ->
A.parseJSON (A.Number num) <&> ConfigInteger
(A.Bool b) -> pure $ ConfigBool b
A.Null -> pure ConfigNull
(A.Object _) -> unexpected "unexpected json object"
(A.Array _) -> unexpected "unexpected json array"
lookupJsonPath :: [KeyPart] -> A.Value -> A.Parser A.Value
lookupJsonPath [] value = pure value
lookupJsonPath (part:parts) value = do
A.withObject "blub" (\obj -> obj A..: A.fromText part) value
>>= lookupJsonPath parts
allJsonPaths :: A.Value -> [Key]
allJsonPaths = fmap keyToKey . subKeys []
where
keyToKey keys = Key (fmap aesonKeyToText keys)
aesonKeyToText (key :: A.Key) = case A.parseMaybe A.parseJSON (A.toJSON key) of
Nothing -> error "key not representable as text; this is a bug in conftrack-aeson."
Just a -> a
subKeys prefix (A.Object keymap) =
A.foldMapWithKey (\key v -> subKeys (prefix <> [key]) v) keymap
subKeys prefix _ = case NonEmpty.nonEmpty prefix of
Just key -> [key]
_ -> undefined
|
