aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD/Flattening.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/JLD/Flattening.hs')
-rw-r--r--src/Data/JLD/Flattening.hs44
1 files changed, 44 insertions, 0 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'