Added Node Map Merging algorithm

1 files changed, 29 insertions, 6 deletions

diff --git a/src/Data/JLD/Flattening/NodeMap.hs b/src/Data/JLD/Flattening/NodeMap.hs
index 3747402..919aec7 100644
--- a/src/Data/JLD/Flattening/NodeMap.hs
+++ b/src/Data/JLD/Flattening/NodeMap.hs
@@ -1,21 +1,21 @@
-module Data.JLD.Flattening.NodeMap (NodeMap, BNMParams (..), buildNodeMap) where
+module Data.JLD.Flattening.NodeMap (NodeMap, BNMParams (..), buildNodeMap, mergeNodeMaps) where
 
 import Data.JLD.Prelude
 
 import Data.JLD.Control.Monad.RES (REST, execREST, withErrorRES')
 import Data.JLD.Error (JLDError (..))
 import Data.JLD.Model.IRI (isBlankIri)
-import Data.JLD.Model.Keyword (Keyword (..), isNotKeyword)
-import Data.JLD.Model.NodeMap (NodeMap)
-import Data.JLD.Model.NodeMap qualified as N (hasKey2, hasKey3, insert, lookup3, memberArray, modifyArray)
+import Data.JLD.Model.Keyword (Keyword (..), isKeywordLike, isNotKeyword)
+import Data.JLD.Model.NodeMap (NodeMap, PropertyMap)
+import Data.JLD.Model.NodeMap qualified as N (hasKey2, hasKey3, insert, lookup2, lookup3, memberArray, modifyArray)
 import Data.JLD.Model.NodeObject (isNodeObject)
 import Data.JLD.Util (valueIsScalar, valueToArray, valueToNonNullArray)
 
 import Control.Monad.Except (MonadError (..))
-import Data.Aeson (Array, Object, Value (..))
+import Data.Aeson (Array, Key, Object, Value (..))
 import Data.Aeson.Key qualified as K (toText)
 import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member, singleton)
-import Data.Foldable.WithIndex (iforM_)
+import Data.Foldable.WithIndex (FoldableWithIndex (..), iforM_)
 import Data.Map.Strict qualified as M (insert, lookup)
 import Data.Vector qualified as V (singleton, snoc, uniq)
 
@@ -300,3 +300,26 @@ buildNodeMap document paramsFn = do
             , bnmStateIdentifierCounter = 1
             , bnmStateIdentifierMap = mempty
             }
+
+mergeNodeMaps :: NodeMap -> NodeMap
+mergeNodeMaps = foldl' (ifoldl' go) mempty
+  where
+    go :: Maybe Text -> NodeMap -> PropertyMap -> NodeMap
+    go subjectKey result = ifoldl' (go' subjectKey) result'
+      where
+        result' = case N.lookup2 (show KeywordMerged) subjectKey result of
+            Just _ -> result
+            Nothing -> N.insert (show KeywordMerged) subjectKey (Just <| show KeywordId) (maybe Null String subjectKey) result
+
+    go' :: Maybe Text -> Maybe Text -> NodeMap -> Value -> NodeMap
+    go' subjectKey propertyKey result property
+        | propertyKey /= Just (show KeywordType) && maybe False isKeywordLike propertyKey =
+            N.insert (show KeywordMerged) subjectKey propertyKey property result
+        | otherwise =
+            N.insert (show KeywordMerged) subjectKey propertyKey array result
+      where
+        array =
+            Array
+                <. (<> valueToArray property)
+                <. maybe mempty valueToArray
+                <| N.lookup3 (show KeywordMerged) subjectKey propertyKey result