src/Data/JLD/Flattening.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

module Data.JLD.Flattening (flatten) where

import Data.JLD.Prelude

import Data.JLD.Flattening.NodeMap (buildNodeMap)

import Data.Aeson (Array, Value (..))
import Data.Foldable.WithIndex (FoldableWithIndex (..))
import Data.JLD.Flattening.Global (JLDFlatteningT)
import Data.JLD.Model.Keyword (Keyword (..))
import Data.JLD.Model.NodeMap (PropertyMap, SubjectMap, propsToKeyMap)
import Data.Map qualified as M (insert, lookup, member, singleton, size)
import Data.Vector qualified as V

collectGraphsStep :: Text -> SubjectMap -> SubjectMap -> SubjectMap
collectGraphsStep graphName dg graph
    | graphName == show KeywordDefault = dg
    | otherwise = M.insert (Just graphName) entry' dg
  where
    -- 4.1. 4.2.
    entry = case M.lookup (Just graphName) dg of
        Just e -> e
        Nothing -> M.singleton (Just <| show KeywordId) (String graphName)

    graphArray = Array <| foldl' collectNodesStep mempty graph

    entry' = M.insert (Just <| show KeywordGraph) graphArray entry

collectNodesStep :: Array -> PropertyMap -> Array
collectNodesStep ar node
    | M.size node == 1 && M.member (Just <| show KeywordId) node = ar
    | otherwise = V.snoc ar (Object <| propsToKeyMap node)

flatten :: Monad m => Value -> JLDFlatteningT e m Value
flatten element = do
    -- 1. 2.
    (nodeMap, _, _, _) <- buildNodeMap element id

    -- 3. 4.
    let defaultGraph = fromMaybe mempty <| M.lookup (show KeywordDefault) nodeMap
        defaultGraph' = ifoldl' collectGraphsStep defaultGraph nodeMap

    -- 5. 6. 7.
    pure <. Array <| foldl' collectNodesStep mempty defaultGraph'