diff options
Diffstat (limited to 'src/Data/JLD/Expansion.hs')
-rw-r--r-- | src/Data/JLD/Expansion.hs | 942 |
1 files changed, 942 insertions, 0 deletions
diff --git a/src/Data/JLD/Expansion.hs b/src/Data/JLD/Expansion.hs new file mode 100644 index 0000000..18d7fc6 --- /dev/null +++ b/src/Data/JLD/Expansion.hs | |||
@@ -0,0 +1,942 @@ | |||
1 | module Data.JLD.Expansion (JLDEParams (..), expand) where | ||
2 | |||
3 | import Data.JLD.Prelude | ||
4 | |||
5 | import Data.JLD.Control.Monad.RES (REST, withEnvRES, withStateRES) | ||
6 | import Data.JLD.Context (BACParams (..), EIParams (..), buildActiveContext, expandIri) | ||
7 | import Data.JLD.Model.ActiveContext (ActiveContext (..), lookupTerm) | ||
8 | import Data.JLD.Model.Direction (Direction (..)) | ||
9 | import Data.JLD.Error (JLDError (..)) | ||
10 | import Data.JLD.Model.GraphObject (isNotGraphObject, toGraphObject) | ||
11 | import Data.JLD.Model.Keyword (Keyword (..), isKeyword, isNotKeyword, parseKeyword) | ||
12 | import Data.JLD.Model.Language (Language (..)) | ||
13 | import Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) | ||
14 | import Data.JLD.Monad (JLDEEnv (..), JLDEState (..), JLDET, JLDEnv (..), JLDT, modifyActiveContext) | ||
15 | import Data.JLD.Model.NodeObject (isNotNodeObject) | ||
16 | import Data.JLD.Options (JLDVersion (..)) | ||
17 | import Data.JLD.Model.TermDefinition (TermDefinition (..)) | ||
18 | import Data.JLD.Model.ValueObject (isNotValueObject', isValueObject, isValueObject') | ||
19 | import Data.JLD.Util ( | ||
20 | allStrings, | ||
21 | getMapDefault, | ||
22 | ifindM, | ||
23 | mapAddValue, | ||
24 | valueContains, | ||
25 | valueIsEmptyArray, | ||
26 | valueIsNotArray, | ||
27 | valueIsNotNull, | ||
28 | valueIsNotString, | ||
29 | valueIsScalar, | ||
30 | valueIsString, | ||
31 | valueToArray, | ||
32 | valueToString, | ||
33 | ) | ||
34 | |||
35 | import Control.Monad.Except (MonadError (..)) | ||
36 | import Data.Aeson (Array, Key, KeyValue (..), Object, Value (..), object) | ||
37 | import Data.Aeson.Key qualified as K (fromText, toText) | ||
38 | import Data.Aeson.KeyMap qualified as KM (delete, fromList, insert, keys, lookup, member, null, singleton, size, toList) | ||
39 | import Data.Foldable.WithIndex (ifoldlM, iforM_) | ||
40 | import Data.RDF (parseIRI) | ||
41 | import Data.Set qualified as S (insert, member) | ||
42 | import Data.Text qualified as T (elem, toLower) | ||
43 | import Data.Vector qualified as V (catMaybes, concat, cons, filter, fromList, mapMaybeM, maximum, modify, null, singleton, snoc, toList) | ||
44 | import Data.Vector.Algorithms.Merge qualified as V | ||
45 | import Text.URI (URI) | ||
46 | |||
47 | type EO1314T e m = REST (JLDEEnv e m) (JLDError e) EO1314State m | ||
48 | |||
49 | data EO1314State = EO1314State | ||
50 | { eo1314StateJlde :: JLDEState | ||
51 | , eo1314StateNest :: Set Key | ||
52 | , eo1314StateResult :: Object | ||
53 | , eo1314StateTypeContext :: ActiveContext | ||
54 | } | ||
55 | deriving (Show, Eq) | ||
56 | |||
57 | eo1314ModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> EO1314T e m () | ||
58 | eo1314ModifyActiveContext = modifyActiveContext .> withStateRES eo1314StateJlde (\s g -> s{eo1314StateJlde = g}) | ||
59 | |||
60 | eo1314ModifyTypeContext :: Monad m => (ActiveContext -> ActiveContext) -> EO1314T e m () | ||
61 | eo1314ModifyTypeContext fn = modify \st -> st{eo1314StateTypeContext = fn (eo1314StateTypeContext st)} | ||
62 | |||
63 | eo1314ModifyNest :: Monad m => (Set Key -> Set Key) -> EO1314T e m () | ||
64 | eo1314ModifyNest fn = modify \s -> s{eo1314StateNest = fn (eo1314StateNest s)} | ||
65 | |||
66 | eo1314ModifyResult :: Monad m => (Object -> Object) -> EO1314T e m () | ||
67 | eo1314ModifyResult fn = modify \s -> s{eo1314StateResult = fn (eo1314StateResult s)} | ||
68 | |||
69 | eo1314BuildActiveContext :: Monad m => ActiveContext -> Value -> Maybe URI -> (BACParams -> BACParams) -> EO1314T e m ActiveContext | ||
70 | eo1314BuildActiveContext activeContext context baseUrl paramsFn = do | ||
71 | buildActiveContext activeContext context baseUrl paramsFn | ||
72 | |> withEnvRES jldeEnvGlobal | ||
73 | |> withStateRES | ||
74 | (eo1314StateJlde .> jldeStateGlobal) | ||
75 | (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) | ||
76 | |||
77 | eo1314ExpandAC :: Monad m => Maybe Text -> Value -> (JLDEParams -> JLDEParams) -> EO1314T e m Value | ||
78 | eo1314ExpandAC activeProperty value fn = do | ||
79 | activeContext <- gets <| jldeStateActiveContext <. eo1314StateJlde | ||
80 | baseUrl <- asks jldeEnvBaseUrl | ||
81 | frameExpansion <- asks jldeEnvFrameExpansion | ||
82 | let params p = fn p{jldeParamsFrameExpansion = frameExpansion, jldeParamsActiveProperty = activeProperty} | ||
83 | expand activeContext value baseUrl params | ||
84 | |> withEnvRES jldeEnvGlobal | ||
85 | |> withStateRES | ||
86 | (eo1314StateJlde .> jldeStateGlobal) | ||
87 | (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) | ||
88 | |||
89 | eo1314ExpandTC :: Monad m => Maybe Text -> Value -> (JLDEParams -> JLDEParams) -> EO1314T e m Value | ||
90 | eo1314ExpandTC activeProperty value fn = do | ||
91 | typeContext <- gets <| eo1314StateTypeContext | ||
92 | baseUrl <- asks jldeEnvBaseUrl | ||
93 | frameExpansion <- asks jldeEnvFrameExpansion | ||
94 | let params p = fn p{jldeParamsFrameExpansion = frameExpansion, jldeParamsActiveProperty = activeProperty} | ||
95 | expand typeContext value baseUrl params | ||
96 | |> withEnvRES jldeEnvGlobal | ||
97 | |> withStateRES | ||
98 | (eo1314StateJlde .> jldeStateGlobal) | ||
99 | (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) | ||
100 | |||
101 | eo1314Expand' :: Monad m => ActiveContext -> Maybe Text -> Value -> (JLDEParams -> JLDEParams) -> EO1314T e m Value | ||
102 | eo1314Expand' activeContext activeProperty value fn = do | ||
103 | baseUrl <- asks <| jldeEnvBaseUrl | ||
104 | frameExpansion <- asks <| jldeEnvFrameExpansion | ||
105 | let params p = fn p{jldeParamsFrameExpansion = frameExpansion, jldeParamsActiveProperty = activeProperty} | ||
106 | expand activeContext value baseUrl params | ||
107 | |> withEnvRES jldeEnvGlobal | ||
108 | |> withStateRES | ||
109 | (eo1314StateJlde .> jldeStateGlobal) | ||
110 | (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) | ||
111 | |||
112 | eo1314ExpandIriAC :: Monad m => Text -> (EIParams -> EIParams) -> EO1314T e m (Maybe Text) | ||
113 | eo1314ExpandIriAC value fn = do | ||
114 | activeContext <- gets <| jldeStateActiveContext <. eo1314StateJlde | ||
115 | (value', activeContext', _) <- | ||
116 | expandIri activeContext value fn | ||
117 | |> withEnvRES jldeEnvGlobal | ||
118 | |> withStateRES | ||
119 | (eo1314StateJlde .> jldeStateGlobal) | ||
120 | (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) | ||
121 | eo1314ModifyActiveContext <| const activeContext' | ||
122 | pure value' | ||
123 | |||
124 | eo1314ExpandIriTC :: Monad m => Text -> (EIParams -> EIParams) -> EO1314T e m (Maybe Text) | ||
125 | eo1314ExpandIriTC value fn = do | ||
126 | typeContext <- gets <| eo1314StateTypeContext | ||
127 | (value', typeContext', _) <- | ||
128 | expandIri typeContext value fn | ||
129 | |> withEnvRES jldeEnvGlobal | ||
130 | |> withStateRES | ||
131 | (eo1314StateJlde .> jldeStateGlobal) | ||
132 | (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) | ||
133 | eo1314ModifyTypeContext <| const typeContext' | ||
134 | pure value' | ||
135 | |||
136 | eo1314ExpandValue :: Monad m => Text -> Value -> EO1314T e m Object | ||
137 | eo1314ExpandValue activeProperty value = do | ||
138 | expandValue activeProperty value | ||
139 | |> withStateRES eo1314StateJlde (\eo1314 jld -> eo1314{eo1314StateJlde = jld}) | ||
140 | |||
141 | eo1314ExpandKeywordItem :: Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m () | ||
142 | eo1314ExpandKeywordItem inputType key keyword value = do | ||
143 | JLDEEnv{..} <- ask | ||
144 | let JLDEnv{..} = jldeEnvGlobal | ||
145 | |||
146 | -- 13.4.1. | ||
147 | when (jldeEnvActiveProperty == Just (show KeywordReverse)) <| throwError InvalidReversePropertyMap | ||
148 | |||
149 | -- 13.4.2. | ||
150 | containsProp <- gets (eo1314StateResult .> KM.member (show keyword)) | ||
151 | when (containsProp && keyword /= KeywordIncluded && keyword /= KeywordType) <| throwError (CollidingKeywords (K.toText key) keyword) | ||
152 | |||
153 | maybeExpandedValue <- case keyword of | ||
154 | -- 13.4.3. | ||
155 | KeywordId -> case value of | ||
156 | String stringValue -> do | ||
157 | maybeExpandedStringValue <- eo1314ExpandIriAC stringValue \params -> | ||
158 | params | ||
159 | { eiParamsDocumentRelative = True | ||
160 | , eiParamsVocab = False | ||
161 | } | ||
162 | case maybeExpandedStringValue of | ||
163 | Just expandedStringValue | ||
164 | | jldeEnvFrameExpansion -> pure <. Just <. Array <. V.singleton <| String expandedStringValue | ||
165 | | otherwise -> pure <. Just <| String expandedStringValue | ||
166 | Nothing -> pure <| Just Null | ||
167 | -- | ||
168 | Object (KM.null -> True) | jldeEnvFrameExpansion -> do | ||
169 | pure <. Just <. Array <. V.singleton <| Object mempty | ||
170 | -- | ||
171 | Array (allStrings -> Just arrayValue) | jldeEnvFrameExpansion && not (V.null arrayValue) -> do | ||
172 | Just <. Array <. V.concat <. V.toList <$> forM arrayValue \item -> do | ||
173 | V.singleton <. maybe Null String <$> eo1314ExpandIriAC item \params -> | ||
174 | params | ||
175 | { eiParamsDocumentRelative = True | ||
176 | , eiParamsVocab = False | ||
177 | } | ||
178 | -- | ||
179 | _ -> throwError <| InvalidKeywordValue keyword value | ||
180 | -- 13.4.4. | ||
181 | KeywordType -> do | ||
182 | expandedValue <- case value of | ||
183 | -- 13.4.4.4. | ||
184 | String stringValue -> do | ||
185 | maybe Null String <$> eo1314ExpandIriTC stringValue \params -> | ||
186 | params | ||
187 | { eiParamsDocumentRelative = True | ||
188 | , eiParamsVocab = True | ||
189 | } | ||
190 | -- 13.4.4.2. 13.4.4.3. | ||
191 | Object objectValue | ||
192 | -- 13.4.4.2. | ||
193 | | jldeEnvFrameExpansion && KM.null objectValue -> | ||
194 | pure value | ||
195 | -- 13.4.4.3. | ||
196 | | jldeEnvFrameExpansion | ||
197 | , Just (String defaultValue) <- KM.lookup (show KeywordDefault) objectValue | ||
198 | , Right _ <- parseIRI defaultValue -> do | ||
199 | Object <. KM.singleton (show KeywordDefault) <. maybe Null String <$> eo1314ExpandIriTC defaultValue \params -> | ||
200 | params | ||
201 | { eiParamsDocumentRelative = True | ||
202 | , eiParamsVocab = True | ||
203 | } | ||
204 | -- 13.4.4.4. | ||
205 | Array (allStrings -> Just arrayValue) -> | ||
206 | Array <. V.concat <. V.toList <$> forM arrayValue \item -> do | ||
207 | V.singleton <. maybe Null String <$> eo1314ExpandIriTC item \params -> | ||
208 | params | ||
209 | { eiParamsDocumentRelative = True | ||
210 | , eiParamsVocab = True | ||
211 | } | ||
212 | -- 13.4.4.1. | ||
213 | _ -> throwError <| InvalidKeywordValue keyword value | ||
214 | |||
215 | -- 13.4.4.5. | ||
216 | gets <| eo1314StateResult .> KM.lookup (show KeywordType) .> \case | ||
217 | Just (Array typeValue) -> Just <. Array <| V.snoc typeValue expandedValue | ||
218 | Just typeValue -> Just <. Array <| V.fromList [typeValue, expandedValue] | ||
219 | Nothing -> Just expandedValue | ||
220 | -- 13.4.5. | ||
221 | KeywordGraph -> Just <. Array <. valueToArray <$> eo1314ExpandTC (Just <| show KeywordGraph) value id | ||
222 | -- 13.4.6. | ||
223 | KeywordIncluded | ||
224 | -- 13.4.6.1. | ||
225 | | JLD1_0 <- jldEnvProcessingMode -> pure Nothing | ||
226 | -- 13.4.6.2. | ||
227 | | otherwise -> do | ||
228 | expandedValue <- valueToArray <$> eo1314ExpandAC Nothing value id | ||
229 | |||
230 | when (V.null expandedValue) <| throwError (InvalidKeywordValue keyword value) | ||
231 | |||
232 | -- 13.4.6.3. | ||
233 | when (any isNotNodeObject expandedValue) <| throwError (InvalidKeywordValue keyword value) | ||
234 | |||
235 | -- 13.4.6.4. | ||
236 | gets <| eo1314StateResult .> KM.lookup (show KeywordIncluded) .> \case | ||
237 | Just (Array includedValue) -> Just <. Array <| includedValue <> expandedValue | ||
238 | Just includedValue -> Just <. Array <| V.singleton includedValue <> expandedValue | ||
239 | Nothing -> Just <| Array expandedValue | ||
240 | -- 13.4.7. | ||
241 | KeywordValue -> do | ||
242 | expandedValue <- case value of | ||
243 | -- 13.4.7.1. | ||
244 | _ | inputType == Just (show KeywordJson) -> do | ||
245 | if jldEnvProcessingMode == JLD1_0 | ||
246 | then throwError InvalidValueObjectValue | ||
247 | else pure value | ||
248 | -- 13.4.7.2. | ||
249 | _ | value == Null || valueIsScalar value -> do | ||
250 | if jldeEnvFrameExpansion | ||
251 | then pure <. Array <| V.singleton value | ||
252 | else pure value | ||
253 | Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <. Array <| V.singleton value | ||
254 | Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure value | ||
255 | -- | ||
256 | _ -> throwError InvalidValueObjectValue | ||
257 | |||
258 | -- 13.4.7.4. | ||
259 | case expandedValue of | ||
260 | Null -> Nothing <$ eo1314ModifyResult (KM.insert (show KeywordValue) Null) | ||
261 | _ -> pure <| Just expandedValue | ||
262 | -- 13.4.8. | ||
263 | KeywordLanguage -> case value of | ||
264 | String stringValue | ||
265 | | jldeEnvFrameExpansion -> pure <. Just <. Array <. V.singleton <. String <| T.toLower stringValue | ||
266 | | otherwise -> pure <. Just <. String <| T.toLower stringValue | ||
267 | Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value | ||
268 | Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value | ||
269 | _ -> throwError InvalidLanguageTaggedString | ||
270 | -- 13.4.9. | ||
271 | KeywordDirection | ||
272 | | JLD1_0 <- jldEnvProcessingMode -> pure Nothing | ||
273 | | otherwise -> case value of | ||
274 | String ((`elem` ["ltr", "rtl"]) -> True) | ||
275 | | jldeEnvFrameExpansion -> pure <. Just <. Array <| V.singleton value | ||
276 | | otherwise -> pure <| Just value | ||
277 | Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value | ||
278 | Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value | ||
279 | _ -> throwError InvalidBaseDirection | ||
280 | -- 13.4.10. | ||
281 | KeywordIndex | ||
282 | | String _ <- value -> pure <| Just value | ||
283 | | otherwise -> throwError <| InvalidKeywordValue keyword value | ||
284 | -- 13.4.11. | ||
285 | KeywordList | ||
286 | -- 13.4.11.1. | ||
287 | | maybe True (== show KeywordGraph) jldeEnvActiveProperty -> pure Nothing | ||
288 | -- 13.4.11.2. | ||
289 | | otherwise -> do | ||
290 | expandedValue <- eo1314ExpandAC jldeEnvActiveProperty value id | ||
291 | case expandedValue of | ||
292 | Array _ -> pure <| Just expandedValue | ||
293 | _ -> pure <. Just <. Array <| V.singleton expandedValue | ||
294 | -- 13.4.12. | ||
295 | KeywordSet -> Just <$> eo1314ExpandAC jldeEnvActiveProperty value id | ||
296 | -- 13.4.13. | ||
297 | KeywordReverse | ||
298 | -- 13.4.13.2. | ||
299 | | Object _ <- value -> | ||
300 | eo1314ExpandAC (Just <| show KeywordReverse) value id >>= \case | ||
301 | Object expandedObjectValue -> do | ||
302 | -- 13.4.13.3. | ||
303 | case KM.lookup (show KeywordReverse) expandedObjectValue of | ||
304 | Just (Object rev) -> iforM_ rev \key' item -> eo1314ModifyResult <| mapAddValue key' item True | ||
305 | _ -> pure () | ||
306 | |||
307 | -- 13.4.13.4. | ||
308 | unless (KM.size expandedObjectValue == 1 && KM.member (show KeywordReverse) expandedObjectValue) do | ||
309 | reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult | ||
310 | reverseMap' <- | ||
311 | (\fn -> ifoldlM fn reverseMap expandedObjectValue) <| \key' rm -> \case | ||
312 | Array item | key' /= show KeywordReverse -> do | ||
313 | (\fn -> foldlM fn rm item) <| \rm' i -> | ||
314 | if isListObject i || isValueObject i | ||
315 | then throwError <| InvalidReversePropertyValue | ||
316 | else pure <| mapAddValue key' i True rm' | ||
317 | _ -> pure rm | ||
318 | |||
319 | if KM.null reverseMap' | ||
320 | then eo1314ModifyResult <| KM.delete (show KeywordReverse) | ||
321 | else eo1314ModifyResult <| KM.insert (show KeywordReverse) (Object reverseMap') | ||
322 | |||
323 | -- 13.4.13.5. | ||
324 | pure Nothing | ||
325 | -- | ||
326 | _ -> pure <| Just Null | ||
327 | -- 13.4.13.1. | ||
328 | | otherwise -> throwError <| InvalidKeywordValue keyword value | ||
329 | -- 13.4.14. | ||
330 | KeywordNest -> Nothing <$ eo1314ModifyNest (S.insert key) | ||
331 | -- | ||
332 | _ -> pure Nothing | ||
333 | |||
334 | case maybeExpandedValue of | ||
335 | Just expandedValue -> do | ||
336 | -- 13.4.15. | ||
337 | expandedValue' <- | ||
338 | if jldeEnvFrameExpansion && keyword `elem` [KeywordDefault, KeywordEmbed, KeywordExplicit, KeywordOmitDefault, KeywordRequireAll] | ||
339 | then eo1314ExpandAC (Just <| show keyword) expandedValue id | ||
340 | else pure expandedValue | ||
341 | |||
342 | -- 13.4.16. | ||
343 | unless (expandedValue' == Null && keyword == KeywordValue && inputType /= Just (show KeywordJson)) | ||
344 | <| eo1314ModifyResult (KM.insert (show keyword) expandedValue') | ||
345 | -- | ||
346 | Nothing -> pure () | ||
347 | |||
348 | eo1314ExpandNonKeywordItem :: Monad m => Key -> Text -> Value -> EO1314T e m () | ||
349 | eo1314ExpandNonKeywordItem key expandedProperty value = do | ||
350 | -- 13.5. | ||
351 | keyTermDefinition <- gets <| lookupTerm (K.toText key) <. jldeStateActiveContext <. eo1314StateJlde | ||
352 | defaultBaseDirection <- gets <| activeContextDefaultBaseDirection <. jldeStateActiveContext <. eo1314StateJlde | ||
353 | |||
354 | let containerMapping = maybe mempty termDefinitionContainerMapping keyTermDefinition | ||
355 | -- 13.7.2. | ||
356 | direction = (keyTermDefinition >>= termDefinitionDirectionMapping) <|> defaultBaseDirection | ||
357 | -- 13.8.2. | ||
358 | indexKey = fromMaybe (show KeywordIndex) (keyTermDefinition >>= termDefinitionIndexMapping) | ||
359 | |||
360 | expandedValue <- case value of | ||
361 | -- 13.6. | ||
362 | _ | (keyTermDefinition >>= termDefinitionTypeMapping) == Just (show KeywordJson) -> do | ||
363 | pure | ||
364 | <| object | ||
365 | [ show KeywordValue .= value | ||
366 | , show KeywordType .= String (show KeywordJson) | ||
367 | ] | ||
368 | -- 13.7. | ||
369 | Object objectValue | ||
370 | | S.member (show KeywordLanguage) containerMapping -> | ||
371 | -- 13.7.4. | ||
372 | Array <. V.concat <$> forM (KM.toList objectValue) \(langCode, langValue) -> | ||
373 | -- 13.7.4.1. 13.7.4.2. | ||
374 | flip V.mapMaybeM (valueToArray langValue) \case | ||
375 | -- 13.7.4.2.1. | ||
376 | Null -> pure Nothing | ||
377 | -- | ||
378 | String item -> do | ||
379 | -- 13.7.4.2.3. | ||
380 | let langMap = KM.singleton (show KeywordValue) (String item) | ||
381 | |||
382 | -- 13.7.4.2.4. | ||
383 | langMap' <- | ||
384 | if langCode /= show KeywordNone | ||
385 | then do | ||
386 | expandedLangCode <- maybe Null String <$> eo1314ExpandIriAC (K.toText langCode) \params -> params{eiParamsVocab = True} | ||
387 | if expandedLangCode /= show KeywordNone | ||
388 | then pure <| KM.insert (show KeywordLanguage) (String <. T.toLower <| K.toText langCode) langMap | ||
389 | else pure langMap | ||
390 | else pure langMap | ||
391 | |||
392 | -- 13.7.4.2.5. | ||
393 | let langMap'' = case direction of | ||
394 | Nothing -> langMap' | ||
395 | Just NoDirection -> langMap' | ||
396 | Just dir -> KM.insert (show KeywordDirection) (String <| show dir) langMap' | ||
397 | |||
398 | -- 13.7.4.2.6. | ||
399 | pure <. Just <| Object langMap'' | ||
400 | -- 13.7.4.2.2. | ||
401 | _ -> throwError <| InvalidLanguageMapValue | ||
402 | -- 13.8. | ||
403 | | S.member (show KeywordIndex) containerMapping | ||
404 | || S.member (show KeywordType) containerMapping | ||
405 | || S.member (show KeywordId) containerMapping -> | ||
406 | Array <. fmap Object <. V.concat <$> forM (KM.toList objectValue) \(index, indexValue) -> do | ||
407 | -- 13.8.3.1. | ||
408 | mapContext <- gets <| jldeStateActiveContext <. eo1314StateJlde | ||
409 | |||
410 | let mapContext' = case activeContextPreviousContext mapContext of | ||
411 | Just previousContext | ||
412 | | S.member (show KeywordId) containerMapping || S.member (show KeywordType) containerMapping -> | ||
413 | previousContext | ||
414 | _ -> mapContext | ||
415 | |||
416 | mapContext'' <- case lookupTerm (K.toText index) mapContext' of | ||
417 | -- 13.8.3.2. | ||
418 | Just termDefinition | ||
419 | | Just localContext <- termDefinitionLocalContext termDefinition | ||
420 | , S.member (show KeywordType) containerMapping -> | ||
421 | eo1314BuildActiveContext mapContext' localContext (termDefinitionBaseUrl termDefinition) id | ||
422 | -- 13.8.3.3. | ||
423 | _ -> pure mapContext' | ||
424 | |||
425 | -- 13.8.3.4. | ||
426 | expandedIndex <- | ||
427 | maybe Null String <$> eo1314ExpandIriAC (K.toText index) \params -> | ||
428 | params | ||
429 | { eiParamsVocab = True | ||
430 | } | ||
431 | |||
432 | -- 13.8.3.6. | ||
433 | indexValue' <- | ||
434 | eo1314Expand' mapContext'' (Just <| K.toText key) (Array <| valueToArray indexValue) \params -> | ||
435 | params | ||
436 | { jldeParamsFromMap = True | ||
437 | } | ||
438 | |||
439 | -- 13.8.3.7. | ||
440 | -- 13.8.3.7.1. | ||
441 | let ensureGraphObject item = | ||
442 | if S.member (show KeywordGraph) containerMapping && isNotGraphObject item | ||
443 | then Object <| toGraphObject item | ||
444 | else item | ||
445 | |||
446 | forM (valueToArray indexValue') <| ensureGraphObject .> \case | ||
447 | Object item | ||
448 | -- 13.8.3.7.2. | ||
449 | | S.member (show KeywordIndex) containerMapping | ||
450 | , indexKey /= show KeywordIndex | ||
451 | , expandedIndex /= show KeywordNone -> do | ||
452 | -- 13.8.3.7.2.1. | ||
453 | reExpandedIndex <- eo1314ExpandValue indexKey (String <| K.toText index) | ||
454 | |||
455 | -- 13.8.3.7.2.2. | ||
456 | expandedIndexKey <- | ||
457 | fmap K.fromText <$> eo1314ExpandIriAC indexKey \params -> | ||
458 | params | ||
459 | { eiParamsVocab = True | ||
460 | } | ||
461 | |||
462 | -- 13.8.3.7.2.3. | ||
463 | let maybeExistingValues = expandedIndexKey >>= (`KM.lookup` item) | ||
464 | |||
465 | indexPropertyValues = | ||
466 | V.singleton (Object reExpandedIndex) | ||
467 | |> case maybeExistingValues of | ||
468 | Just (Array existingValues) -> (<> existingValues) | ||
469 | Just existingValue -> (`V.snoc` existingValue) | ||
470 | Nothing -> id | ||
471 | |||
472 | -- 13.8.3.7.2.4. | ||
473 | let item' = case expandedIndexKey of | ||
474 | Just eiKey -> item |> KM.insert eiKey (Array indexPropertyValues) | ||
475 | Nothing -> item | ||
476 | |||
477 | -- 13.8.3.7.2.5. | ||
478 | when (isValueObject' item' && KM.size item' > 1) <| throwError InvalidValueObject | ||
479 | |||
480 | pure item' | ||
481 | -- 13.8.3.7.3. | ||
482 | | S.member (show KeywordIndex) containerMapping | ||
483 | , not (KM.member (show KeywordIndex) item) | ||
484 | , expandedIndex /= show KeywordNone -> | ||
485 | pure <. KM.insert (show KeywordIndex) (String <| K.toText index) <| item | ||
486 | -- 13.8.3.7.4. | ||
487 | | S.member (show KeywordId) containerMapping | ||
488 | , not (KM.member (show KeywordId) item) | ||
489 | , expandedIndex /= show KeywordNone -> do | ||
490 | expandedIndex' <- eo1314ExpandIriAC (K.toText index) \params -> | ||
491 | params | ||
492 | { eiParamsVocab = False | ||
493 | , eiParamsDocumentRelative = True | ||
494 | } | ||
495 | pure <| KM.insert (show KeywordId) (maybe Null String expandedIndex') item | ||
496 | -- 13.8.3.7.5. | ||
497 | | S.member (show KeywordType) containerMapping | ||
498 | , expandedIndex /= show KeywordNone -> do | ||
499 | let types = case KM.lookup (show KeywordType) item of | ||
500 | Just existingType -> V.cons expandedIndex <| valueToArray existingType | ||
501 | Nothing -> V.singleton expandedIndex | ||
502 | pure <. KM.insert (show KeywordType) (Array types) <| item | ||
503 | -- 13.8.3.7.6. | ||
504 | | otherwise -> pure item | ||
505 | -- | ||
506 | _ -> pure mempty | ||
507 | -- 13.9. | ||
508 | _ -> eo1314ExpandAC (Just <| K.toText key) value id | ||
509 | |||
510 | -- 13.10. | ||
511 | when (expandedValue /= Null) do | ||
512 | -- 13.11. | ||
513 | let expandedValue' = | ||
514 | if S.member (show KeywordList) containerMapping && isNotListObject expandedValue | ||
515 | then toListObject expandedValue | ||
516 | else expandedValue | ||
517 | |||
518 | -- 13.12. | ||
519 | let expandedValue'' = | ||
520 | if S.member (show KeywordGraph) containerMapping | ||
521 | && not (S.member (show KeywordId) containerMapping) | ||
522 | && not (S.member (show KeywordIndex) containerMapping) | ||
523 | then Array <| Object <. toGraphObject <$> valueToArray expandedValue' | ||
524 | else expandedValue' | ||
525 | |||
526 | -- 13.13. | ||
527 | if maybe False termDefinitionReversePropertyFlag keyTermDefinition | ||
528 | then do | ||
529 | reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult | ||
530 | |||
531 | -- 13.13.3. 13.13.4. | ||
532 | reverseMap' <- | ||
533 | (\fn -> foldlM fn reverseMap (valueToArray expandedValue'')) <| \rm item -> | ||
534 | if isListObject item || isValueObject item | ||
535 | then -- 13.13.4.1. | ||
536 | throwError InvalidReversePropertyValue | ||
537 | else -- 13.13.4.3. | ||
538 | pure <| mapAddValue (K.fromText expandedProperty) item True rm | ||
539 | |||
540 | eo1314ModifyResult <| KM.insert (show KeywordReverse) (Object reverseMap') | ||
541 | else -- 13.14. | ||
542 | eo1314ModifyResult <| mapAddValue (K.fromText expandedProperty) expandedValue'' True | ||
543 | |||
544 | eo1314ExpandItem :: Monad m => Maybe Text -> Key -> Value -> EO1314T e m () | ||
545 | eo1314ExpandItem _ ((== K.fromText (show KeywordContext)) -> True) _ = pure () -- 13.1. | ||
546 | eo1314ExpandItem inputType key value = do | ||
547 | -- 13.2. 13.3. | ||
548 | maybeExpandedProperty <- eo1314ExpandIriAC (K.toText key) \params -> | ||
549 | params | ||
550 | { eiParamsDocumentRelative = False | ||
551 | , eiParamsVocab = True | ||
552 | } | ||
553 | |||
554 | case maybeExpandedProperty of | ||
555 | Just expandedProperty | ||
556 | -- 13.4. | ||
557 | | Just keyword <- parseKeyword expandedProperty -> eo1314ExpandKeywordItem inputType key keyword value | ||
558 | -- 13.5. | ||
559 | | ':' `T.elem` expandedProperty -> eo1314ExpandNonKeywordItem key expandedProperty value | ||
560 | -- | ||
561 | _ -> pure () | ||
562 | |||
563 | eo1314Recurse :: Monad m => Text -> Maybe Text -> Object -> EO1314T e m () | ||
564 | eo1314Recurse activeProperty inputType value = do | ||
565 | -- 3. 8. | ||
566 | activeContext <- gets <| jldeStateActiveContext <. eo1314StateJlde | ||
567 | case lookupTerm activeProperty activeContext of | ||
568 | Just propertyDefinition | Just propertyContext <- termDefinitionLocalContext propertyDefinition -> do | ||
569 | activeContext' <- eo1314BuildActiveContext activeContext propertyContext (termDefinitionBaseUrl propertyDefinition) \params -> | ||
570 | params | ||
571 | { bacParamsOverrideProtected = True | ||
572 | } | ||
573 | eo1314ModifyActiveContext <| const activeContext' | ||
574 | _ -> pure () | ||
575 | |||
576 | expandObject1314' inputType value | ||
577 | |||
578 | expandObject1314' :: Monad m => Maybe Text -> Object -> EO1314T e m () | ||
579 | expandObject1314' inputType value = do | ||
580 | -- 13. | ||
581 | iforM_ value <| eo1314ExpandItem inputType | ||
582 | |||
583 | -- 14. | ||
584 | gets eo1314StateNest >>= mapM_ \nestedKey -> | ||
585 | KM.lookup nestedKey value |> fmap valueToArray .> fromMaybe mempty .> mapM_ \case | ||
586 | Object nestValue -> do | ||
587 | forM_ (KM.keys nestValue) \nestedValueKey -> do | ||
588 | -- 14.2.1. | ||
589 | expandedNestedValueKey <- eo1314ExpandIriTC (K.toText nestedValueKey) \params -> params{eiParamsVocab = True} | ||
590 | when (expandedNestedValueKey == Just (show KeywordValue)) <| throwError (InvalidKeywordValue KeywordNest (Object nestValue)) | ||
591 | -- 14.2.2. | ||
592 | eo1314ModifyNest <| const mempty | ||
593 | eo1314Recurse (K.toText nestedKey) inputType nestValue | ||
594 | -- 14.2.1. | ||
595 | invalid -> throwError <| InvalidKeywordValue KeywordNest invalid | ||
596 | |||
597 | -- | ||
598 | |||
599 | eoExpandObject1314 :: Monad m => ActiveContext -> Maybe Text -> Object -> JLDET e m Object | ||
600 | eoExpandObject1314 typeContext inputType value = do | ||
601 | EO1314State{..} <- | ||
602 | (expandObject1314' inputType value >> get) | ||
603 | |> withStateRES | ||
604 | ( \jld -> | ||
605 | EO1314State | ||
606 | { eo1314StateJlde = jld | ||
607 | , eo1314StateNest = mempty | ||
608 | , eo1314StateResult = mempty | ||
609 | , eo1314StateTypeContext = typeContext | ||
610 | } | ||
611 | ) | ||
612 | (const eo1314StateJlde) | ||
613 | pure eo1314StateResult | ||
614 | |||
615 | eoNormalizeObject :: Monad m => Object -> JLDET e m Value | ||
616 | eoNormalizeObject result | ||
617 | -- 18. | ||
618 | | KM.size result == 1 && KM.member (show KeywordLanguage) result = pure Null | ||
619 | -- | ||
620 | | otherwise = do | ||
621 | JLDEEnv{..} <- ask | ||
622 | |||
623 | if | ||
624 | -- 19.1. | ||
625 | | maybe True (== show KeywordGraph) jldeEnvActiveProperty | ||
626 | , not jldeEnvFrameExpansion | ||
627 | , KM.null result || KM.member (show KeywordValue) result || KM.member (show KeywordList) result -> | ||
628 | pure Null | ||
629 | -- 19.2. | ||
630 | | maybe True (== show KeywordGraph) jldeEnvActiveProperty | ||
631 | , not jldeEnvFrameExpansion | ||
632 | , KM.size result == 1 | ||
633 | , KM.member (show KeywordId) result -> | ||
634 | pure Null | ||
635 | -- | ||
636 | | otherwise -> | ||
637 | pure <| Object result | ||
638 | |||
639 | expandObject :: Monad m => Maybe Value -> Object -> JLDET e m Value | ||
640 | expandObject maybePropertyContext value = do | ||
641 | JLDEEnv{..} <- ask | ||
642 | |||
643 | -- 7. | ||
644 | gets (jldeStateActiveContext .> activeContextPreviousContext) >>= \case | ||
645 | Just previousContext | not jldeEnvFromMap -> do | ||
646 | noRevert <- flip anyM (KM.keys value) \k -> do | ||
647 | expanded <- exExpandIri <| K.toText k | ||
648 | pure <| expanded == Just (show KeywordValue) || (expanded == Just (show KeywordId) && KM.size value == 1) | ||
649 | unless noRevert <| exModifyActiveContext (const previousContext) | ||
650 | -- | ||
651 | _ -> pure () | ||
652 | |||
653 | -- 8. | ||
654 | case (jldeEnvActiveProperty, maybePropertyContext) of | ||
655 | (Just activeProperty, Just propertyContext) -> do | ||
656 | baseUrl' <- gets (jldeStateActiveContext .> lookupTerm activeProperty >=> termDefinitionBaseUrl) | ||
657 | exBuildActiveContext baseUrl' propertyContext \params -> params{bacParamsOverrideProtected = True} | ||
658 | -- | ||
659 | _ -> pure () | ||
660 | |||
661 | -- 9. | ||
662 | case KM.lookup (show KeywordContext) value of | ||
663 | Just context -> exBuildActiveContext (Just jldeEnvBaseUrl) context id | ||
664 | -- | ||
665 | _ -> pure () | ||
666 | |||
667 | -- 10. | ||
668 | typeContext <- gets jldeStateActiveContext | ||
669 | |||
670 | -- 11. | ||
671 | inputType <- do | ||
672 | maybeType <- | ||
673 | value |> ifindM \key item -> do | ||
674 | -- 11.2. | ||
675 | isType <- (Just (show KeywordType) ==) <$> exExpandIri (K.toText key) | ||
676 | |||
677 | when isType do | ||
678 | valueToArray item |> fmap valueToString .> V.catMaybes .> V.modify V.sort .> mapM_ \term -> | ||
679 | case lookupTerm term typeContext >>= termDefinitionLocalContext of | ||
680 | Just localContext -> do | ||
681 | valueBaseUrl <- gets <| termDefinitionBaseUrl <=< lookupTerm term <. jldeStateActiveContext | ||
682 | exBuildActiveContext valueBaseUrl localContext \params -> | ||
683 | params | ||
684 | { bacParamsPropagate = False | ||
685 | } | ||
686 | _ -> pure () | ||
687 | |||
688 | pure isType | ||
689 | |||
690 | case maybeType of | ||
691 | Just (Array type') | not (V.null type') -> exExpandIri <. V.maximum <. V.catMaybes <| valueToString <$> type' | ||
692 | Just (String type') -> exExpandIri type' | ||
693 | -- | ||
694 | _ -> pure Nothing | ||
695 | |||
696 | -- 13. 14. | ||
697 | result <- eoExpandObject1314 typeContext inputType value | ||
698 | |||
699 | if | ||
700 | -- 15. | ||
701 | | Just resultValue <- KM.lookup (show KeywordValue) result -> do | ||
702 | -- 15.1. | ||
703 | when (isNotValueObject' result) <| throwError InvalidValueObject | ||
704 | when | ||
705 | ( KM.member (show KeywordType) result | ||
706 | && (KM.member (show KeywordDirection) result || KM.member (show KeywordLanguage) result) | ||
707 | ) | ||
708 | <| throwError InvalidValueObject | ||
709 | |||
710 | case KM.lookup (show KeywordType) result of | ||
711 | -- 15.2. | ||
712 | Just type' | valueContains (show KeywordJson) type' -> do | ||
713 | eoNormalizeObject result | ||
714 | _ | ||
715 | -- 15.3. | ||
716 | | resultValue == Null || valueIsEmptyArray resultValue -> | ||
717 | pure Null | ||
718 | -- 15.4. | ||
719 | | not jldeEnvFrameExpansion | ||
720 | , valueIsNotString resultValue | ||
721 | , KM.member (show KeywordLanguage) result -> | ||
722 | throwError InvalidLanguageTaggedValue | ||
723 | -- 15.5. | ||
724 | Just (String (parseIRI -> Left _)) | not jldeEnvFrameExpansion -> do | ||
725 | throwError InvalidTypedValue | ||
726 | Just (valueIsNotString -> True) | not jldeEnvFrameExpansion -> do | ||
727 | throwError InvalidTypedValue | ||
728 | -- | ||
729 | _ -> eoNormalizeObject result | ||
730 | -- 16. | ||
731 | | Just resultType <- KM.lookup (show KeywordType) result -> | ||
732 | eoNormalizeObject | ||
733 | <| if valueIsNotArray resultType && valueIsNotNull resultType | ||
734 | then KM.insert (show KeywordType) (Array <| V.singleton resultType) result | ||
735 | else result | ||
736 | -- 17. | ||
737 | | KM.member (show KeywordList) result || KM.member (show KeywordSet) result -> do | ||
738 | -- 17.1. | ||
739 | when (KM.size result > 2 || (KM.size result == 2 && not (KM.member (show KeywordIndex) result))) | ||
740 | <| throwError InvalidSetOrListObject | ||
741 | -- 17.2. | ||
742 | if | ||
743 | | Just (Object set) <- KM.lookup (show KeywordSet) result -> eoNormalizeObject set | ||
744 | | Just set <- KM.lookup (show KeywordSet) result -> pure set | ||
745 | | otherwise -> eoNormalizeObject result | ||
746 | -- | ||
747 | | otherwise -> eoNormalizeObject result | ||
748 | |||
749 | -- | ||
750 | |||
751 | expandArrayItem :: Monad m => Value -> JLDET e m Array | ||
752 | expandArrayItem item = do | ||
753 | JLDEEnv{..} <- ask | ||
754 | |||
755 | -- 5.2.1. | ||
756 | item' <- exExpand item id | ||
757 | |||
758 | -- 5.2.2. | ||
759 | activeContext <- gets jldeStateActiveContext | ||
760 | let item'' = case item' of | ||
761 | Array a | ||
762 | | Just activeProperty <- jldeEnvActiveProperty | ||
763 | , Just term <- lookupTerm activeProperty activeContext | ||
764 | , S.member (show KeywordList) (termDefinitionContainerMapping term) -> | ||
765 | toListObject <| Array a | ||
766 | _ -> item' | ||
767 | |||
768 | case item'' of | ||
769 | -- 5.2.3. | ||
770 | Array a -> pure <| V.filter valueIsNotNull a | ||
771 | Null -> pure mempty | ||
772 | _ -> pure <| V.singleton item'' | ||
773 | |||
774 | -- | ||
775 | |||
776 | expandValue :: Monad m => Text -> Value -> JLDET e m Object | ||
777 | expandValue activeProperty value = do | ||
778 | definition <- gets <| lookupTerm activeProperty <. jldeStateActiveContext | ||
779 | |||
780 | case definition >>= termDefinitionTypeMapping of | ||
781 | -- 1. 2. | ||
782 | Just typeMapping | ||
783 | | String stringValue <- value | ||
784 | , typeMapping `isKeyword` [KeywordId, KeywordVocab] -> | ||
785 | KM.singleton (show KeywordId) <. maybe Null String <$> evExpandIri stringValue \params -> | ||
786 | params | ||
787 | { eiParamsDocumentRelative = True | ||
788 | , eiParamsVocab = typeMapping == show KeywordVocab | ||
789 | } | ||
790 | -- 3. 4. | ||
791 | | typeMapping `isNotKeyword` [KeywordId, KeywordVocab, KeywordNone] -> | ||
792 | pure <| KM.fromList [(show KeywordType, String typeMapping), (show KeywordValue, value)] | ||
793 | -- 5. | ||
794 | _ | String _ <- value -> do | ||
795 | defaultLanguage <- gets <| activeContextDefaultLanguage <. jldeStateActiveContext | ||
796 | defaultDirection <- gets <| activeContextDefaultBaseDirection <. jldeStateActiveContext | ||
797 | |||
798 | -- 5.1. 5.2. 5.3. 5.4. | ||
799 | KM.singleton (show KeywordValue) value | ||
800 | |> case definition >>= termDefinitionLanguageMapping of | ||
801 | Nothing | ||
802 | | Just (Language def) <- defaultLanguage -> KM.insert (show KeywordLanguage) (String def) | ||
803 | | otherwise -> id | ||
804 | Just NoLanguage -> id | ||
805 | Just (Language lang) -> KM.insert (show KeywordLanguage) (String lang) | ||
806 | |> case definition >>= termDefinitionDirectionMapping of | ||
807 | Nothing | ||
808 | | Just def <- defaultDirection -> KM.insert (show KeywordDirection) (show def) | ||
809 | | otherwise -> id | ||
810 | Just NoDirection -> id | ||
811 | Just dir -> KM.insert (show KeywordDirection) (show dir) | ||
812 | |> pure | ||
813 | -- 6. | ||
814 | _ -> pure <| KM.singleton (show KeywordValue) value | ||
815 | |||
816 | -- | ||
817 | |||
818 | data JLDEParams = JLDEParams | ||
819 | { jldeParamsFrameExpansion :: Bool | ||
820 | , jldeParamsFromMap :: Bool | ||
821 | , jldeParamsBaseUrl :: URI | ||
822 | , jldeParamsActiveProperty :: Maybe Text | ||
823 | } | ||
824 | deriving (Show, Eq) | ||
825 | |||
826 | exModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> JLDET e m () | ||
827 | exModifyActiveContext fn = modify \st -> st{jldeStateActiveContext = fn (jldeStateActiveContext st)} | ||
828 | |||
829 | evExpandIri :: Monad m => Text -> (EIParams -> EIParams) -> JLDET e m (Maybe Text) | ||
830 | evExpandIri value fn = do | ||
831 | JLDEEnv{..} <- ask | ||
832 | activeContext <- gets jldeStateActiveContext | ||
833 | (value', activeContext', _) <- | ||
834 | expandIri activeContext value fn | ||
835 | |> withEnvRES (const jldeEnvGlobal) | ||
836 | |> withStateRES jldeStateGlobal (\s jlde -> s{jldeStateGlobal = jlde}) | ||
837 | exModifyActiveContext <| const activeContext' | ||
838 | pure value' | ||
839 | |||
840 | exExpandIri :: Monad m => Text -> JLDET e m (Maybe Text) | ||
841 | exExpandIri value = do | ||
842 | JLDEEnv{..} <- ask | ||
843 | activeContext <- gets jldeStateActiveContext | ||
844 | let params p = p{eiParamsVocab = True} | ||
845 | (value', activeContext', _) <- | ||
846 | expandIri activeContext value params | ||
847 | |> withEnvRES (const jldeEnvGlobal) | ||
848 | |> withStateRES jldeStateGlobal (\s jlde -> s{jldeStateGlobal = jlde}) | ||
849 | exModifyActiveContext <| const activeContext' | ||
850 | pure value' | ||
851 | |||
852 | exBuildActiveContext :: Monad m => Maybe URI -> Value -> (BACParams -> BACParams) -> JLDET e m () | ||
853 | exBuildActiveContext baseUrl localContext fn = do | ||
854 | JLDEEnv{..} <- ask | ||
855 | activeContext <- gets jldeStateActiveContext | ||
856 | activeContext' <- | ||
857 | buildActiveContext activeContext localContext baseUrl fn | ||
858 | |> withEnvRES (const jldeEnvGlobal) | ||
859 | |> withStateRES jldeStateGlobal (\s jlde -> s{jldeStateGlobal = jlde}) | ||
860 | exModifyActiveContext (const activeContext') | ||
861 | |||
862 | exExpand :: Monad m => Value -> (JLDEParams -> JLDEParams) -> JLDET e m Value | ||
863 | exExpand value fn = do | ||
864 | JLDEEnv{..} <- ask | ||
865 | activeContext <- gets jldeStateActiveContext | ||
866 | let params p = fn p{jldeParamsActiveProperty = jldeEnvActiveProperty} | ||
867 | expand activeContext value jldeEnvBaseUrl params | ||
868 | |> withEnvRES (const jldeEnvGlobal) | ||
869 | |> withStateRES jldeStateGlobal (\s jlde -> s{jldeStateGlobal = jlde}) | ||
870 | |||
871 | expand' :: Monad m => Value -> JLDET e m Value | ||
872 | expand' = \case | ||
873 | -- 1. | ||
874 | Null -> pure Null | ||
875 | -- 5. | ||
876 | Array value -> Array <. V.concat <. V.toList <$> forM value expandArrayItem | ||
877 | -- 6. | ||
878 | Object value -> do | ||
879 | JLDEEnv{..} <- ask | ||
880 | |||
881 | -- 3. | ||
882 | maybePropertyContext <- case jldeEnvActiveProperty of | ||
883 | Just activeProperty -> gets (jldeStateActiveContext .> lookupTerm activeProperty >=> termDefinitionLocalContext) | ||
884 | Nothing -> pure Nothing | ||
885 | |||
886 | -- 6. | ||
887 | expandObject maybePropertyContext value | ||
888 | |> withEnvRES \env -> | ||
889 | env{jldeEnvFrameExpansion = jldeEnvFrameExpansion && maybePropertyContext /= Just (show KeywordDefault)} | ||
890 | |||
891 | -- 4. | ||
892 | value -> do | ||
893 | JLDEEnv{..} <- ask | ||
894 | |||
895 | maybePropertyTerm <- case jldeEnvActiveProperty of | ||
896 | Just activeProperty -> gets <| lookupTerm activeProperty <. jldeStateActiveContext | ||
897 | Nothing -> pure Nothing | ||
898 | |||
899 | case jldeEnvActiveProperty of | ||
900 | -- 4.1. | ||
901 | Nothing -> pure Null | ||
902 | -- | ||
903 | Just activeProperty | ||
904 | -- 4.1. | ||
905 | | activeProperty == show KeywordGraph -> pure Null | ||
906 | -- 4.2. | ||
907 | | Just propertyTerm <- maybePropertyTerm | ||
908 | , Just propertyContext <- termDefinitionLocalContext propertyTerm -> do | ||
909 | exBuildActiveContext (termDefinitionBaseUrl propertyTerm) propertyContext id | ||
910 | Object <$> expandValue activeProperty value | ||
911 | -- 4.3. | ||
912 | | otherwise -> Object <$> expandValue activeProperty value | ||
913 | |||
914 | expand :: Monad m => ActiveContext -> Value -> URI -> (JLDEParams -> JLDEParams) -> JLDT e m Value | ||
915 | expand activeContext value baseUrl paramsFn = | ||
916 | expand' value | ||
917 | |> withEnvRES env | ||
918 | |> withStateRES st (const jldeStateGlobal) | ||
919 | where | ||
920 | JLDEParams{..} = | ||
921 | paramsFn | ||
922 | JLDEParams | ||
923 | { jldeParamsFrameExpansion = False | ||
924 | , jldeParamsFromMap = False | ||
925 | , jldeParamsBaseUrl = baseUrl | ||
926 | , jldeParamsActiveProperty = Nothing | ||
927 | } | ||
928 | |||
929 | env global = | ||
930 | JLDEEnv | ||
931 | { jldeEnvGlobal = global | ||
932 | , jldeEnvFrameExpansion = jldeParamsFrameExpansion | ||
933 | , jldeEnvFromMap = jldeParamsFromMap | ||
934 | , jldeEnvBaseUrl = jldeParamsBaseUrl | ||
935 | , jldeEnvActiveProperty = jldeParamsActiveProperty | ||
936 | } | ||
937 | |||
938 | st global = | ||
939 | JLDEState | ||
940 | { jldeStateGlobal = global | ||
941 | , jldeStateActiveContext = activeContext | ||
942 | } | ||