From 838ed8229ed13959d9235b5eafae959e8b8421c4 Mon Sep 17 00:00:00 2001 From: Volpeon Date: Sat, 27 May 2023 20:36:26 +0200 Subject: Added Node Map Generation algorithm --- src/Data/JLD/Model/NodeMap.hs | 45 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 src/Data/JLD/Model/NodeMap.hs (limited to 'src/Data/JLD/Model/NodeMap.hs') 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 -- cgit v1.2.3-54-g00ecf