aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorVolpeon <github@volpeon.ink>2023-05-28 08:13:08 +0200
committerVolpeon <github@volpeon.ink>2023-05-28 08:13:08 +0200
commit8c49a30faa431b8b56a4b4926e7dae56b1311fea (patch)
tree6a103b49cdfe6df38fadad1f9d59521dd92ebf74 /src
parentAdded Node Map Merging algorithm (diff)
downloadhs-jsonld-8c49a30faa431b8b56a4b4926e7dae56b1311fea.tar.gz
hs-jsonld-8c49a30faa431b8b56a4b4926e7dae56b1311fea.tar.bz2
hs-jsonld-8c49a30faa431b8b56a4b4926e7dae56b1311fea.zip
Completed untested Flattening implementation
Diffstat (limited to 'src')
-rw-r--r--src/Data/JLD.hs9
-rw-r--r--src/Data/JLD/Flattening.hs44
-rw-r--r--src/Data/JLD/Flattening/Global.hs7
-rw-r--r--src/Data/JLD/Flattening/NodeMap.hs18
-rw-r--r--src/Data/JLD/Model/NodeMap.hs16
5 files changed, 87 insertions, 7 deletions
diff --git a/src/Data/JLD.hs b/src/Data/JLD.hs
index c5c28eb..d7688d0 100644
--- a/src/Data/JLD.hs
+++ b/src/Data/JLD.hs
@@ -5,6 +5,7 @@ module Data.JLD (
5 JLDExpansionParams (..), 5 JLDExpansionParams (..),
6 JLDExpansionState (..), 6 JLDExpansionState (..),
7 expand, 7 expand,
8 flatten,
8) where 9) where
9 10
10import Data.JLD.Prelude 11import Data.JLD.Prelude
@@ -15,6 +16,7 @@ import Data.JLD.Expansion (JLDEParams (..))
15import Data.JLD.Expansion qualified as E (expand) 16import Data.JLD.Expansion qualified as E (expand)
16import Data.JLD.Expansion.Context (buildActiveContext) 17import Data.JLD.Expansion.Context (buildActiveContext)
17import Data.JLD.Expansion.Global (JLDExpansionEnv (..), JLDExpansionState (..)) 18import Data.JLD.Expansion.Global (JLDExpansionEnv (..), JLDExpansionState (..))
19import Data.JLD.Flattening qualified as F (flatten)
18import Data.JLD.Mime 20import Data.JLD.Mime
19import Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext) 21import Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext)
20import Data.JLD.Model.Keyword (Keyword (..)) 22import Data.JLD.Model.Keyword (Keyword (..))
@@ -97,3 +99,10 @@ expand document baseUrl paramsFn = do
97 Left err -> Left err 99 Left err -> Left err
98 100
99 pure (result', state') 101 pure (result', state')
102
103flatten :: Monad m => Value -> URI -> (JLDExpansionParams () m -> JLDExpansionParams e m) -> m (Either (JLDError e) Value, JLDExpansionState)
104flatten document baseUrl paramsFn = do
105 (result, state') <- expand document baseUrl paramsFn
106 case result of
107 Left err -> pure (Left err, state')
108 Right expanded -> fmap (,state') <. runExceptT <| F.flatten expanded
diff --git a/src/Data/JLD/Flattening.hs b/src/Data/JLD/Flattening.hs
new file mode 100644
index 0000000..2bfd8dd
--- /dev/null
+++ b/src/Data/JLD/Flattening.hs
@@ -0,0 +1,44 @@
1module Data.JLD.Flattening (flatten) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Flattening.NodeMap (buildNodeMap)
6
7import Data.Aeson (Array, Value (..))
8import Data.Foldable.WithIndex (FoldableWithIndex (..))
9import Data.JLD.Flattening.Global (JLDFlatteningT)
10import Data.JLD.Model.Keyword (Keyword (..))
11import Data.JLD.Model.NodeMap (PropertyMap, SubjectMap, propsToKeyMap)
12import Data.Map qualified as M (insert, lookup, member, singleton, size)
13import Data.Vector qualified as V
14
15collectGraphsStep :: Text -> SubjectMap -> SubjectMap -> SubjectMap
16collectGraphsStep graphName dg graph
17 | graphName == show KeywordDefault = dg
18 | otherwise = M.insert (Just graphName) entry' dg
19 where
20 -- 4.1. 4.2.
21 entry = case M.lookup (Just graphName) dg of
22 Just e -> e
23 Nothing -> M.singleton (Just <| show KeywordId) (String graphName)
24
25 graphArray = Array <| foldl' collectNodesStep mempty graph
26
27 entry' = M.insert (Just <| show KeywordGraph) graphArray entry
28
29collectNodesStep :: Array -> PropertyMap -> Array
30collectNodesStep ar node
31 | M.size node == 1 && M.member (Just <| show KeywordId) node = ar
32 | otherwise = V.snoc ar (Object <| propsToKeyMap node)
33
34flatten :: Monad m => Value -> JLDFlatteningT e m Value
35flatten element = do
36 -- 1. 2.
37 nodeMap <- fst <$> buildNodeMap element id
38
39 -- 3. 4.
40 let defaultGraph = fromMaybe mempty <| M.lookup (show KeywordDefault) nodeMap
41 defaultGraph' = ifoldl' collectGraphsStep defaultGraph nodeMap
42
43 -- 5. 6. 7.
44 pure <. Array <| foldl' collectNodesStep mempty defaultGraph'
diff --git a/src/Data/JLD/Flattening/Global.hs b/src/Data/JLD/Flattening/Global.hs
new file mode 100644
index 0000000..591d3ad
--- /dev/null
+++ b/src/Data/JLD/Flattening/Global.hs
@@ -0,0 +1,7 @@
1module Data.JLD.Flattening.Global (JLDFlatteningT) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Error (JLDError)
6
7type JLDFlatteningT e m = ExceptT (JLDError e) m
diff --git a/src/Data/JLD/Flattening/NodeMap.hs b/src/Data/JLD/Flattening/NodeMap.hs
index 919aec7..65db9ab 100644
--- a/src/Data/JLD/Flattening/NodeMap.hs
+++ b/src/Data/JLD/Flattening/NodeMap.hs
@@ -2,8 +2,9 @@ module Data.JLD.Flattening.NodeMap (NodeMap, BNMParams (..), buildNodeMap, merge
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, runREST, withErrorRES')
6import Data.JLD.Error (JLDError (..)) 6import Data.JLD.Error (JLDError (..))
7import Data.JLD.Flattening.Global (JLDFlatteningT)
7import Data.JLD.Model.IRI (isBlankIri) 8import Data.JLD.Model.IRI (isBlankIri)
8import Data.JLD.Model.Keyword (Keyword (..), isKeywordLike, isNotKeyword) 9import Data.JLD.Model.Keyword (Keyword (..), isKeywordLike, isNotKeyword)
9import Data.JLD.Model.NodeMap (NodeMap, PropertyMap) 10import Data.JLD.Model.NodeMap (NodeMap, PropertyMap)
@@ -12,7 +13,7 @@ import Data.JLD.Model.NodeObject (isNodeObject)
12import Data.JLD.Util (valueIsScalar, valueToArray, valueToNonNullArray) 13import Data.JLD.Util (valueIsScalar, valueToArray, valueToNonNullArray)
13 14
14import Control.Monad.Except (MonadError (..)) 15import Control.Monad.Except (MonadError (..))
15import Data.Aeson (Array, Key, Object, Value (..)) 16import Data.Aeson (Array, Object, Value (..))
16import Data.Aeson.Key qualified as K (toText) 17import Data.Aeson.Key qualified as K (toText)
17import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member, singleton) 18import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member, singleton)
18import Data.Foldable.WithIndex (FoldableWithIndex (..), iforM_) 19import Data.Foldable.WithIndex (FoldableWithIndex (..), iforM_)
@@ -85,7 +86,10 @@ bnmBuildNodeMap value paramsFn = do
85 , bnmParamsActiveSubject = bnmEnvActiveSubject 86 , bnmParamsActiveSubject = bnmEnvActiveSubject
86 , bnmParamsActiveProperty = bnmEnvActiveProperty 87 , bnmParamsActiveProperty = bnmEnvActiveProperty
87 } 88 }
88 (nodeMap', list) <- buildNodeMap value params 89 (nodeMap', list) <-
90 buildNodeMap value params |> runExceptT >=> \case
91 Left err -> throwError <| Left err
92 Right a -> pure a
89 bnmModifyNodeMap <| const nodeMap' 93 bnmModifyNodeMap <| const nodeMap'
90 pure list 94 pure list
91 95
@@ -269,10 +273,12 @@ buildNodeMap' element = case element of
269 -- 273 --
270 _ -> pure () 274 _ -> pure ()
271 275
272buildNodeMap :: Monad m => Value -> (BNMParams -> BNMParams) -> m (NodeMap, Maybe Array) 276buildNodeMap :: Monad m => Value -> (BNMParams -> BNMParams) -> JLDFlatteningT e m (NodeMap, Maybe Array)
273buildNodeMap document paramsFn = do 277buildNodeMap document paramsFn = do
274 BNMState{..} <- buildNodeMap' document |> execREST env st 278 (result, BNMState{..}) <- buildNodeMap' document |> runREST env st
275 pure (bnmStateNodeMap, bnmStateList) 279 case result of
280 Left (Left err) -> throwError err
281 _ -> pure (bnmStateNodeMap, bnmStateList)
276 where 282 where
277 BNMParams{..} = 283 BNMParams{..} =
278 paramsFn 284 paramsFn
diff --git a/src/Data/JLD/Model/NodeMap.hs b/src/Data/JLD/Model/NodeMap.hs
index d0fb2f9..f76c662 100644
--- a/src/Data/JLD/Model/NodeMap.hs
+++ b/src/Data/JLD/Model/NodeMap.hs
@@ -10,13 +10,18 @@ module Data.JLD.Model.NodeMap (
10 hasKey2, 10 hasKey2,
11 hasKey3, 11 hasKey3,
12 memberArray, 12 memberArray,
13 propsToKeyMap,
13) where 14) where
14 15
15import Data.JLD.Prelude hiding (modify) 16import Data.JLD.Prelude hiding (modify)
16 17
17import Data.Aeson (Array, Value (..)) 18import Data.Aeson (Array, Value (..))
19import Data.Aeson.Key qualified as K
20import Data.Aeson.KeyMap (KeyMap)
21import Data.Aeson.KeyMap qualified as KM
22import Data.Foldable.WithIndex (FoldableWithIndex (..))
18import Data.JLD.Util (valueToArray) 23import Data.JLD.Util (valueToArray)
19import Data.Map.Strict qualified as M (alter, insert, lookup, member) 24import Data.Map.Strict qualified as M (alter, insert, lookup, member, toList)
20 25
21type PropertyKey = Maybe Text 26type PropertyKey = Maybe Text
22type PropertyMap = Map PropertyKey Value 27type PropertyMap = Map PropertyKey Value
@@ -55,3 +60,12 @@ memberArray :: GraphKey -> SubjectKey -> PropertyKey -> Value -> NodeMap -> Bool
55memberArray graphName subject property value nodeMap = case lookup3 graphName subject property nodeMap of 60memberArray graphName subject property value nodeMap = case lookup3 graphName subject property nodeMap of
56 Just (Array a) -> value `elem` a 61 Just (Array a) -> value `elem` a
57 _ -> False 62 _ -> False
63
64propsToKeyMap :: PropertyMap -> KeyMap Value
65propsToKeyMap =
66 ifoldl'
67 ( \maybeKey km value -> case maybeKey of
68 Just key -> KM.insert (K.fromText key) value km
69 Nothing -> km
70 )
71 mempty