aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD/Expansion.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/JLD/Expansion.hs')
-rw-r--r--src/Data/JLD/Expansion.hs942
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 @@
1module Data.JLD.Expansion (JLDEParams (..), expand) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Control.Monad.RES (REST, withEnvRES, withStateRES)
6import Data.JLD.Context (BACParams (..), EIParams (..), buildActiveContext, expandIri)
7import Data.JLD.Model.ActiveContext (ActiveContext (..), lookupTerm)
8import Data.JLD.Model.Direction (Direction (..))
9import Data.JLD.Error (JLDError (..))
10import Data.JLD.Model.GraphObject (isNotGraphObject, toGraphObject)
11import Data.JLD.Model.Keyword (Keyword (..), isKeyword, isNotKeyword, parseKeyword)
12import Data.JLD.Model.Language (Language (..))
13import Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject)
14import Data.JLD.Monad (JLDEEnv (..), JLDEState (..), JLDET, JLDEnv (..), JLDT, modifyActiveContext)
15import Data.JLD.Model.NodeObject (isNotNodeObject)
16import Data.JLD.Options (JLDVersion (..))
17import Data.JLD.Model.TermDefinition (TermDefinition (..))
18import Data.JLD.Model.ValueObject (isNotValueObject', isValueObject, isValueObject')
19import 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
35import Control.Monad.Except (MonadError (..))
36import Data.Aeson (Array, Key, KeyValue (..), Object, Value (..), object)
37import Data.Aeson.Key qualified as K (fromText, toText)
38import Data.Aeson.KeyMap qualified as KM (delete, fromList, insert, keys, lookup, member, null, singleton, size, toList)
39import Data.Foldable.WithIndex (ifoldlM, iforM_)
40import Data.RDF (parseIRI)
41import Data.Set qualified as S (insert, member)
42import Data.Text qualified as T (elem, toLower)
43import Data.Vector qualified as V (catMaybes, concat, cons, filter, fromList, mapMaybeM, maximum, modify, null, singleton, snoc, toList)
44import Data.Vector.Algorithms.Merge qualified as V
45import Text.URI (URI)
46
47type EO1314T e m = REST (JLDEEnv e m) (JLDError e) EO1314State m
48
49data EO1314State = EO1314State
50 { eo1314StateJlde :: JLDEState
51 , eo1314StateNest :: Set Key
52 , eo1314StateResult :: Object
53 , eo1314StateTypeContext :: ActiveContext
54 }
55 deriving (Show, Eq)
56
57eo1314ModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> EO1314T e m ()
58eo1314ModifyActiveContext = modifyActiveContext .> withStateRES eo1314StateJlde (\s g -> s{eo1314StateJlde = g})
59
60eo1314ModifyTypeContext :: Monad m => (ActiveContext -> ActiveContext) -> EO1314T e m ()
61eo1314ModifyTypeContext fn = modify \st -> st{eo1314StateTypeContext = fn (eo1314StateTypeContext st)}
62
63eo1314ModifyNest :: Monad m => (Set Key -> Set Key) -> EO1314T e m ()
64eo1314ModifyNest fn = modify \s -> s{eo1314StateNest = fn (eo1314StateNest s)}
65
66eo1314ModifyResult :: Monad m => (Object -> Object) -> EO1314T e m ()
67eo1314ModifyResult fn = modify \s -> s{eo1314StateResult = fn (eo1314StateResult s)}
68
69eo1314BuildActiveContext :: Monad m => ActiveContext -> Value -> Maybe URI -> (BACParams -> BACParams) -> EO1314T e m ActiveContext
70eo1314BuildActiveContext 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
77eo1314ExpandAC :: Monad m => Maybe Text -> Value -> (JLDEParams -> JLDEParams) -> EO1314T e m Value
78eo1314ExpandAC 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
89eo1314ExpandTC :: Monad m => Maybe Text -> Value -> (JLDEParams -> JLDEParams) -> EO1314T e m Value
90eo1314ExpandTC 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
101eo1314Expand' :: Monad m => ActiveContext -> Maybe Text -> Value -> (JLDEParams -> JLDEParams) -> EO1314T e m Value
102eo1314Expand' 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
112eo1314ExpandIriAC :: Monad m => Text -> (EIParams -> EIParams) -> EO1314T e m (Maybe Text)
113eo1314ExpandIriAC 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
124eo1314ExpandIriTC :: Monad m => Text -> (EIParams -> EIParams) -> EO1314T e m (Maybe Text)
125eo1314ExpandIriTC 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
136eo1314ExpandValue :: Monad m => Text -> Value -> EO1314T e m Object
137eo1314ExpandValue activeProperty value = do
138 expandValue activeProperty value
139 |> withStateRES eo1314StateJlde (\eo1314 jld -> eo1314{eo1314StateJlde = jld})
140
141eo1314ExpandKeywordItem :: Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m ()
142eo1314ExpandKeywordItem 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
348eo1314ExpandNonKeywordItem :: Monad m => Key -> Text -> Value -> EO1314T e m ()
349eo1314ExpandNonKeywordItem 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
544eo1314ExpandItem :: Monad m => Maybe Text -> Key -> Value -> EO1314T e m ()
545eo1314ExpandItem _ ((== K.fromText (show KeywordContext)) -> True) _ = pure () -- 13.1.
546eo1314ExpandItem 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
563eo1314Recurse :: Monad m => Text -> Maybe Text -> Object -> EO1314T e m ()
564eo1314Recurse 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
578expandObject1314' :: Monad m => Maybe Text -> Object -> EO1314T e m ()
579expandObject1314' 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
599eoExpandObject1314 :: Monad m => ActiveContext -> Maybe Text -> Object -> JLDET e m Object
600eoExpandObject1314 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
615eoNormalizeObject :: Monad m => Object -> JLDET e m Value
616eoNormalizeObject 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
639expandObject :: Monad m => Maybe Value -> Object -> JLDET e m Value
640expandObject 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
751expandArrayItem :: Monad m => Value -> JLDET e m Array
752expandArrayItem 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
776expandValue :: Monad m => Text -> Value -> JLDET e m Object
777expandValue 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
818data JLDEParams = JLDEParams
819 { jldeParamsFrameExpansion :: Bool
820 , jldeParamsFromMap :: Bool
821 , jldeParamsBaseUrl :: URI
822 , jldeParamsActiveProperty :: Maybe Text
823 }
824 deriving (Show, Eq)
825
826exModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> JLDET e m ()
827exModifyActiveContext fn = modify \st -> st{jldeStateActiveContext = fn (jldeStateActiveContext st)}
828
829evExpandIri :: Monad m => Text -> (EIParams -> EIParams) -> JLDET e m (Maybe Text)
830evExpandIri 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
840exExpandIri :: Monad m => Text -> JLDET e m (Maybe Text)
841exExpandIri 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
852exBuildActiveContext :: Monad m => Maybe URI -> Value -> (BACParams -> BACParams) -> JLDET e m ()
853exBuildActiveContext 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
862exExpand :: Monad m => Value -> (JLDEParams -> JLDEParams) -> JLDET e m Value
863exExpand 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
871expand' :: Monad m => Value -> JLDET e m Value
872expand' = \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
914expand :: Monad m => ActiveContext -> Value -> URI -> (JLDEParams -> JLDEParams) -> JLDT e m Value
915expand 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 }
generated by cgit v1.2.3-70-g09d2 (git 2.52.0) at 2025-12-21 04:15:20 +0000