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
107
108
109
110
111
112
113
114
115
|
module Data.JLD.Util (
valueContains,
valueContainsAny,
valueIsString,
valueIsArray,
valueIsNotArray,
valueIsEmptyArray,
valueIsScalar,
valueToString,
valueIsNotString,
flattenSingletonArray,
valueToArray,
valueToNonNullArray,
allStrings,
ifindM,
getMapDefault,
mapAddValue,
) where
import Data.JLD.Prelude
import Data.Aeson (Array, Key, Object, Value (..))
import Data.Aeson.Key qualified as K (fromText)
import Data.Aeson.KeyMap qualified as KM (insert, lookup, member)
import Data.Foldable qualified as F (Foldable (..), elem)
import Data.Foldable.WithIndex (FoldableWithIndex (..), ifoldlM)
import Data.Vector (Vector)
import Data.Vector qualified as V (filter, fromList, null, singleton, snoc, uncons)
valueContains :: Text -> Value -> Bool
valueContains text = \case
String s -> s == text
Array a -> elem (String text) a
Object o -> KM.member (K.fromText text) o
_ -> False
valueContainsAny :: (Foldable f, Functor f) => f Text -> Value -> Bool
valueContainsAny texts = \case
String s -> s `F.elem` texts
Array a -> any (`elem` a) <| String <$> texts
Object o -> any (\text -> KM.member (K.fromText text) o) texts
_ -> False
valueIsString :: Value -> Bool
valueIsString (String _) = True
valueIsString _ = False
valueIsNotString :: Value -> Bool
valueIsNotString = valueIsString .> not
valueIsArray :: Value -> Bool
valueIsArray (Array _) = True
valueIsArray _ = False
valueIsNotArray :: Value -> Bool
valueIsNotArray = valueIsArray .> not
valueIsEmptyArray :: Value -> Bool
valueIsEmptyArray (Array a) = V.null a
valueIsEmptyArray _ = False
valueIsScalar :: Value -> Bool
valueIsScalar = \case
String _ -> True
Number _ -> True
Bool _ -> True
_ -> False
valueToString :: Value -> Maybe Text
valueToString (String s) = Just s
valueToString _ = Nothing
flattenSingletonArray :: Value -> Value
flattenSingletonArray = \case
Array (V.uncons -> Just (value, V.null -> True)) -> value
value -> value
valueToArray :: Value -> Array
valueToArray = \case
Array a -> a
value -> V.singleton value
valueToNonNullArray :: Value -> Array
valueToNonNullArray = \case
Null -> mempty
Array a -> V.filter (/= Null) a
value -> V.singleton value
allStrings :: Array -> Maybe (Vector Text)
allStrings = foldl' go (Just mempty)
where
go :: Maybe (Vector Text) -> Value -> Maybe (Vector Text)
go (Just a) (String s) = Just <| V.snoc a s
go _ _ = Nothing
ifindM :: (FoldableWithIndex i f, Monad m) => (i -> a -> m Bool) -> f a -> m (Maybe a)
ifindM p = ifoldlM (\i r x -> p i x <&> bool r (Just x)) Nothing
getMapDefault :: Key -> Object -> Object
getMapDefault key obj = case KM.lookup key obj of
Just (Object o) -> o
_ -> mempty
mapAddValue :: Key -> Value -> Bool -> Object -> Object
mapAddValue key value True object = mapAddValue key value False <| KM.insert key (Array array) object
where
array = case KM.lookup key object of
Just (Array a) -> a
Just original -> V.singleton original
Nothing -> mempty
mapAddValue key (Array value) False object = foldl' (\o v -> mapAddValue key v False o) object value
mapAddValue key value False object = case KM.lookup key object of
Just (Array a) -> KM.insert key (Array <| V.snoc a value) object
Just original -> KM.insert key (Array <| V.fromList [original, value]) object
Nothing -> KM.insert key value object
|
