Added Node Map Generation algorithm

1 files changed, 45 insertions, 0 deletions

diff --git a/src/Data/JLD/Model/NodeMap.hs b/src/Data/JLD/Model/NodeMap.hs
new file mode 100644
index 0000000..48db17e
--- /dev/null
+++ b/src/Data/JLD/Model/NodeMap.hs
@@ -0,0 +1,45 @@
+module Data.JLD.Model.NodeMap (NodeMap, lookup, lookup2, lookup3, insert, modifyArray, hasKey2, hasKey3, memberArray) where
+
+import Data.JLD.Prelude hiding (modify)
+
+import Data.Aeson (Array, Value (..))
+import Data.JLD.Util (valueToArray)
+import Data.Map.Strict qualified as M (alter, insert, lookup, member)
+
+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