diff options
Diffstat (limited to 'src/Data/JLD')
-rw-r--r-- | src/Data/JLD/Compaction/IRI.hs | 509 | ||||
-rw-r--r-- | src/Data/JLD/Model/InverseContext.hs | 2 |
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) | |||
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 |
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 | ||
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) |
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 | ||
13 | hasKey3 :: Text -> Text -> Keyword -> InverseContext -> Bool | 13 | hasKey3 :: Text -> Text -> Keyword -> InverseContext -> Bool |
14 | hasKey3 var container type' inverseContext = | 14 | hasKey3 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 | ||
17 | lookup4 :: Text -> Text -> Keyword -> Text -> InverseContext -> Maybe Text | 17 | lookup4 :: Text -> Text -> Keyword -> Text -> InverseContext -> Maybe Text |
18 | lookup4 var container type' typeMapping inverseContext = | 18 | lookup4 var container type' typeMapping inverseContext = |