aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/Data/JLD/Flattening/NodeMap.hs31
-rw-r--r--test/Test/Flattening.hs4
2 files changed, 12 insertions, 23 deletions
diff --git a/src/Data/JLD/Flattening/NodeMap.hs b/src/Data/JLD/Flattening/NodeMap.hs
index 2e6b8e3..06af2d4 100644
--- a/src/Data/JLD/Flattening/NodeMap.hs
+++ b/src/Data/JLD/Flattening/NodeMap.hs
@@ -19,7 +19,6 @@ import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member,
19import Data.Foldable.WithIndex (FoldableWithIndex (..), iforM_) 19import Data.Foldable.WithIndex (FoldableWithIndex (..), iforM_)
20import Data.Map.Strict qualified as M (insert, lookup) 20import Data.Map.Strict qualified as M (insert, lookup)
21import Data.Vector qualified as V (singleton, snoc, uniq) 21import Data.Vector qualified as V (singleton, snoc, uniq)
22import Debug.Pretty.Simple (pTraceShowM)
23 22
24type BNMT e m = REST BNMEnv (Either (JLDError e) ()) BNMState m 23type BNMT e m = REST BNMEnv (Either (JLDError e) ()) BNMState m
25 24
@@ -127,22 +126,14 @@ buildNodeMap' element = case element of
127 | KM.member (show KeywordValue) elementObject' -> 126 | KM.member (show KeywordValue) elementObject' ->
128 gets bnmStateList >>= \case 127 gets bnmStateList >>= \case
129 -- 4.1. 128 -- 4.1.
130 Nothing -> 129 Nothing -> bnmModifyNodeMap \nodeMap -> case N.lookup3 bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty nodeMap of
131 gets (bnmStateNodeMap .> N.lookup3 bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty) >>= \case 130 -- 4.1.1.
132 -- 4.1.1. 131 Just (Array activePropertyValue)
133 Just (Array activePropertyValue) 132 | element `notElem` activePropertyValue ->
134 | notElem element activePropertyValue -> 133 N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Array <| V.snoc activePropertyValue element) nodeMap
135 bnmModifyNodeMap 134 | otherwise -> nodeMap
136 <. N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty 135 -- 4.2.2
137 <. Array 136 _ -> N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Array <| V.singleton element) nodeMap
138 <| V.snoc activePropertyValue element
139 | otherwise -> pure ()
140 -- 4.2.2
141 _ ->
142 bnmModifyNodeMap
143 <. N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty
144 <. Array
145 <| V.singleton element
146 -- 4.2. 137 -- 4.2.
147 Just list -> bnmModifyList <. const <. Just <| V.snoc list element 138 Just list -> bnmModifyList <. const <. Just <| V.snoc list element
148 -- 5. 139 -- 5.
@@ -241,15 +232,13 @@ buildNodeMap' element = case element of
241 232
242 -- 6.10. 233 -- 6.10.
243 case KM.lookup (show KeywordGraph) elementObject' of 234 case KM.lookup (show KeywordGraph) elementObject' of
244 Just graphValue -> 235 Just graphValue -> void <| bnmBuildNodeMap graphValue \params -> params{bnmParamsActiveGraph = id'}
245 void <| bnmBuildNodeMap graphValue \params -> params{bnmParamsActiveGraph = id'}
246 -- 236 --
247 _ -> pure () 237 _ -> pure ()
248 238
249 -- 6.11. 239 -- 6.11.
250 case KM.lookup (show KeywordIncluded) elementObject' of 240 case KM.lookup (show KeywordIncluded) elementObject' of
251 Just includedValue -> 241 Just includedValue -> void <| bnmBuildNodeMap includedValue id
252 void <| bnmBuildNodeMap includedValue id
253 -- 242 --
254 _ -> pure () 243 _ -> pure ()
255 244
diff --git a/test/Test/Flattening.hs b/test/Test/Flattening.hs
index 76f5434..d452eee 100644
--- a/test/Test/Flattening.hs
+++ b/test/Test/Flattening.hs
@@ -55,8 +55,8 @@ flatteningTest W3CTest{..} (show .> (<> ". " <> toString w3cTestName) -> testNam
55 inputJld <- fetchTest inputUrl 55 inputJld <- fetchTest inputUrl
56 expectJld <- fetchTest expectUrl 56 expectJld <- fetchTest expectUrl
57 57
58 (expandBaseUrl, params) <- parseFlatteningOptions baseUrl inputUrl w3cTestOption 58 (flatteningBaseUrl, params) <- parseFlatteningOptions baseUrl inputUrl w3cTestOption
59 (result, _) <- flatten inputJld expandBaseUrl params 59 (result, _) <- flatten inputJld flatteningBaseUrl params
60 60
61 result @?= Right expectJld 61 result @?= Right expectJld
62 -- 62 --