diff options
-rw-r--r-- | src/Data/JLD/Compaction/IRI.hs | 42 | ||||
-rw-r--r-- | src/Data/JLD/Error.hs | 1 |
2 files changed, 32 insertions, 11 deletions
diff --git a/src/Data/JLD/Compaction/IRI.hs b/src/Data/JLD/Compaction/IRI.hs index 414c7de..c7ac127 100644 --- a/src/Data/JLD/Compaction/IRI.hs +++ b/src/Data/JLD/Compaction/IRI.hs | |||
@@ -2,7 +2,7 @@ module Data.JLD.Compaction.IRI (compactIri) where | |||
2 | 2 | ||
3 | import Data.JLD.Prelude | 3 | import Data.JLD.Prelude |
4 | 4 | ||
5 | import Data.JLD (JLDError (InvalidKeywordValue), JLDVersion (JLD1_0)) | 5 | import Data.JLD (JLDError (..), JLDVersion (JLD1_0)) |
6 | import Data.JLD.Compaction.Global (JLDCompactionEnv (jldCompactionEnvProcessingMode), JLDCompactionT) | 6 | import Data.JLD.Compaction.Global (JLDCompactionEnv (jldCompactionEnvProcessingMode), JLDCompactionT) |
7 | import Data.JLD.Compaction.InverseContext (buildInverseContext) | 7 | import Data.JLD.Compaction.InverseContext (buildInverseContext) |
8 | import Data.JLD.Control.Monad.RES (REST, evalREST, withEnvRES, withErrorRES, withErrorRES') | 8 | import Data.JLD.Control.Monad.RES (REST, evalREST, withEnvRES, withErrorRES, withErrorRES') |
@@ -14,6 +14,7 @@ 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.Foldable.WithIndex (FoldableWithIndex (..)) |
16 | import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject') | 16 | import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject') |
17 | import Data.JLD.Model.IRI (isBlankIri) | ||
17 | import Data.JLD.Model.Keyword (Keyword (..)) | 18 | import Data.JLD.Model.Keyword (Keyword (..)) |
18 | import Data.JLD.Model.Language (Language (..)) | 19 | import Data.JLD.Model.Language (Language (..)) |
19 | import Data.JLD.Model.ListObject (isListObject') | 20 | import Data.JLD.Model.ListObject (isListObject') |
@@ -21,6 +22,7 @@ import Data.JLD.Model.TermDefinition (TermDefinition (termDefinitionIriMapping, | |||
21 | import Data.JLD.Model.ValueObject (isValueObject') | 22 | import Data.JLD.Model.ValueObject (isValueObject') |
22 | import Data.JLD.Util (valueToArray) | 23 | import Data.JLD.Util (valueToArray) |
23 | import Data.Map qualified as M (lookup, member) | 24 | import Data.Map qualified as M (lookup, member) |
25 | import Data.RDF (IRIRef (..), Scheme (..), parseIRI, resolveIRI, serializeIRI) | ||
24 | import Data.Set qualified as S (insert) | 26 | import Data.Set qualified as S (insert) |
25 | import Data.Text (toLower) | 27 | import Data.Text (toLower) |
26 | import Data.Text qualified as T (drop, findIndex, isPrefixOf, length) | 28 | import Data.Text qualified as T (drop, findIndex, isPrefixOf, length) |
@@ -362,21 +364,39 @@ compactIri' var = do | |||
362 | throwError <| Right suffix | 364 | throwError <| Right suffix |
363 | _ -> pure () | 365 | _ -> pure () |
364 | 366 | ||
365 | -- 6. | 367 | -- 6. 7. |
366 | let go key ci term = case termDefinitionIriMapping term of | 368 | let go key ci term = case termDefinitionIriMapping term of |
369 | -- 7.1. | ||
367 | Nothing -> ci | 370 | Nothing -> ci |
368 | Just iriMapping | 371 | Just iriMapping |
369 | | var == iriMapping | 372 | | var == iriMapping || not (T.isPrefixOf iriMapping var) || not (termDefinitionPrefixFlag term) -> ci |
370 | || not (T.isPrefixOf iriMapping var) | 373 | -- 7.3. |
371 | || not (termDefinitionPrefixFlag term) -> | 374 | | (maybe True (ciCandidate <) ci && not (M.member ciCandidate activeContextTerms)) |
372 | ci | 375 | || (M.lookup ciCandidate activeContextTerms >>= termDefinitionIriMapping) == Just var && maybe True (== Null) ciEnvValue -> |
376 | Just ciCandidate | ||
373 | -- | 377 | -- |
374 | | otherwise -> do | 378 | | otherwise -> ci |
375 | 379 | where | |
376 | compactIri = ifoldl' go Nothing activeContextTerms | 380 | -- 7.2. |
381 | ciCandidate = key <> ":" <> T.drop (T.length iriMapping) var | ||
382 | |||
383 | -- 8. | ||
384 | case ifoldl' go Nothing activeContextTerms of | ||
385 | Just ci -> throwError <| Right ci | ||
386 | Nothing -> pure () | ||
387 | |||
388 | -- 9. | ||
389 | case parseIRI var of | ||
390 | Right (IRIRef (Just (Scheme scheme)) Nothing _ _ _) | ||
391 | | Just term <- M.lookup scheme activeContextTerms | ||
392 | , termDefinitionPrefixFlag term -> | ||
393 | throwError <| Left IRIConfusedWithPrefix | ||
394 | _ -> pure () | ||
377 | 395 | ||
378 | -- 11. | 396 | -- 10. |
379 | pure var | 397 | case activeContextBaseIri of |
398 | -- 11. | ||
399 | _ -> pure var | ||
380 | 400 | ||
381 | compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext) | 401 | compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext) |
382 | compactIri activeContext var paramsFn = do | 402 | compactIri activeContext var paramsFn = do |
diff --git a/src/Data/JLD/Error.hs b/src/Data/JLD/Error.hs index fe59df0..7b6fdec 100644 --- a/src/Data/JLD/Error.hs +++ b/src/Data/JLD/Error.hs | |||
@@ -42,6 +42,7 @@ data JLDError e | |||
42 | | InvalidSetOrListObject | 42 | | InvalidSetOrListObject |
43 | | InvalidScopedContext | 43 | | InvalidScopedContext |
44 | | ConflictingIndexes | 44 | | ConflictingIndexes |
45 | | IRIConfusedWithPrefix | ||
45 | deriving (Eq, Show) | 46 | deriving (Eq, Show) |
46 | 47 | ||
47 | toJldErrorCode :: JLDError e -> Text | 48 | toJldErrorCode :: JLDError e -> Text |