Completed untested Flattening implementation

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 @@
+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 <- fst <$> 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'