From 8c49a30faa431b8b56a4b4926e7dae56b1311fea Mon Sep 17 00:00:00 2001 From: Volpeon Date: Sun, 28 May 2023 08:13:08 +0200 Subject: Completed untested Flattening implementation --- src/Data/JLD/Flattening.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 src/Data/JLD/Flattening.hs (limited to 'src/Data/JLD/Flattening.hs') 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' -- cgit v1.2.3-54-g00ecf