From 57870d6f040795546008ec254a70856fc2b436a8 Mon Sep 17 00:00:00 2001
From: Volpeon <github@volpeon.ink>
Date: Sun, 25 Jun 2023 09:35:34 +0200
Subject: Update

---
 src/Data/JLD/Compaction/IRI.hs | 42 +++++++++++++++++++++++++++++++-----------
 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
 
 import Data.JLD.Prelude
 
-import Data.JLD (JLDError (InvalidKeywordValue), JLDVersion (JLD1_0))
+import Data.JLD (JLDError (..), JLDVersion (JLD1_0))
 import Data.JLD.Compaction.Global (JLDCompactionEnv (jldCompactionEnvProcessingMode), JLDCompactionT)
 import Data.JLD.Compaction.InverseContext (buildInverseContext)
 import Data.JLD.Control.Monad.RES (REST, evalREST, withEnvRES, withErrorRES, withErrorRES')
@@ -14,6 +14,7 @@ import Data.Aeson (Value (..))
 import Data.Aeson.KeyMap qualified as KM (lookup, member, size)
 import Data.Foldable.WithIndex (FoldableWithIndex (..))
 import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject')
+import Data.JLD.Model.IRI (isBlankIri)
 import Data.JLD.Model.Keyword (Keyword (..))
 import Data.JLD.Model.Language (Language (..))
 import Data.JLD.Model.ListObject (isListObject')
@@ -21,6 +22,7 @@ import Data.JLD.Model.TermDefinition (TermDefinition (termDefinitionIriMapping,
 import Data.JLD.Model.ValueObject (isValueObject')
 import Data.JLD.Util (valueToArray)
 import Data.Map qualified as M (lookup, member)
+import Data.RDF (IRIRef (..), Scheme (..), parseIRI, resolveIRI, serializeIRI)
 import Data.Set qualified as S (insert)
 import Data.Text (toLower)
 import Data.Text qualified as T (drop, findIndex, isPrefixOf, length)
@@ -362,21 +364,39 @@ compactIri' var = do
                 throwError <| Right suffix
         _ -> pure ()
 
-    -- 6.
+    -- 6. 7.
     let go key ci term = case termDefinitionIriMapping term of
+            -- 7.1.
             Nothing -> ci
             Just iriMapping
-                | var == iriMapping
-                    || not (T.isPrefixOf iriMapping var)
-                    || not (termDefinitionPrefixFlag term) ->
-                    ci
+                | var == iriMapping || not (T.isPrefixOf iriMapping var) || not (termDefinitionPrefixFlag term) -> ci
+                -- 7.3.
+                | (maybe True (ciCandidate <) ci && not (M.member ciCandidate activeContextTerms))
+                    || (M.lookup ciCandidate activeContextTerms >>= termDefinitionIriMapping) == Just var && maybe True (== Null) ciEnvValue ->
+                    Just ciCandidate
                 --
-                | otherwise -> do
-
-        compactIri = ifoldl' go Nothing activeContextTerms
+                | otherwise -> ci
+              where
+                -- 7.2.
+                ciCandidate = key <> ":" <> T.drop (T.length iriMapping) var
+
+    -- 8.
+    case ifoldl' go Nothing activeContextTerms of
+        Just ci -> throwError <| Right ci
+        Nothing -> pure ()
+
+    -- 9.
+    case parseIRI var of
+        Right (IRIRef (Just (Scheme scheme)) Nothing _ _ _)
+            | Just term <- M.lookup scheme activeContextTerms
+            , termDefinitionPrefixFlag term ->
+                throwError <| Left IRIConfusedWithPrefix
+        _ -> pure ()
 
-    -- 11.
-    pure var
+    -- 10.
+    case activeContextBaseIri of
+        -- 11.
+        _ -> pure var
 
 compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext)
 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
     | InvalidSetOrListObject
     | InvalidScopedContext
     | ConflictingIndexes
+    | IRIConfusedWithPrefix
     deriving (Eq, Show)
 
 toJldErrorCode :: JLDError e -> Text
-- 
cgit v1.2.3-54-g00ecf