aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/JLD')
-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
4 files changed, 78 insertions, 7 deletions
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