blob: b00be270e159257b23dd2668fe2777a91ba5003f (
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
|
module Store.Query.Record
( Record (..),
fromValue,
toValue,
lookup,
Records,
lookups,
disjointUnion,
disjointUnions,
)
where
import Control.Exception (throw)
import Data.Aeson qualified as J
import Data.Aeson.Key qualified as JK
import Data.Aeson.KeyMap qualified as JM
import Data.List (foldl')
import Data.Maybe (mapMaybe)
import Data.Text qualified as T
import Store.Exception (DuplicateField (DuplicateField))
import Store.Query.Field
import Prelude hiding (lookup)
data Record a
= Record Collection a
deriving (Show, Eq)
type Collection = FilePath
fromValue :: Collection -> a -> Record a
fromValue = Record
toValue :: Record a -> a
toValue (Record _ v) = v
lookup :: Field -> Record J.Value -> Maybe J.Value
lookup (Field c' ks) (Record c v)
| c' == c = lookup' ks v
| otherwise = Nothing
lookup' :: [T.Text] -> J.Value -> Maybe J.Value
lookup' [] v = Just v
lookup' (k : ks) (J.Object kvs) =
lookup' ks =<< JM.lookup (JK.fromText k) kvs
type Records a = [Record a]
lookups :: Field -> Records J.Value -> Maybe J.Value
lookups f rs =
case mapMaybe (lookup f) rs of
[] -> Nothing
[v] -> Just v
(_ : _) -> throw (DuplicateField (toString f))
disjointUnion :: J.Value -> J.Value -> J.Value
disjointUnion (J.Object r) (J.Object s) =
J.Object (JM.unionWithKey disjointUnion' r s)
disjointUnion' :: JK.Key -> J.Value -> J.Value -> J.Value
disjointUnion' _ (J.Object r) (J.Object s) =
J.Object (JM.unionWithKey disjointUnion' r s)
disjointUnion' k _ _ =
throw (DuplicateField (JK.toString k))
disjointUnions :: [J.Value] -> J.Value
disjointUnions = foldl' disjointUnion (J.Object JM.empty)
|
