aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorVolpeon <github@volpeon.ink>2023-05-27 21:19:25 +0200
committerVolpeon <github@volpeon.ink>2023-05-27 21:19:25 +0200
commit4f3dc25f63c21fc74f1b2370335eb83c27d42ecd (patch)
treef1a481dddce751e2c1f98419ca0610cfdac1c277 /src
parentAdded Node Map Generation algorithm (diff)
downloadhs-jsonld-4f3dc25f63c21fc74f1b2370335eb83c27d42ecd.tar.gz
hs-jsonld-4f3dc25f63c21fc74f1b2370335eb83c27d42ecd.tar.bz2
hs-jsonld-4f3dc25f63c21fc74f1b2370335eb83c27d42ecd.zip
Added Node Map Merging algorithm
Diffstat (limited to 'src')
-rw-r--r--src/Data/JLD/Expansion.hs31
-rw-r--r--src/Data/JLD/Flattening/NodeMap.hs35
-rw-r--r--src/Data/JLD/Model/Keyword.hs3
-rw-r--r--src/Data/JLD/Model/NodeMap.hs14
4 files changed, 58 insertions, 25 deletions
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
167 expandValue activeProperty value 167 expandValue activeProperty value
168 |> withStateRES eo1314StateJlde (\eo1314 jld -> eo1314{eo1314StateJlde = jld}) 168 |> withStateRES eo1314StateJlde (\eo1314 jld -> eo1314{eo1314StateJlde = jld})
169 169
170eo1314ExpandKeywordItem :: Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m () 170eo1314ExpandKeywordItem :: forall e m. Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m ()
171eo1314ExpandKeywordItem inputType key keyword value = do 171eo1314ExpandKeywordItem inputType key keyword value = do
172 JLDEEnv{..} <- ask 172 JLDEEnv{..} <- ask
173 let JLDExpansionEnv{..} = jldeEnvGlobal 173 let JLDExpansionEnv{..} = jldeEnvGlobal
@@ -335,15 +335,14 @@ eo1314ExpandKeywordItem inputType key keyword value = do
335 335
336 -- 13.4.13.4. 336 -- 13.4.13.4.
337 unless (KM.size expandedObjectValue == 1 && KM.member (show KeywordReverse) expandedObjectValue) do 337 unless (KM.size expandedObjectValue == 1 && KM.member (show KeywordReverse) expandedObjectValue) do
338 let go key' reverseMap (Array item) | key' /= show KeywordReverse = foldlM (go' key') reverseMap item
339 go _ reverseMap _ = pure reverseMap
340
341 go' _ _ item | isListObject item || isValueObject item = throwError <| InvalidReversePropertyValue
342 go' key' reverseMap item = pure <| mapAddValue key' item True reverseMap
343
338 reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult 344 reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult
339 reverseMap' <- 345 reverseMap' <- ifoldlM go reverseMap expandedObjectValue
340 (\fn -> ifoldlM fn reverseMap expandedObjectValue) <| \key' rm -> \case
341 Array item | key' /= show KeywordReverse -> do
342 (\fn -> foldlM fn rm item) <| \rm' i ->
343 if isListObject i || isValueObject i
344 then throwError <| InvalidReversePropertyValue
345 else pure <| mapAddValue key' i True rm'
346 _ -> pure rm
347 346
348 if KM.null reverseMap' 347 if KM.null reverseMap'
349 then eo1314ModifyResult <| KM.delete (show KeywordReverse) 348 then eo1314ModifyResult <| KM.delete (show KeywordReverse)
@@ -555,16 +554,12 @@ eo1314ExpandNonKeywordItem key expandedProperty value = do
555 -- 13.13. 554 -- 13.13.
556 if maybe False termDefinitionReversePropertyFlag keyTermDefinition 555 if maybe False termDefinitionReversePropertyFlag keyTermDefinition
557 then do 556 then do
558 reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult
559
560 -- 13.13.3. 13.13.4. 557 -- 13.13.3. 13.13.4.
561 reverseMap' <- 558 let go _ item | isListObject item || isValueObject item = throwError InvalidReversePropertyValue
562 (\fn -> foldlM fn reverseMap (valueToArray expandedValue'')) <| \rm item -> 559 go reverseMap item = pure <| mapAddValue (K.fromText expandedProperty) item True reverseMap
563 if isListObject item || isValueObject item 560
564 then -- 13.13.4.1. 561 reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult
565 throwError InvalidReversePropertyValue 562 reverseMap' <- foldlM go reverseMap (valueToArray expandedValue'')
566 else -- 13.13.4.3.
567 pure <| mapAddValue (K.fromText expandedProperty) item True rm
568 563
569 eo1314ModifyResult <| KM.insert (show KeywordReverse) (Object reverseMap') 564 eo1314ModifyResult <| KM.insert (show KeywordReverse) (Object reverseMap')
570 else -- 13.14. 565 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 @@
1module Data.JLD.Flattening.NodeMap (NodeMap, BNMParams (..), buildNodeMap) where 1module Data.JLD.Flattening.NodeMap (NodeMap, BNMParams (..), buildNodeMap, mergeNodeMaps) where
2 2
3import Data.JLD.Prelude 3import Data.JLD.Prelude
4 4
5import Data.JLD.Control.Monad.RES (REST, execREST, withErrorRES') 5import Data.JLD.Control.Monad.RES (REST, execREST, withErrorRES')
6import Data.JLD.Error (JLDError (..)) 6import Data.JLD.Error (JLDError (..))
7import Data.JLD.Model.IRI (isBlankIri) 7import Data.JLD.Model.IRI (isBlankIri)
8import Data.JLD.Model.Keyword (Keyword (..), isNotKeyword) 8import Data.JLD.Model.Keyword (Keyword (..), isKeywordLike, isNotKeyword)
9import Data.JLD.Model.NodeMap (NodeMap) 9import Data.JLD.Model.NodeMap (NodeMap, PropertyMap)
10import Data.JLD.Model.NodeMap qualified as N (hasKey2, hasKey3, insert, lookup3, memberArray, modifyArray) 10import Data.JLD.Model.NodeMap qualified as N (hasKey2, hasKey3, insert, lookup2, lookup3, memberArray, modifyArray)
11import Data.JLD.Model.NodeObject (isNodeObject) 11import Data.JLD.Model.NodeObject (isNodeObject)
12import Data.JLD.Util (valueIsScalar, valueToArray, valueToNonNullArray) 12import Data.JLD.Util (valueIsScalar, valueToArray, valueToNonNullArray)
13 13
14import Control.Monad.Except (MonadError (..)) 14import Control.Monad.Except (MonadError (..))
15import Data.Aeson (Array, Object, Value (..)) 15import Data.Aeson (Array, Key, Object, Value (..))
16import Data.Aeson.Key qualified as K (toText) 16import Data.Aeson.Key qualified as K (toText)
17import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member, singleton) 17import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member, singleton)
18import Data.Foldable.WithIndex (iforM_) 18import Data.Foldable.WithIndex (FoldableWithIndex (..), iforM_)
19import Data.Map.Strict qualified as M (insert, lookup) 19import Data.Map.Strict qualified as M (insert, lookup)
20import Data.Vector qualified as V (singleton, snoc, uniq) 20import Data.Vector qualified as V (singleton, snoc, uniq)
21 21
@@ -300,3 +300,26 @@ buildNodeMap document paramsFn = do
300 , bnmStateIdentifierCounter = 1 300 , bnmStateIdentifierCounter = 1
301 , bnmStateIdentifierMap = mempty 301 , bnmStateIdentifierMap = mempty
302 } 302 }
303
304mergeNodeMaps :: NodeMap -> NodeMap
305mergeNodeMaps = foldl' (ifoldl' go) mempty
306 where
307 go :: Maybe Text -> NodeMap -> PropertyMap -> NodeMap
308 go subjectKey result = ifoldl' (go' subjectKey) result'
309 where
310 result' = case N.lookup2 (show KeywordMerged) subjectKey result of
311 Just _ -> result
312 Nothing -> N.insert (show KeywordMerged) subjectKey (Just <| show KeywordId) (maybe Null String subjectKey) result
313
314 go' :: Maybe Text -> Maybe Text -> NodeMap -> Value -> NodeMap
315 go' subjectKey propertyKey result property
316 | propertyKey /= Just (show KeywordType) && maybe False isKeywordLike propertyKey =
317 N.insert (show KeywordMerged) subjectKey propertyKey property result
318 | otherwise =
319 N.insert (show KeywordMerged) subjectKey propertyKey array result
320 where
321 array =
322 Array
323 <. (<> valueToArray property)
324 <. maybe mempty valueToArray
325 <| 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
32 | KeywordJson 32 | KeywordJson
33 | KeywordLanguage 33 | KeywordLanguage
34 | KeywordList 34 | KeywordList
35 | KeywordMerged
35 | KeywordNest 36 | KeywordNest
36 | KeywordNone 37 | KeywordNone
37 | KeywordNull 38 | KeywordNull
@@ -68,6 +69,7 @@ instance Show Keyword where
68 KeywordJson -> "@json" 69 KeywordJson -> "@json"
69 KeywordLanguage -> "@language" 70 KeywordLanguage -> "@language"
70 KeywordList -> "@list" 71 KeywordList -> "@list"
72 KeywordMerged -> "@merged"
71 KeywordNest -> "@nest" 73 KeywordNest -> "@nest"
72 KeywordNone -> "@none" 74 KeywordNone -> "@none"
73 KeywordNull -> "@null" 75 KeywordNull -> "@null"
@@ -103,6 +105,7 @@ parseKeyword = \case
103 "@json" -> Just KeywordJson 105 "@json" -> Just KeywordJson
104 "@language" -> Just KeywordLanguage 106 "@language" -> Just KeywordLanguage
105 "@list" -> Just KeywordList 107 "@list" -> Just KeywordList
108 "@merged" -> Just KeywordMerged
106 "@nest" -> Just KeywordNest 109 "@nest" -> Just KeywordNest
107 "@none" -> Just KeywordNone 110 "@none" -> Just KeywordNone
108 "@null" -> Just KeywordNull 111 "@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 @@
1module Data.JLD.Model.NodeMap (NodeMap, lookup, lookup2, lookup3, insert, modifyArray, hasKey2, hasKey3, memberArray) where 1module Data.JLD.Model.NodeMap (
2 NodeMap,
3 SubjectMap,
4 PropertyMap,
5 lookup,
6 lookup2,
7 lookup3,
8 insert,
9 modifyArray,
10 hasKey2,
11 hasKey3,
12 memberArray,
13) where
2 14
3import Data.JLD.Prelude hiding (modify) 15import Data.JLD.Prelude hiding (modify)
4 16