aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD/Model/NodeMap.hs
blob: f76c66235e19b5c29cd3107a1ea7ec671bc0027b (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
module Data.JLD.Model.NodeMap (
    NodeMap,
    SubjectMap,
    PropertyMap,
    lookup,
    lookup2,
    lookup3,
    insert,
    modifyArray,
    hasKey2,
    hasKey3,
    memberArray,
    propsToKeyMap,
) where

import Data.JLD.Prelude hiding (modify)

import Data.Aeson (Array, Value (..))
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap (KeyMap)
import Data.Aeson.KeyMap qualified as KM
import Data.Foldable.WithIndex (FoldableWithIndex (..))
import Data.JLD.Util (valueToArray)
import Data.Map.Strict qualified as M (alter, insert, lookup, member, toList)

type PropertyKey = Maybe Text
type PropertyMap = Map PropertyKey Value

type SubjectKey = Maybe Text
type SubjectMap = Map SubjectKey PropertyMap

type GraphKey = Text
type NodeMap = Map GraphKey SubjectMap

lookup :: GraphKey -> NodeMap -> Maybe SubjectMap
lookup = M.lookup

lookup2 :: GraphKey -> SubjectKey -> NodeMap -> Maybe PropertyMap
lookup2 graphName subject nodeMap = M.lookup graphName nodeMap >>= M.lookup subject

lookup3 :: GraphKey -> SubjectKey -> PropertyKey -> NodeMap -> Maybe Value
lookup3 graphName subject property nodeMap =
    M.lookup graphName nodeMap >>= M.lookup subject >>= M.lookup property

modifyArray :: GraphKey -> SubjectKey -> PropertyKey -> (Array -> Array) -> NodeMap -> NodeMap
modifyArray graphName subject property fn =
    M.alter (Just <. M.alter (Just <. M.alter (Just <. Array <. fn <. maybe mempty valueToArray) property <. fromMaybe mempty) subject <. fromMaybe mempty) graphName

insert :: GraphKey -> SubjectKey -> PropertyKey -> Value -> NodeMap -> NodeMap
insert graphName subject property value =
    M.alter (Just <. M.alter (Just <. M.insert property value <. fromMaybe mempty) subject <. fromMaybe mempty) graphName

hasKey2 :: GraphKey -> SubjectKey -> NodeMap -> Bool
hasKey2 graphName subject nodeMap = maybe False (M.member subject) <| M.lookup graphName nodeMap

hasKey3 :: GraphKey -> SubjectKey -> PropertyKey -> NodeMap -> Bool
hasKey3 graphName subject property nodeMap = maybe False (M.member property) <| M.lookup subject =<< M.lookup graphName nodeMap

memberArray :: GraphKey -> SubjectKey -> PropertyKey -> Value -> NodeMap -> Bool
memberArray graphName subject property value nodeMap = case lookup3 graphName subject property nodeMap of
    Just (Array a) -> value `elem` a
    _ -> False

propsToKeyMap :: PropertyMap -> KeyMap Value
propsToKeyMap =
    ifoldl'
        ( \maybeKey km value -> case maybeKey of
            Just key -> KM.insert (K.fromText key) value km
            Nothing -> km
        )
        mempty