aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorVolpeon <github@volpeon.ink>2023-06-24 11:14:19 +0200
committerVolpeon <github@volpeon.ink>2023-06-24 11:14:19 +0200
commit77447e837f7461a337eec09845ad4b24dea1cce4 (patch)
treea12f839d9233e26043b5a0329c10f15b546b5f7a /src
parentWIP: IRI compaction (diff)
downloadhs-jsonld-77447e837f7461a337eec09845ad4b24dea1cce4.tar.gz
hs-jsonld-77447e837f7461a337eec09845ad4b24dea1cce4.tar.bz2
hs-jsonld-77447e837f7461a337eec09845ad4b24dea1cce4.zip
Update
Diffstat (limited to 'src')
-rw-r--r--src/Data/JLD/Compaction/IRI.hs539
-rw-r--r--src/Data/JLD/Model/InverseContext.hs2
2 files changed, 283 insertions, 258 deletions
diff --git a/src/Data/JLD/Compaction/IRI.hs b/src/Data/JLD/Compaction/IRI.hs
index 208643f..414c7de 100644
--- a/src/Data/JLD/Compaction/IRI.hs
+++ b/src/Data/JLD/Compaction/IRI.hs
@@ -12,17 +12,18 @@ import Data.JLD.Model.InverseContext (InverseContext, selectTerm)
12import Control.Monad.Except (MonadError (..)) 12import Control.Monad.Except (MonadError (..))
13import Data.Aeson (Value (..)) 13import Data.Aeson (Value (..))
14import Data.Aeson.KeyMap qualified as KM (lookup, member, size) 14import Data.Aeson.KeyMap qualified as KM (lookup, member, size)
15import Data.Foldable.WithIndex (FoldableWithIndex (..))
15import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject') 16import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject')
16import Data.JLD.Model.Keyword (Keyword (..)) 17import Data.JLD.Model.Keyword (Keyword (..))
17import Data.JLD.Model.Language (Language (..)) 18import Data.JLD.Model.Language (Language (..))
18import Data.JLD.Model.ListObject (isListObject') 19import Data.JLD.Model.ListObject (isListObject')
19import Data.JLD.Model.TermDefinition (TermDefinition (termDefinitionIriMapping)) 20import Data.JLD.Model.TermDefinition (TermDefinition (termDefinitionIriMapping, termDefinitionPrefixFlag))
20import Data.JLD.Model.ValueObject (isValueObject') 21import Data.JLD.Model.ValueObject (isValueObject')
21import Data.JLD.Util (valueToArray) 22import Data.JLD.Util (valueToArray)
22import Data.Map qualified as M (lookup) 23import Data.Map qualified as M (lookup, member)
23import Data.Set qualified as S (insert) 24import Data.Set qualified as S (insert)
24import Data.Text (toLower) 25import Data.Text (toLower)
25import Data.Text qualified as T (drop, findIndex) 26import Data.Text qualified as T (drop, findIndex, isPrefixOf, length)
26import Data.Vector (Vector, (!?)) 27import Data.Vector (Vector, (!?))
27import Data.Vector qualified as V (cons) 28import Data.Vector qualified as V (cons)
28 29
@@ -85,272 +86,296 @@ compactIri' var = do
85 CIEnv{..} <- ask 86 CIEnv{..} <- ask
86 let ActiveContext{..} = ciEnvActiveContext 87 let ActiveContext{..} = ciEnvActiveContext
87 88
88 -- 4.1. 89 -- 4.
89 let defaultLanguage = case (activeContextDefaultLanguage, activeContextDefaultBaseDirection) of 90 when (M.member var ciEnvInverseContext) do
90 (Just (Language language), Just dir) -> language <> show dir 91 -- 4.1.
91 (Nothing, Just dir) -> "_" <> show dir 92 let defaultLanguage = case (activeContextDefaultLanguage, activeContextDefaultBaseDirection) of
92 _ -> show KeywordNone 93 (Just (Language language), Just dir) -> language <> show dir
93 94 (Nothing, Just dir) -> "_" <> show dir
94 -- 4.2. 95 _ -> show KeywordNone
95 value = case ciEnvValue of 96
96 Just v@(Object o) -> case KM.lookup (show KeywordPreserve) o of 97 -- 4.2.
97 Just Null -> Just v 98 value = case ciEnvValue of
98 Just preserve -> valueToArray preserve !? 0 99 Just v@(Object o) -> case KM.lookup (show KeywordPreserve) o of
99 _ -> Just v 100 Just Null -> Just v
100 _ -> Nothing 101 Just preserve -> valueToArray preserve !? 0
101 102 _ -> Just v
102 -- 4.5. 103 _ -> Nothing
103 case value of 104
104 Just (Object o) 105 -- 4.5.
105 | KM.member (show KeywordIndex) o && isNotGraphObject' o -> 106 case value of
106 ciModifyContainers 107 Just (Object o)
107 <| S.insert (show KeywordIndex) 108 | KM.member (show KeywordIndex) o && isNotGraphObject' o ->
108 .> S.insert (show KeywordIndex <> show KeywordSet)
109 _ -> pure ()
110
111 case value of
112 -- 4.6.
113 _ | ciEnvReverse -> do
114 ciPutTypeLanguage KeywordType
115 ciPutTypeLanguageValue <| show KeywordReverse
116 --
117 Just (Object o)
118 -- 4.7.
119 | isListObject' o
120 , Just (Array list) <- KM.lookup (show KeywordList) o -> do
121 -- 4.7.1.
122 unless (KM.member (show KeywordIndex) o) <| ciModifyContainers (S.insert (show KeywordList))
123
124 -- 4.7.4.
125 let go (commonType, commonLanguage) item
126 -- 4.7.4.8.
127 | commonLanguage == Just (show KeywordNone)
128 , commonType == Just (show KeywordNone) =
129 (commonType, commonLanguage)
130 --
131 | otherwise = (Just commonType', Just commonLanguage')
132 where
133 (itemLanguage, itemType) = case item of
134 Object objectItem
135 | KM.member (show KeywordValue) objectItem ->
136 if
137 -- 4.7.4.2.1.
138 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem
139 , Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
140 (toLower lang <> "_" <> toLower dir, show KeywordId)
141 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem ->
142 ("_" <> toLower dir, show KeywordId)
143 -- 4.7.4.2.2.
144 | Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
145 (toLower lang, show KeywordId)
146 -- 4.7.4.2.3.
147 | Just (String type') <- KM.lookup (show KeywordType) objectItem ->
148 (show KeywordNone, type')
149 -- 4.7.4.2.4.
150 | otherwise ->
151 (show KeywordNone, show KeywordId)
152 -- 4.7.4.2.4.
153 _ -> (show KeywordNone, show KeywordId)
154
155 commonLanguage' = case commonLanguage of
156 -- 4.7.4.4.
157 Nothing -> itemLanguage
158 -- 4.7.4.5.
159 Just lang
160 | itemLanguage /= lang
161 , Object itemObject <- item
162 , KM.member (show KeywordValue) itemObject ->
163 show KeywordNone
164 | otherwise -> lang
165
166 commonType' = case commonType of
167 Nothing -> itemType
168 Just it
169 | itemType /= it -> show KeywordNone
170 | otherwise -> it
171
172 -- 4.7.3. 4.7.5. 4.7.6.
173 (commonType'', commonLanguage'') =
174 list
175 |> foldl' go (Nothing, if null list then Just defaultLanguage else Nothing)
176 .> bimap (fromMaybe (show KeywordNone)) (fromMaybe (show KeywordNone))
177
178 -- 4.7.7.
179 if commonType'' /= show KeywordNone
180 then do
181 ciPutTypeLanguage KeywordType
182 ciPutTypeLanguageValue (show commonType'')
183 else -- 4.7.8.
184 ciPutTypeLanguageValue (show commonLanguage'')
185 -- 4.8.
186 | isGraphObject' o -> do
187 -- 4.8.1.
188 when (KM.member (show KeywordIndex) o) do
189 ciModifyContainers
190 <| S.insert (show KeywordGraph <> show KeywordIndex)
191 .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet)
192 -- 4.8.2.
193 when (KM.member (show KeywordId) o) do
194 ciModifyContainers 109 ciModifyContainers
195 <| S.insert (show KeywordGraph <> show KeywordId) 110 <| S.insert (show KeywordIndex)
196 .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet) 111 .> S.insert (show KeywordIndex <> show KeywordSet)
197 -- 4.8.3. 112 _ -> pure ()
198 ciModifyContainers 113
199 <| S.insert (show KeywordGraph) 114 case value of
200 .> S.insert (show KeywordGraph <> show KeywordSet) 115 -- 4.6.
201 .> S.insert (show KeywordSet) 116 _ | ciEnvReverse -> do
202 -- 4.8.4. 117 ciPutTypeLanguage KeywordType
203 unless (KM.member (show KeywordIndex) o) do 118 ciPutTypeLanguageValue <| show KeywordReverse
119 --
120 Just (Object o)
121 -- 4.7.
122 | isListObject' o
123 , Just (Array list) <- KM.lookup (show KeywordList) o -> do
124 -- 4.7.1.
125 unless (KM.member (show KeywordIndex) o) <| ciModifyContainers (S.insert (show KeywordList))
126
127 -- 4.7.4.
128 let go (commonType, commonLanguage) item
129 -- 4.7.4.8.
130 | commonLanguage == Just (show KeywordNone)
131 , commonType == Just (show KeywordNone) =
132 (commonType, commonLanguage)
133 --
134 | otherwise = (Just commonType', Just commonLanguage')
135 where
136 (itemLanguage, itemType) = case item of
137 Object objectItem
138 | KM.member (show KeywordValue) objectItem ->
139 if
140 -- 4.7.4.2.1.
141 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem
142 , Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
143 (toLower lang <> "_" <> toLower dir, show KeywordId)
144 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem ->
145 ("_" <> toLower dir, show KeywordId)
146 -- 4.7.4.2.2.
147 | Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
148 (toLower lang, show KeywordId)
149 -- 4.7.4.2.3.
150 | Just (String type') <- KM.lookup (show KeywordType) objectItem ->
151 (show KeywordNone, type')
152 -- 4.7.4.2.4.
153 | otherwise ->
154 (show KeywordNone, show KeywordId)
155 -- 4.7.4.2.4.
156 _ -> (show KeywordNone, show KeywordId)
157
158 commonLanguage' = case commonLanguage of
159 -- 4.7.4.4.
160 Nothing -> itemLanguage
161 -- 4.7.4.5.
162 Just lang
163 | itemLanguage /= lang
164 , Object itemObject <- item
165 , KM.member (show KeywordValue) itemObject ->
166 show KeywordNone
167 | otherwise -> lang
168
169 commonType' = case commonType of
170 Nothing -> itemType
171 Just it
172 | itemType /= it -> show KeywordNone
173 | otherwise -> it
174
175 -- 4.7.3. 4.7.5. 4.7.6.
176 (commonType'', commonLanguage'') =
177 list
178 |> foldl' go (Nothing, if null list then Just defaultLanguage else Nothing)
179 .> bimap (fromMaybe (show KeywordNone)) (fromMaybe (show KeywordNone))
180
181 -- 4.7.7.
182 if commonType'' /= show KeywordNone
183 then do
184 ciPutTypeLanguage KeywordType
185 ciPutTypeLanguageValue (show commonType'')
186 else -- 4.7.8.
187 ciPutTypeLanguageValue (show commonLanguage'')
188 -- 4.8.
189 | isGraphObject' o -> do
190 -- 4.8.1.
191 when (KM.member (show KeywordIndex) o) do
192 ciModifyContainers
193 <| S.insert (show KeywordGraph <> show KeywordIndex)
194 .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet)
195 -- 4.8.2.
196 when (KM.member (show KeywordId) o) do
197 ciModifyContainers
198 <| S.insert (show KeywordGraph <> show KeywordId)
199 .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet)
200 -- 4.8.3.
204 ciModifyContainers 201 ciModifyContainers
205 <| S.insert (show KeywordGraph <> show KeywordIndex) 202 <| S.insert (show KeywordGraph)
206 .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet) 203 .> S.insert (show KeywordGraph <> show KeywordSet)
207 -- 4.8.5. 204 .> S.insert (show KeywordSet)
208 unless (KM.member (show KeywordId) o) do 205 -- 4.8.4.
206 unless (KM.member (show KeywordIndex) o) do
207 ciModifyContainers
208 <| S.insert (show KeywordGraph <> show KeywordIndex)
209 .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet)
210 -- 4.8.5.
211 unless (KM.member (show KeywordId) o) do
212 ciModifyContainers
213 <| S.insert (show KeywordGraph <> show KeywordId)
214 .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet)
215 -- 4.8.6.
209 ciModifyContainers 216 ciModifyContainers
210 <| S.insert (show KeywordGraph <> show KeywordId) 217 <| S.insert (show KeywordIndex)
211 .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet) 218 .> S.insert (show KeywordIndex <> show KeywordSet)
212 -- 4.8.6. 219 -- 4.8.7.
213 ciModifyContainers 220 ciPutTypeLanguage KeywordType
214 <| S.insert (show KeywordIndex) 221 ciPutTypeLanguageValue (show KeywordId)
215 .> S.insert (show KeywordIndex <> show KeywordSet) 222 -- 4.9. 4.9.1.
216 -- 4.8.7. 223 | isValueObject' o -> do
224 if
225 -- 4.9.1.1.
226 | Just (String dir) <- KM.lookup (show KeywordDirection) o
227 , Just (String lang) <- KM.lookup (show KeywordLanguage) o
228 , not (KM.member (show KeywordIndex) o) -> do
229 ciPutTypeLanguageValue (toLower lang <> "_" <> toLower dir)
230 ciModifyContainers
231 <| S.insert (show KeywordLanguage)
232 .> S.insert (show KeywordLanguage <> show KeywordSet)
233 | Just (String dir) <- KM.lookup (show KeywordDirection) o
234 , not (KM.member (show KeywordIndex) o) -> do
235 ciPutTypeLanguageValue ("_" <> toLower dir)
236 ciModifyContainers
237 <| S.insert (show KeywordLanguage)
238 .> S.insert (show KeywordLanguage <> show KeywordSet)
239 -- 4.9.1.2.
240 | Just (String lang) <- KM.lookup (show KeywordLanguage) o
241 , not (KM.member (show KeywordIndex) o) -> do
242 ciPutTypeLanguageValue (toLower lang)
243 ciModifyContainers
244 <| S.insert (show KeywordLanguage)
245 .> S.insert (show KeywordLanguage <> show KeywordSet)
246 -- 4.9.1.3.
247 | Just (String type') <- KM.lookup (show KeywordType) o -> do
248 ciPutTypeLanguage KeywordType
249 ciPutTypeLanguageValue type'
250 --
251 | otherwise -> pure ()
252 -- 4.9.3.
253 ciModifyContainers <| S.insert (show KeywordSet)
254 -- 4.9.2.
255 _ -> do
217 ciPutTypeLanguage KeywordType 256 ciPutTypeLanguage KeywordType
218 ciPutTypeLanguageValue (show KeywordId) 257 ciPutTypeLanguageValue (show KeywordId)
219 -- 4.9. 4.9.1.
220 | isValueObject' o -> do
221 if
222 -- 4.9.1.1.
223 | Just (String dir) <- KM.lookup (show KeywordDirection) o
224 , Just (String lang) <- KM.lookup (show KeywordLanguage) o
225 , not (KM.member (show KeywordIndex) o) -> do
226 ciPutTypeLanguageValue (toLower lang <> "_" <> toLower dir)
227 ciModifyContainers
228 <| S.insert (show KeywordLanguage)
229 .> S.insert (show KeywordLanguage <> show KeywordSet)
230 | Just (String dir) <- KM.lookup (show KeywordDirection) o
231 , not (KM.member (show KeywordIndex) o) -> do
232 ciPutTypeLanguageValue ("_" <> toLower dir)
233 ciModifyContainers
234 <| S.insert (show KeywordLanguage)
235 .> S.insert (show KeywordLanguage <> show KeywordSet)
236 -- 4.9.1.2.
237 | Just (String lang) <- KM.lookup (show KeywordLanguage) o
238 , not (KM.member (show KeywordIndex) o) -> do
239 ciPutTypeLanguageValue (toLower lang)
240 ciModifyContainers
241 <| S.insert (show KeywordLanguage)
242 .> S.insert (show KeywordLanguage <> show KeywordSet)
243 -- 4.9.1.3.
244 | Just (String type') <- KM.lookup (show KeywordType) o -> do
245 ciPutTypeLanguage KeywordType
246 ciPutTypeLanguageValue type'
247 --
248 | otherwise -> pure ()
249 -- 4.9.3. 258 -- 4.9.3.
250 ciModifyContainers <| S.insert (show KeywordSet)
251 -- 4.9.2.
252 _ -> do
253 ciPutTypeLanguage KeywordType
254 ciPutTypeLanguageValue (show KeywordId)
255 -- 4.9.3.
256 ciModifyContainers
257 <| S.insert (show KeywordId)
258 .> S.insert (show KeywordId <> show KeywordSet)
259 .> S.insert (show KeywordType)
260 .> S.insert (show KeywordSet <> show KeywordType)
261 .> S.insert (show KeywordSet)
262
263 -- 4.10.
264 ciModifyContainers <| S.insert (show KeywordNone)
265
266 -- 4.11.
267 case value of
268 Just (Object o)
269 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
270 , not (KM.member (show KeywordIndex) o) ->
271 ciModifyContainers
272 <| S.insert (show KeywordIndex)
273 .> S.insert (show KeywordIndex <> show KeywordSet)
274 _
275 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0 ->
276 ciModifyContainers
277 <| S.insert (show KeywordIndex)
278 .> S.insert (show KeywordIndex <> show KeywordSet)
279 --
280 | otherwise -> pure ()
281
282 -- 4.12.
283 case value of
284 Just (Object o)
285 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
286 , KM.member (show KeywordIndex) o
287 , KM.size o == 1 ->
288 ciModifyContainers 259 ciModifyContainers
289 <| S.insert (show KeywordLanguage) 260 <| S.insert (show KeywordId)
290 .> S.insert (show KeywordLanguage <> show KeywordSet) 261 .> S.insert (show KeywordId <> show KeywordSet)
291 -- 262 .> S.insert (show KeywordType)
292 _ -> pure () 263 .> S.insert (show KeywordSet <> show KeywordType)
264 .> S.insert (show KeywordSet)
293 265
294 -- 4.15. 266 -- 4.10.
295 typeLanguageValue <- gets ciStateTypeLanguageValue 267 ciModifyContainers <| S.insert (show KeywordNone)
296 when (typeLanguageValue == show KeywordReverse) <| ciModifyPreferredValues (V.cons (show KeywordReverse)) 268
297 269 -- 4.11.
298 -- 4.16. 270 case value of
299 case value of 271 Just (Object o)
300 Just (Object o) 272 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
301 | typeLanguageValue == show KeywordReverse || typeLanguageValue == show KeywordId 273 , not (KM.member (show KeywordIndex) o) ->
302 , Just idValue <- KM.lookup (show KeywordId) o -> case idValue of 274 ciModifyContainers
303 -- 4.16.1. 275 <| S.insert (show KeywordIndex)
304 String idValue' -> do 276 .> S.insert (show KeywordIndex <> show KeywordSet)
305 compactedIdValue <- ciCompactIri idValue' 277 _
306 case M.lookup compactedIdValue activeContextTerms of 278 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0 ->
307 Just term 279 ciModifyContainers
308 | termDefinitionIriMapping term == Just idValue' -> 280 <| S.insert (show KeywordIndex)
309 ciModifyPreferredValues 281 .> S.insert (show KeywordIndex <> show KeywordSet)
310 <| V.cons (show KeywordVocab)
311 .> V.cons (show KeywordId)
312 -- 4.16.2.
313 _ ->
314 ciModifyPreferredValues
315 <| V.cons (show KeywordId)
316 .> V.cons (show KeywordVocab)
317 ciModifyPreferredValues <| V.cons (show KeywordNone)
318 -- 282 --
319 _ -> throwError <. Left <| InvalidKeywordValue KeywordId idValue 283 | otherwise -> pure ()
320 -- 4.17. 284
321 | Just (Array a) <- KM.lookup (show KeywordList) o 285 -- 4.12.
322 , null a -> do 286 case value of
287 Just (Object o)
288 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
289 , KM.member (show KeywordIndex) o
290 , KM.size o == 1 ->
291 ciModifyContainers
292 <| S.insert (show KeywordLanguage)
293 .> S.insert (show KeywordLanguage <> show KeywordSet)
294 --
295 _ -> pure ()
296
297 -- 4.15.
298 typeLanguageValue <- gets ciStateTypeLanguageValue
299 when (typeLanguageValue == show KeywordReverse) <| ciModifyPreferredValues (V.cons (show KeywordReverse))
300
301 -- 4.16.
302 case value of
303 Just (Object o)
304 | typeLanguageValue == show KeywordReverse || typeLanguageValue == show KeywordId
305 , Just idValue <- KM.lookup (show KeywordId) o -> case idValue of
306 -- 4.16.1.
307 String idValue' -> do
308 compactedIdValue <- ciCompactIri idValue'
309 case M.lookup compactedIdValue activeContextTerms of
310 Just term
311 | termDefinitionIriMapping term == Just idValue' ->
312 ciModifyPreferredValues
313 <| V.cons (show KeywordVocab)
314 .> V.cons (show KeywordId)
315 -- 4.16.2.
316 _ ->
317 ciModifyPreferredValues
318 <| V.cons (show KeywordId)
319 .> V.cons (show KeywordVocab)
320 ciModifyPreferredValues <| V.cons (show KeywordNone)
321 --
322 _ -> throwError <. Left <| InvalidKeywordValue KeywordId idValue
323 -- 4.17.
324 | Just (Array a) <- KM.lookup (show KeywordList) o
325 , null a -> do
326 ciModifyPreferredValues
327 <| V.cons typeLanguageValue
328 .> V.cons (show KeywordNone)
329 ciPutTypeLanguage KeywordAny
330 _ -> do
323 ciModifyPreferredValues 331 ciModifyPreferredValues
324 <| V.cons typeLanguageValue 332 <| V.cons typeLanguageValue
325 .> V.cons (show KeywordNone) 333 .> V.cons (show KeywordNone)
326 ciPutTypeLanguage KeywordAny 334
327 _ -> do 335 -- 4.18.
328 ciModifyPreferredValues 336 ciModifyPreferredValues <| V.cons (show KeywordAny)
329 <| V.cons typeLanguageValue 337
330 .> V.cons (show KeywordNone) 338 -- 4.19.
331 339 gets ciStatePreferredValues >>= mapM_ \preferredValue -> case T.findIndex (== ':') preferredValue of
332 -- 4.18. 340 Just idx -> ciModifyPreferredValues <| V.cons (T.drop idx preferredValue)
333 ciModifyPreferredValues <| V.cons (show KeywordAny) 341 Nothing -> pure ()
334 342
335 -- 4.19. 343 -- 4.20.
336 gets ciStatePreferredValues >>= mapM_ \preferredValue -> case T.findIndex (== ':') preferredValue of 344 maybeTerm <-
337 Just idx -> ciModifyPreferredValues <| V.cons (T.drop idx preferredValue) 345 liftA3
338 Nothing -> pure () 346 (\containers typeLanguage preferredValues -> selectTerm var containers typeLanguage preferredValues ciEnvInverseContext)
339 347 (gets ciStateContainers)
340 -- 4.20. 348 (gets ciStateTypeLanguage)
341 maybeTerm <- 349 (gets ciStatePreferredValues)
342 liftA3 350
343 (\containers typeLanguage preferredValues -> selectTerm var containers typeLanguage preferredValues ciEnvInverseContext) 351 -- 4.21.
344 (gets ciStateContainers) 352 case maybeTerm of
345 (gets ciStateTypeLanguage) 353 Just term -> throwError <| Right term
346 (gets ciStatePreferredValues) 354 Nothing -> pure ()
347 355
348 -- 4.21. 356 -- 5.
349 case maybeTerm of 357 case activeContextVocabularyMapping of
350 Just term -> throwError <| Right term 358 Just vocabMapping
351 Nothing -> pure () 359 | ciEnvVocab && T.isPrefixOf vocabMapping var && T.length var > T.length vocabMapping
352 360 , suffix <- T.drop (T.length vocabMapping) var
353 -- 361 , not (M.member suffix activeContextTerms) ->
362 throwError <| Right suffix
363 _ -> pure ()
364
365 -- 6.
366 let go key ci term = case termDefinitionIriMapping term of
367 Nothing -> ci
368 Just iriMapping
369 | var == iriMapping
370 || not (T.isPrefixOf iriMapping var)
371 || not (termDefinitionPrefixFlag term) ->
372 ci
373 --
374 | otherwise -> do
375
376 compactIri = ifoldl' go Nothing activeContextTerms
377
378 -- 11.
354 pure var 379 pure var
355 380
356compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext) 381compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext)
diff --git a/src/Data/JLD/Model/InverseContext.hs b/src/Data/JLD/Model/InverseContext.hs
index ee85ce9..95cdeb8 100644
--- a/src/Data/JLD/Model/InverseContext.hs
+++ b/src/Data/JLD/Model/InverseContext.hs
@@ -12,7 +12,7 @@ type InverseContext = Map Text (Map Text (Map Keyword (Map Text Text)))
12 12
13hasKey3 :: Text -> Text -> Keyword -> InverseContext -> Bool 13hasKey3 :: Text -> Text -> Keyword -> InverseContext -> Bool
14hasKey3 var container type' inverseContext = 14hasKey3 var container type' inverseContext =
15 M.lookup var inverseContext >>= M.lookup container >>= M.lookup type' |> isJust 15 M.lookup var inverseContext >>= M.lookup container |> maybe False (M.member type')
16 16
17lookup4 :: Text -> Text -> Keyword -> Text -> InverseContext -> Maybe Text 17lookup4 :: Text -> Text -> Keyword -> Text -> InverseContext -> Maybe Text
18lookup4 var container type' typeMapping inverseContext = 18lookup4 var container type' typeMapping inverseContext =
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-21 16:51:30 +0000