aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD/Util.hs
blob: 8d84778e73b12f6a525e965784d8121a65eb81ee (plain) (blame)
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, 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 -> pure value

valueToNonNullArray :: Value -> Array
valueToNonNullArray = \case
    Null -> mempty
    Array a -> V.filter (/= Null) a
    value -> pure 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 -> pure 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