aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/JLD')
-rw-r--r--src/Data/JLD/Compaction/IRI.hs509
-rw-r--r--src/Data/JLD/Model/InverseContext.hs2
2 files changed, 268 insertions, 243 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
94 (Nothing, Just dir) -> "_" <> show dir
95 _ -> show KeywordNone
93 96
94 -- 4.2. 97 -- 4.2.
95 value = case ciEnvValue of 98 value = case ciEnvValue of
96 Just v@(Object o) -> case KM.lookup (show KeywordPreserve) o of 99 Just v@(Object o) -> case KM.lookup (show KeywordPreserve) o of
97 Just Null -> Just v 100 Just Null -> Just v
98 Just preserve -> valueToArray preserve !? 0 101 Just preserve -> valueToArray preserve !? 0
99 _ -> Just v 102 _ -> Just v
100 _ -> Nothing 103 _ -> Nothing
101 104
102 -- 4.5. 105 -- 4.5.
103 case value of 106 case value of
104 Just (Object o) 107 Just (Object o)
105 | KM.member (show KeywordIndex) o && isNotGraphObject' o -> 108 | KM.member (show KeywordIndex) o && isNotGraphObject' o ->
106 ciModifyContainers 109 ciModifyContainers
107 <| S.insert (show KeywordIndex) 110 <| S.insert (show KeywordIndex)
108 .> S.insert (show KeywordIndex <> show KeywordSet) 111 .> S.insert (show KeywordIndex <> show KeywordSet)
109 _ -> pure () 112 _ -> pure ()
110 113
111 case value of 114 case value of
112 -- 4.6. 115 -- 4.6.
113 _ | ciEnvReverse -> do 116 _ | ciEnvReverse -> do
114 ciPutTypeLanguage KeywordType 117 ciPutTypeLanguage KeywordType
115 ciPutTypeLanguageValue <| show KeywordReverse 118 ciPutTypeLanguageValue <| show KeywordReverse
116 -- 119 --
117 Just (Object o) 120 Just (Object o)
118 -- 4.7. 121 -- 4.7.
119 | isListObject' o 122 | isListObject' o
120 , Just (Array list) <- KM.lookup (show KeywordList) o -> do 123 , Just (Array list) <- KM.lookup (show KeywordList) o -> do
121 -- 4.7.1. 124 -- 4.7.1.
122 unless (KM.member (show KeywordIndex) o) <| ciModifyContainers (S.insert (show KeywordList)) 125 unless (KM.member (show KeywordIndex) o) <| ciModifyContainers (S.insert (show KeywordList))
123 126
124 -- 4.7.4. 127 -- 4.7.4.
125 let go (commonType, commonLanguage) item 128 let go (commonType, commonLanguage) item
126 -- 4.7.4.8. 129 -- 4.7.4.8.
127 | commonLanguage == Just (show KeywordNone) 130 | commonLanguage == Just (show KeywordNone)
128 , commonType == Just (show KeywordNone) = 131 , commonType == Just (show KeywordNone) =
129 (commonType, commonLanguage) 132 (commonType, commonLanguage)
130 -- 133 --
131 | otherwise = (Just commonType', Just commonLanguage') 134 | otherwise = (Just commonType', Just commonLanguage')
132 where 135 where
133 (itemLanguage, itemType) = case item of 136 (itemLanguage, itemType) = case item of
134 Object objectItem 137 Object objectItem
135 | KM.member (show KeywordValue) objectItem -> 138 | KM.member (show KeywordValue) objectItem ->
136 if 139 if
137 -- 4.7.4.2.1. 140 -- 4.7.4.2.1.
138 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem 141 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem
139 , Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem -> 142 , Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
140 (toLower lang <> "_" <> toLower dir, show KeywordId) 143 (toLower lang <> "_" <> toLower dir, show KeywordId)
141 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem -> 144 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem ->
142 ("_" <> toLower dir, show KeywordId) 145 ("_" <> toLower dir, show KeywordId)
143 -- 4.7.4.2.2. 146 -- 4.7.4.2.2.
144 | Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem -> 147 | Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
145 (toLower lang, show KeywordId) 148 (toLower lang, show KeywordId)
146 -- 4.7.4.2.3. 149 -- 4.7.4.2.3.
147 | Just (String type') <- KM.lookup (show KeywordType) objectItem -> 150 | Just (String type') <- KM.lookup (show KeywordType) objectItem ->
148 (show KeywordNone, type') 151 (show KeywordNone, type')
149 -- 4.7.4.2.4. 152 -- 4.7.4.2.4.
150 | otherwise -> 153 | otherwise ->
151 (show KeywordNone, show KeywordId) 154 (show KeywordNone, show KeywordId)
152 -- 4.7.4.2.4. 155 -- 4.7.4.2.4.
153 _ -> (show KeywordNone, show KeywordId) 156 _ -> (show KeywordNone, show KeywordId)
154 157
155 commonLanguage' = case commonLanguage of 158 commonLanguage' = case commonLanguage of
156 -- 4.7.4.4. 159 -- 4.7.4.4.
157 Nothing -> itemLanguage 160 Nothing -> itemLanguage
158 -- 4.7.4.5. 161 -- 4.7.4.5.
159 Just lang 162 Just lang
160 | itemLanguage /= lang 163 | itemLanguage /= lang
161 , Object itemObject <- item 164 , Object itemObject <- item
162 , KM.member (show KeywordValue) itemObject -> 165 , KM.member (show KeywordValue) itemObject ->
163 show KeywordNone 166 show KeywordNone
164 | otherwise -> lang 167 | otherwise -> lang
165 168
166 commonType' = case commonType of 169 commonType' = case commonType of
167 Nothing -> itemType 170 Nothing -> itemType
168 Just it 171 Just it
169 | itemType /= it -> show KeywordNone 172 | itemType /= it -> show KeywordNone
170 | otherwise -> it 173 | otherwise -> it
171 174
172 -- 4.7.3. 4.7.5. 4.7.6. 175 -- 4.7.3. 4.7.5. 4.7.6.
173 (commonType'', commonLanguage'') = 176 (commonType'', commonLanguage'') =
174 list 177 list
175 |> foldl' go (Nothing, if null list then Just defaultLanguage else Nothing) 178 |> foldl' go (Nothing, if null list then Just defaultLanguage else Nothing)
176 .> bimap (fromMaybe (show KeywordNone)) (fromMaybe (show KeywordNone)) 179 .> bimap (fromMaybe (show KeywordNone)) (fromMaybe (show KeywordNone))
177 180
178 -- 4.7.7. 181 -- 4.7.7.
179 if commonType'' /= show KeywordNone 182 if commonType'' /= show KeywordNone
180 then do 183 then do
181 ciPutTypeLanguage KeywordType 184 ciPutTypeLanguage KeywordType
182 ciPutTypeLanguageValue (show commonType'') 185 ciPutTypeLanguageValue (show commonType'')
183 else -- 4.7.8. 186 else -- 4.7.8.
184 ciPutTypeLanguageValue (show commonLanguage'') 187 ciPutTypeLanguageValue (show commonLanguage'')
185 -- 4.8. 188 -- 4.8.
186 | isGraphObject' o -> do 189 | isGraphObject' o -> do
187 -- 4.8.1. 190 -- 4.8.1.
188 when (KM.member (show KeywordIndex) o) do 191 when (KM.member (show KeywordIndex) o) do
189 ciModifyContainers 192 ciModifyContainers
190 <| S.insert (show KeywordGraph <> show KeywordIndex) 193 <| S.insert (show KeywordGraph <> show KeywordIndex)
191 .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet) 194 .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet)
192 -- 4.8.2. 195 -- 4.8.2.
193 when (KM.member (show KeywordId) o) do 196 when (KM.member (show KeywordId) o) do
194 ciModifyContainers 197 ciModifyContainers
195 <| S.insert (show KeywordGraph <> show KeywordId) 198 <| S.insert (show KeywordGraph <> show KeywordId)
196 .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet) 199 .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet)
197 -- 4.8.3. 200 -- 4.8.3.
198 ciModifyContainers
199 <| S.insert (show KeywordGraph)
200 .> S.insert (show KeywordGraph <> show KeywordSet)
201 .> S.insert (show KeywordSet)
202 -- 4.8.4.
203 unless (KM.member (show KeywordIndex) o) do
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) 259 ciModifyContainers
251 -- 4.9.2. 260 <| S.insert (show KeywordId)
252 _ -> do 261 .> S.insert (show KeywordId <> show KeywordSet)
253 ciPutTypeLanguage KeywordType 262 .> S.insert (show KeywordType)
254 ciPutTypeLanguageValue (show KeywordId) 263 .> S.insert (show KeywordSet <> show KeywordType)
255 -- 4.9.3. 264 .> S.insert (show KeywordSet)
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 265
263 -- 4.10. 266 -- 4.10.
264 ciModifyContainers <| S.insert (show KeywordNone) 267 ciModifyContainers <| S.insert (show KeywordNone)
265 268
266 -- 4.11. 269 -- 4.11.
267 case value of 270 case value of
268 Just (Object o) 271 Just (Object o)
269 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0 272 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
270 , not (KM.member (show KeywordIndex) o) -> 273 , not (KM.member (show KeywordIndex) o) ->
271 ciModifyContainers 274 ciModifyContainers
272 <| S.insert (show KeywordIndex) 275 <| S.insert (show KeywordIndex)
273 .> S.insert (show KeywordIndex <> show KeywordSet) 276 .> S.insert (show KeywordIndex <> show KeywordSet)
274 _ 277 _
275 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0 -> 278 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0 ->
276 ciModifyContainers 279 ciModifyContainers
277 <| S.insert (show KeywordIndex) 280 <| S.insert (show KeywordIndex)
278 .> S.insert (show KeywordIndex <> show KeywordSet) 281 .> S.insert (show KeywordIndex <> show KeywordSet)
279 -- 282 --
280 | otherwise -> pure () 283 | otherwise -> pure ()
281 284
282 -- 4.12. 285 -- 4.12.
283 case value of 286 case value of
284 Just (Object o) 287 Just (Object o)
285 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0 288 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
286 , KM.member (show KeywordIndex) o 289 , KM.member (show KeywordIndex) o
287 , KM.size o == 1 -> 290 , KM.size o == 1 ->
288 ciModifyContainers 291 ciModifyContainers
289 <| S.insert (show KeywordLanguage) 292 <| S.insert (show KeywordLanguage)
290 .> S.insert (show KeywordLanguage <> show KeywordSet) 293 .> S.insert (show KeywordLanguage <> show KeywordSet)
291 -- 294 --
292 _ -> pure () 295 _ -> pure ()
293 296
294 -- 4.15. 297 -- 4.15.
295 typeLanguageValue <- gets ciStateTypeLanguageValue 298 typeLanguageValue <- gets ciStateTypeLanguageValue
296 when (typeLanguageValue == show KeywordReverse) <| ciModifyPreferredValues (V.cons (show KeywordReverse)) 299 when (typeLanguageValue == show KeywordReverse) <| ciModifyPreferredValues (V.cons (show KeywordReverse))
297 300
298 -- 4.16. 301 -- 4.16.
299 case value of 302 case value of
300 Just (Object o) 303 Just (Object o)
301 | typeLanguageValue == show KeywordReverse || typeLanguageValue == show KeywordId 304 | typeLanguageValue == show KeywordReverse || typeLanguageValue == show KeywordId
302 , Just idValue <- KM.lookup (show KeywordId) o -> case idValue of 305 , Just idValue <- KM.lookup (show KeywordId) o -> case idValue of
303 -- 4.16.1. 306 -- 4.16.1.
304 String idValue' -> do 307 String idValue' -> do
305 compactedIdValue <- ciCompactIri idValue' 308 compactedIdValue <- ciCompactIri idValue'
306 case M.lookup compactedIdValue activeContextTerms of 309 case M.lookup compactedIdValue activeContextTerms of
307 Just term 310 Just term
308 | termDefinitionIriMapping term == Just idValue' -> 311 | termDefinitionIriMapping term == Just idValue' ->
312 ciModifyPreferredValues
313 <| V.cons (show KeywordVocab)
314 .> V.cons (show KeywordId)
315 -- 4.16.2.
316 _ ->
309 ciModifyPreferredValues 317 ciModifyPreferredValues
310 <| V.cons (show KeywordVocab) 318 <| V.cons (show KeywordId)
311 .> V.cons (show KeywordId) 319 .> V.cons (show KeywordVocab)
312 -- 4.16.2. 320 ciModifyPreferredValues <| V.cons (show KeywordNone)
313 _ -> 321 --
314 ciModifyPreferredValues 322 _ -> throwError <. Left <| InvalidKeywordValue KeywordId idValue
315 <| V.cons (show KeywordId) 323 -- 4.17.
316 .> V.cons (show KeywordVocab) 324 | Just (Array a) <- KM.lookup (show KeywordList) o
317 ciModifyPreferredValues <| V.cons (show KeywordNone) 325 , null a -> do
318 -- 326 ciModifyPreferredValues
319 _ -> throwError <. Left <| InvalidKeywordValue KeywordId idValue 327 <| V.cons typeLanguageValue
320 -- 4.17. 328 .> V.cons (show KeywordNone)
321 | Just (Array a) <- KM.lookup (show KeywordList) o 329 ciPutTypeLanguage KeywordAny
322 , null a -> do 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
327 _ -> do
328 ciModifyPreferredValues
329 <| V.cons typeLanguageValue
330 .> V.cons (show KeywordNone)
331 334
332 -- 4.18. 335 -- 4.18.
333 ciModifyPreferredValues <| V.cons (show KeywordAny) 336 ciModifyPreferredValues <| V.cons (show KeywordAny)
337
338 -- 4.19.
339 gets ciStatePreferredValues >>= mapM_ \preferredValue -> case T.findIndex (== ':') preferredValue of
340 Just idx -> ciModifyPreferredValues <| V.cons (T.drop idx preferredValue)
341 Nothing -> pure ()
342
343 -- 4.20.
344 maybeTerm <-
345 liftA3
346 (\containers typeLanguage preferredValues -> selectTerm var containers typeLanguage preferredValues ciEnvInverseContext)
347 (gets ciStateContainers)
348 (gets ciStateTypeLanguage)
349 (gets ciStatePreferredValues)
334 350
335 -- 4.19. 351 -- 4.21.
336 gets ciStatePreferredValues >>= mapM_ \preferredValue -> case T.findIndex (== ':') preferredValue of 352 case maybeTerm of
337 Just idx -> ciModifyPreferredValues <| V.cons (T.drop idx preferredValue) 353 Just term -> throwError <| Right term
338 Nothing -> pure () 354 Nothing -> pure ()
339 355
340 -- 4.20. 356 -- 5.
341 maybeTerm <- 357 case activeContextVocabularyMapping of
342 liftA3 358 Just vocabMapping
343 (\containers typeLanguage preferredValues -> selectTerm var containers typeLanguage preferredValues ciEnvInverseContext) 359 | ciEnvVocab && T.isPrefixOf vocabMapping var && T.length var > T.length vocabMapping
344 (gets ciStateContainers) 360 , suffix <- T.drop (T.length vocabMapping) var
345 (gets ciStateTypeLanguage) 361 , not (M.member suffix activeContextTerms) ->
346 (gets ciStatePreferredValues) 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
347 375
348 -- 4.21. 376 compactIri = ifoldl' go Nothing activeContextTerms
349 case maybeTerm of
350 Just term -> throwError <| Right term
351 Nothing -> pure ()
352 377
353 -- 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 =