From 4f3dc25f63c21fc74f1b2370335eb83c27d42ecd Mon Sep 17 00:00:00 2001 From: Volpeon Date: Sat, 27 May 2023 21:19:25 +0200 Subject: Added Node Map Merging algorithm --- src/Data/JLD/Expansion.hs | 31 +++++++++++++------------------ src/Data/JLD/Flattening/NodeMap.hs | 35 +++++++++++++++++++++++++++++------ src/Data/JLD/Model/Keyword.hs | 3 +++ src/Data/JLD/Model/NodeMap.hs | 14 +++++++++++++- 4 files changed, 58 insertions(+), 25 deletions(-) (limited to 'src') diff --git a/src/Data/JLD/Expansion.hs b/src/Data/JLD/Expansion.hs index 79a992d..beb10a3 100644 --- a/src/Data/JLD/Expansion.hs +++ b/src/Data/JLD/Expansion.hs @@ -167,7 +167,7 @@ eo1314ExpandValue activeProperty value = do expandValue activeProperty value |> withStateRES eo1314StateJlde (\eo1314 jld -> eo1314{eo1314StateJlde = jld}) -eo1314ExpandKeywordItem :: Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m () +eo1314ExpandKeywordItem :: forall e m. Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m () eo1314ExpandKeywordItem inputType key keyword value = do JLDEEnv{..} <- ask let JLDExpansionEnv{..} = jldeEnvGlobal @@ -335,15 +335,14 @@ eo1314ExpandKeywordItem inputType key keyword value = do -- 13.4.13.4. unless (KM.size expandedObjectValue == 1 && KM.member (show KeywordReverse) expandedObjectValue) do + let go key' reverseMap (Array item) | key' /= show KeywordReverse = foldlM (go' key') reverseMap item + go _ reverseMap _ = pure reverseMap + + go' _ _ item | isListObject item || isValueObject item = throwError <| InvalidReversePropertyValue + go' key' reverseMap item = pure <| mapAddValue key' item True reverseMap + reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult - reverseMap' <- - (\fn -> ifoldlM fn reverseMap expandedObjectValue) <| \key' rm -> \case - Array item | key' /= show KeywordReverse -> do - (\fn -> foldlM fn rm item) <| \rm' i -> - if isListObject i || isValueObject i - then throwError <| InvalidReversePropertyValue - else pure <| mapAddValue key' i True rm' - _ -> pure rm + reverseMap' <- ifoldlM go reverseMap expandedObjectValue if KM.null reverseMap' then eo1314ModifyResult <| KM.delete (show KeywordReverse) @@ -555,16 +554,12 @@ eo1314ExpandNonKeywordItem key expandedProperty value = do -- 13.13. if maybe False termDefinitionReversePropertyFlag keyTermDefinition then do - reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult - -- 13.13.3. 13.13.4. - reverseMap' <- - (\fn -> foldlM fn reverseMap (valueToArray expandedValue'')) <| \rm item -> - if isListObject item || isValueObject item - then -- 13.13.4.1. - throwError InvalidReversePropertyValue - else -- 13.13.4.3. - pure <| mapAddValue (K.fromText expandedProperty) item True rm + let go _ item | isListObject item || isValueObject item = throwError InvalidReversePropertyValue + go reverseMap item = pure <| mapAddValue (K.fromText expandedProperty) item True reverseMap + + reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult + reverseMap' <- foldlM go reverseMap (valueToArray expandedValue'') eo1314ModifyResult <| KM.insert (show KeywordReverse) (Object reverseMap') else -- 13.14. 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 diff --git a/src/Data/JLD/Model/Keyword.hs b/src/Data/JLD/Model/Keyword.hs index 10835a9..ab86164 100644 --- a/src/Data/JLD/Model/Keyword.hs +++ b/src/Data/JLD/Model/Keyword.hs @@ -32,6 +32,7 @@ data Keyword | KeywordJson | KeywordLanguage | KeywordList + | KeywordMerged | KeywordNest | KeywordNone | KeywordNull @@ -68,6 +69,7 @@ instance Show Keyword where KeywordJson -> "@json" KeywordLanguage -> "@language" KeywordList -> "@list" + KeywordMerged -> "@merged" KeywordNest -> "@nest" KeywordNone -> "@none" KeywordNull -> "@null" @@ -103,6 +105,7 @@ parseKeyword = \case "@json" -> Just KeywordJson "@language" -> Just KeywordLanguage "@list" -> Just KeywordList + "@merged" -> Just KeywordMerged "@nest" -> Just KeywordNest "@none" -> Just KeywordNone "@null" -> Just KeywordNull diff --git a/src/Data/JLD/Model/NodeMap.hs b/src/Data/JLD/Model/NodeMap.hs index 48db17e..d0fb2f9 100644 --- a/src/Data/JLD/Model/NodeMap.hs +++ b/src/Data/JLD/Model/NodeMap.hs @@ -1,4 +1,16 @@ -module Data.JLD.Model.NodeMap (NodeMap, lookup, lookup2, lookup3, insert, modifyArray, hasKey2, hasKey3, memberArray) where +module Data.JLD.Model.NodeMap ( + NodeMap, + SubjectMap, + PropertyMap, + lookup, + lookup2, + lookup3, + insert, + modifyArray, + hasKey2, + hasKey3, + memberArray, +) where import Data.JLD.Prelude hiding (modify) -- cgit v1.2.3-54-g00ecf