diff options
author | Volpeon <github@volpeon.ink> | 2023-06-24 11:14:19 +0200 |
---|---|---|
committer | Volpeon <github@volpeon.ink> | 2023-06-24 11:14:19 +0200 |
commit | 77447e837f7461a337eec09845ad4b24dea1cce4 (patch) | |
tree | a12f839d9233e26043b5a0329c10f15b546b5f7a /src/Data/JLD/Compaction | |
parent | WIP: IRI compaction (diff) | |
download | hs-jsonld-77447e837f7461a337eec09845ad4b24dea1cce4.tar.gz hs-jsonld-77447e837f7461a337eec09845ad4b24dea1cce4.tar.bz2 hs-jsonld-77447e837f7461a337eec09845ad4b24dea1cce4.zip |
Update
Diffstat (limited to 'src/Data/JLD/Compaction')
-rw-r--r-- | src/Data/JLD/Compaction/IRI.hs | 539 |
1 files changed, 282 insertions, 257 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) | |||
12 | import Control.Monad.Except (MonadError (..)) | 12 | import Control.Monad.Except (MonadError (..)) |
13 | import Data.Aeson (Value (..)) | 13 | import Data.Aeson (Value (..)) |
14 | import Data.Aeson.KeyMap qualified as KM (lookup, member, size) | 14 | import Data.Aeson.KeyMap qualified as KM (lookup, member, size) |
15 | import Data.Foldable.WithIndex (FoldableWithIndex (..)) | ||
15 | import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject') | 16 | import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject') |
16 | import Data.JLD.Model.Keyword (Keyword (..)) | 17 | import Data.JLD.Model.Keyword (Keyword (..)) |
17 | import Data.JLD.Model.Language (Language (..)) | 18 | import Data.JLD.Model.Language (Language (..)) |
18 | import Data.JLD.Model.ListObject (isListObject') | 19 | import Data.JLD.Model.ListObject (isListObject') |
19 | import Data.JLD.Model.TermDefinition (TermDefinition (termDefinitionIriMapping)) | 20 | import Data.JLD.Model.TermDefinition (TermDefinition (termDefinitionIriMapping, termDefinitionPrefixFlag)) |
20 | import Data.JLD.Model.ValueObject (isValueObject') | 21 | import Data.JLD.Model.ValueObject (isValueObject') |
21 | import Data.JLD.Util (valueToArray) | 22 | import Data.JLD.Util (valueToArray) |
22 | import Data.Map qualified as M (lookup) | 23 | import Data.Map qualified as M (lookup, member) |
23 | import Data.Set qualified as S (insert) | 24 | import Data.Set qualified as S (insert) |
24 | import Data.Text (toLower) | 25 | import Data.Text (toLower) |
25 | import Data.Text qualified as T (drop, findIndex) | 26 | import Data.Text qualified as T (drop, findIndex, isPrefixOf, length) |
26 | import Data.Vector (Vector, (!?)) | 27 | import Data.Vector (Vector, (!?)) |
27 | import Data.Vector qualified as V (cons) | 28 | import 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 | ||
356 | compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext) | 381 | compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext) |