aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/Data/JLD/Compaction/IRI.hs42
-rw-r--r--src/Data/JLD/Error.hs1
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
3import Data.JLD.Prelude 3import Data.JLD.Prelude
4 4
5import Data.JLD (JLDError (InvalidKeywordValue), JLDVersion (JLD1_0)) 5import Data.JLD (JLDError (..), JLDVersion (JLD1_0))
6import Data.JLD.Compaction.Global (JLDCompactionEnv (jldCompactionEnvProcessingMode), JLDCompactionT) 6import Data.JLD.Compaction.Global (JLDCompactionEnv (jldCompactionEnvProcessingMode), JLDCompactionT)
7import Data.JLD.Compaction.InverseContext (buildInverseContext) 7import Data.JLD.Compaction.InverseContext (buildInverseContext)
8import Data.JLD.Control.Monad.RES (REST, evalREST, withEnvRES, withErrorRES, withErrorRES') 8import Data.JLD.Control.Monad.RES (REST, evalREST, withEnvRES, withErrorRES, withErrorRES')
@@ -14,6 +14,7 @@ import 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.Foldable.WithIndex (FoldableWithIndex (..))
16import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject') 16import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject')
17import Data.JLD.Model.IRI (isBlankIri)
17import Data.JLD.Model.Keyword (Keyword (..)) 18import Data.JLD.Model.Keyword (Keyword (..))
18import Data.JLD.Model.Language (Language (..)) 19import Data.JLD.Model.Language (Language (..))
19import Data.JLD.Model.ListObject (isListObject') 20import Data.JLD.Model.ListObject (isListObject')
@@ -21,6 +22,7 @@ import Data.JLD.Model.TermDefinition (TermDefinition (termDefinitionIriMapping,
21import Data.JLD.Model.ValueObject (isValueObject') 22import Data.JLD.Model.ValueObject (isValueObject')
22import Data.JLD.Util (valueToArray) 23import Data.JLD.Util (valueToArray)
23import Data.Map qualified as M (lookup, member) 24import Data.Map qualified as M (lookup, member)
25import Data.RDF (IRIRef (..), Scheme (..), parseIRI, resolveIRI, serializeIRI)
24import Data.Set qualified as S (insert) 26import Data.Set qualified as S (insert)
25import Data.Text (toLower) 27import Data.Text (toLower)
26import Data.Text qualified as T (drop, findIndex, isPrefixOf, length) 28import 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
381compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext) 401compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext)
382compactIri activeContext var paramsFn = do 402compactIri 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
47toJldErrorCode :: JLDError e -> Text 48toJldErrorCode :: JLDError e -> Text