diff options
Diffstat (limited to 'src/Data/JLD/Flattening.hs')
| -rw-r--r-- | src/Data/JLD/Flattening.hs | 44 |
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 @@ | |||
| 1 | module Data.JLD.Flattening (flatten) where | ||
| 2 | |||
| 3 | import Data.JLD.Prelude | ||
| 4 | |||
| 5 | import Data.JLD.Flattening.NodeMap (buildNodeMap) | ||
| 6 | |||
| 7 | import Data.Aeson (Array, Value (..)) | ||
| 8 | import Data.Foldable.WithIndex (FoldableWithIndex (..)) | ||
| 9 | import Data.JLD.Flattening.Global (JLDFlatteningT) | ||
| 10 | import Data.JLD.Model.Keyword (Keyword (..)) | ||
| 11 | import Data.JLD.Model.NodeMap (PropertyMap, SubjectMap, propsToKeyMap) | ||
| 12 | import Data.Map qualified as M (insert, lookup, member, singleton, size) | ||
| 13 | import Data.Vector qualified as V | ||
| 14 | |||
| 15 | collectGraphsStep :: Text -> SubjectMap -> SubjectMap -> SubjectMap | ||
| 16 | collectGraphsStep 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 | |||
| 29 | collectNodesStep :: Array -> PropertyMap -> Array | ||
| 30 | collectNodesStep ar node | ||
| 31 | | M.size node == 1 && M.member (Just <| show KeywordId) node = ar | ||
| 32 | | otherwise = V.snoc ar (Object <| propsToKeyMap node) | ||
| 33 | |||
| 34 | flatten :: Monad m => Value -> JLDFlatteningT e m Value | ||
| 35 | flatten 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' | ||
