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 | |
| 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')
| -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 = |
