Fix https://github.com/w3c/json-ld-api/issues/565HEADmaster

1 files changed, 38 insertions, 42 deletions

diff --git a/src/Data/JLD/Expansion/Context.hs b/src/Data/JLD/Expansion/Context.hs
index 21350c8..570628f 100644
--- a/src/Data/JLD/Expansion/Context.hs
+++ b/src/Data/JLD/Expansion/Context.hs
@@ -52,19 +52,19 @@ data BACParams = BACParams
     }
     deriving (Show, Eq)
 
-bacModifyContextCache :: Monad m => (ContextCache -> ContextCache) -> BACT e m ()
+bacModifyContextCache :: (Monad m) => (ContextCache -> ContextCache) -> BACT e m ()
 bacModifyContextCache = modifyContextCache .> withStateRES bacStateGlobal (\s g -> s{bacStateGlobal = g})
 
-bacModifyDocumentCache :: Monad m => (DocumentCache -> DocumentCache) -> BACT e m ()
+bacModifyDocumentCache :: (Monad m) => (DocumentCache -> DocumentCache) -> BACT e m ()
 bacModifyDocumentCache = modifyDocumentCache .> withStateRES bacStateGlobal (\s g -> s{bacStateGlobal = g})
 
-bacModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> BACT e m ()
+bacModifyActiveContext :: (Monad m) => (ActiveContext -> ActiveContext) -> BACT e m ()
 bacModifyActiveContext fn = modify \s -> s{bacStateActiveContext = fn (bacStateActiveContext s)}
 
-bacModifyRemoteContexts :: Monad m => (Set Text -> Set Text) -> BACT e m ()
+bacModifyRemoteContexts :: (Monad m) => (Set Text -> Set Text) -> BACT e m ()
 bacModifyRemoteContexts fn = modify \s -> s{bacStateRemoteContexts = fn (bacStateRemoteContexts s)}
 
-bacBuildTermDefinition :: Monad m => Object -> Maybe URI -> Text -> BACT e m ()
+bacBuildTermDefinition :: (Monad m) => Object -> Maybe URI -> Text -> BACT e m ()
 bacBuildTermDefinition contextDefinition baseUrl term = do
     BACEnv{..} <- ask
     activeContext <- gets bacStateActiveContext
@@ -83,7 +83,7 @@ bacBuildTermDefinition contextDefinition baseUrl term = do
             |> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
     bacModifyActiveContext <| const activeContext'
 
-bacBuildActiveContext :: Monad m => Value -> URI -> BACT e m ()
+bacBuildActiveContext :: (Monad m) => Value -> URI -> BACT e m ()
 bacBuildActiveContext context uri = do
     BACEnv{..} <- ask
     activeContext <- gets bacStateActiveContext
@@ -100,7 +100,7 @@ bacBuildActiveContext context uri = do
             .> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
     bacModifyActiveContext <| const activeContext'
 
-bacProcessItem :: Monad m => Maybe URI -> Value -> BACT e m ()
+bacProcessItem :: (Monad m) => Maybe URI -> Value -> BACT e m ()
 bacProcessItem baseUrl item = do
     BACEnv{..} <- ask
     let JLDExpansionEnv{..} = hoistEnv (lift .> lift .> lift) bacEnvGlobal
@@ -263,7 +263,7 @@ bacProcessItem baseUrl item = do
         -- 5.3.
         _ -> throwError <| Left InvalidLocalContext
 
-bacFetchRemoteContext :: Monad m => Text -> Maybe URI -> BACT e m ()
+bacFetchRemoteContext :: (Monad m) => Text -> Maybe URI -> BACT e m ()
 bacFetchRemoteContext url maybeBaseUrl
     | Just uri <- parseUri url
     , Just contextUri <- relativeTo uri =<< maybeBaseUrl -- 5.2.1.
@@ -315,7 +315,7 @@ bacFetchRemoteContext url maybeBaseUrl
         bacModifyContextCache <| M.insert contextKey importedContext
     | otherwise = throwError <| Left LoadingRemoteContextError
 
-buildActiveContext' :: Monad m => Value -> Maybe URI -> BACT e m ()
+buildActiveContext' :: (Monad m) => Value -> Maybe URI -> BACT e m ()
 buildActiveContext' localContext baseUrl = do
     activeContext <- gets bacStateActiveContext
 
@@ -340,7 +340,7 @@ buildActiveContext' localContext baseUrl = do
         .> withEnvRES (\env -> env{bacEnvPropagate = propagate})
         .> withErrorRES' (either (Left .> throwError) pure)
 
-buildActiveContext :: Monad m => ActiveContext -> Value -> Maybe URI -> (BACParams -> BACParams) -> JLDExpansionT e m ActiveContext
+buildActiveContext :: (Monad m) => ActiveContext -> Value -> Maybe URI -> (BACParams -> BACParams) -> JLDExpansionT e m ActiveContext
 buildActiveContext activeContext localContext baseUrl paramsFn = do
     BACState{..} <-
         (buildActiveContext' localContext baseUrl >> get)
@@ -400,7 +400,7 @@ data EIParams = EIParams
     }
     deriving (Show, Eq)
 
-eiBuildTermDefinition :: Monad m => Text -> EIT e m ()
+eiBuildTermDefinition :: (Monad m) => Text -> EIT e m ()
 eiBuildTermDefinition value = do
     EIEnv{..} <- ask
     defined <- gets eiStateDefined
@@ -417,7 +417,7 @@ eiBuildTermDefinition value = do
             , eiStateDefined = defined'
             }
 
-eiInitLocalContext :: Monad m => Text -> EIT e m ()
+eiInitLocalContext :: (Monad m) => Text -> EIT e m ()
 eiInitLocalContext value =
     -- 3.
     asks eiEnvLocalContext >>= \case
@@ -426,7 +426,7 @@ eiInitLocalContext value =
             when (maybe True not (M.lookup entry defined)) <| eiBuildTermDefinition value
         _ -> pure ()
 
-eiInitPropertyContext :: Monad m => Text -> Text -> Text -> EIT e m Text
+eiInitPropertyContext :: (Monad m) => Text -> Text -> Text -> EIT e m Text
 eiInitPropertyContext prefix suffix value = do
     -- 6.3.
     defined <- gets eiStateDefined
@@ -445,7 +445,7 @@ eiInitPropertyContext prefix suffix value = do
                 pure <| iriMapping <> suffix
         _ -> pure value
 
-eiExpandResult :: Monad m => Text -> EIT e m (Maybe Text)
+eiExpandResult :: (Monad m) => Text -> EIT e m (Maybe Text)
 eiExpandResult value = do
     EIEnv{..} <- ask
     activeContext <- gets eiStateActiveContext
@@ -461,7 +461,7 @@ eiExpandResult value = do
         -- 9.
         _ -> pure <| Just value
 
-expandIri' :: Monad m => Text -> EIT e m (Maybe Text)
+expandIri' :: (Monad m) => Text -> EIT e m (Maybe Text)
 expandIri' value
     -- 1.
     | Just _ <- parseKeyword value = pure <| Just value
@@ -499,7 +499,7 @@ expandIri' value
             --
             _ -> eiExpandResult value
 
-expandIri :: Monad m => ActiveContext -> Text -> (EIParams -> EIParams) -> JLDExpansionT e m (Maybe Text, ActiveContext, Map Text Bool)
+expandIri :: (Monad m) => ActiveContext -> Text -> (EIParams -> EIParams) -> JLDExpansionT e m (Maybe Text, ActiveContext, Map Text Bool)
 expandIri activeContext value paramsFn = do
     (value', EIState{..}) <-
         (expandIri' value >>= \v -> gets (v,))
@@ -563,13 +563,13 @@ data BTDParams = BTDParams
     }
     deriving (Show, Eq)
 
-btdModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> BTDT e m ()
+btdModifyActiveContext :: (Monad m) => (ActiveContext -> ActiveContext) -> BTDT e m ()
 btdModifyActiveContext fn = modify \s -> s{btdStateActiveContext = fn (btdStateActiveContext s)}
 
-btdModifyTermDefinition :: Monad m => (TermDefinition -> TermDefinition) -> BTDT e m ()
+btdModifyTermDefinition :: (Monad m) => (TermDefinition -> TermDefinition) -> BTDT e m ()
 btdModifyTermDefinition fn = modify \s -> s{btdStateTermDefinition = fn (btdStateTermDefinition s)}
 
-btdModifyDefined :: Monad m => (Map Text Bool -> Map Text Bool) -> BTDT e m ()
+btdModifyDefined :: (Monad m) => (Map Text Bool -> Map Text Bool) -> BTDT e m ()
 btdModifyDefined fn = modify \s -> s{btdStateDefined = fn (btdStateDefined s)}
 
 btdValidateContainer :: JLDExpansionEnv e m -> Value -> Bool
@@ -602,7 +602,7 @@ btdValidateContainer JLDExpansionEnv{..} value
                 True
         _ -> False
 
-btdExpandIri :: Monad m => Text -> BTDT e m (Maybe Text)
+btdExpandIri :: (Monad m) => Text -> BTDT e m (Maybe Text)
 btdExpandIri value = do
     BTDEnv{..} <- ask
     defined <- gets btdStateDefined
@@ -625,7 +625,7 @@ btdExpandIri value = do
             }
     pure expanded
 
-btdBuildTermDefinition :: Monad m => Text -> BTDT e m ()
+btdBuildTermDefinition :: (Monad m) => Text -> BTDT e m ()
 btdBuildTermDefinition term = do
     BTDEnv{..} <- ask
     defined <- gets btdStateDefined
@@ -642,7 +642,7 @@ btdBuildTermDefinition term = do
             , btdStateDefined = defined'
             }
 
-buildTermDefinition' :: Monad m => Text -> BTDT e m ()
+buildTermDefinition' :: (Monad m) => Text -> BTDT e m ()
 buildTermDefinition' "" = throwError <| Left InvalidTermDefinition -- 2.
 buildTermDefinition' term = do
     BTDEnv{..} <- ask
@@ -666,16 +666,16 @@ buildTermDefinition' term = do
             | JLD1_0 <- jldExpansionEnvProcessingMode -> throwError <| Left KeywordRedefinition
             | Object map' <- value ->
                 if
-                        | KM.size map' == 1
-                        , Just container <- KM.lookup (show KeywordContainer) map' ->
-                            when (container /= String (show KeywordSet)) <| throwError (Left KeywordRedefinition)
-                        | KM.size map' == 2
-                        , Just container <- KM.lookup (show KeywordContainer) map'
-                        , KM.member (show KeywordProtected) map' ->
-                            unless (valueContains (show KeywordSet) container) <| throwError (Left KeywordRedefinition)
-                        | KM.size map' /= 1 || not (KM.member (show KeywordProtected) map') ->
-                            throwError <| Left KeywordRedefinition
-                        | otherwise -> pure ()
+                    | KM.size map' == 1
+                    , Just container <- KM.lookup (show KeywordContainer) map' ->
+                        when (container /= String (show KeywordSet)) <| throwError (Left KeywordRedefinition)
+                    | KM.size map' == 2
+                    , Just container <- KM.lookup (show KeywordContainer) map'
+                    , KM.member (show KeywordProtected) map' ->
+                        unless (valueContains (show KeywordSet) container) <| throwError (Left KeywordRedefinition)
+                    | KM.size map' /= 1 || not (KM.member (show KeywordProtected) map') ->
+                        throwError <| Left KeywordRedefinition
+                    | otherwise -> pure ()
             | otherwise -> throwError <| Left KeywordRedefinition
         -- 5.
         (parseKeyword -> Just _) -> throwError <| Left KeywordRedefinition
@@ -726,6 +726,9 @@ buildTermDefinition' term = do
         --
         Nothing -> pure ()
 
+    -- 14. 15. 16. 17. 18.
+    maybeVocabMapping <- gets (btdStateActiveContext .> activeContextVocabularyMapping)
+
     -- 13.
     case KM.lookup (show KeywordReverse) valueObject of
         -- 13.1.
@@ -757,17 +760,10 @@ buildTermDefinition' term = do
             definition <- gets btdStateTermDefinition
             btdModifyActiveContext \ac -> ac{activeContextTerms = activeContextTerms ac |> M.insert term definition}
             btdModifyDefined <| M.insert term True
-
-            throwError <| Right ()
         -- 13.2.
         Just _ -> throwError <| Left InvalidIriMapping
-        --
-        Nothing -> pure ()
-
-    -- 14. 15. 16. 17. 18.
-    maybeVocabMapping <- gets (btdStateActiveContext .> activeContextVocabularyMapping)
-    if
-            -- 14. 14.1.
+        -- 14. 14.1.
+        Nothing
             | Just idValue' <- idValue
             , idValue' /= String term -> case idValue' of
                 Null -> pure ()
@@ -980,7 +976,7 @@ buildTermDefinition' term = do
 
     btdModifyDefined <| M.insert term True
 
-buildTermDefinition :: Monad m => ActiveContext -> Object -> Text -> (BTDParams -> BTDParams) -> JLDExpansionT e m (ActiveContext, Map Text Bool)
+buildTermDefinition :: (Monad m) => ActiveContext -> Object -> Text -> (BTDParams -> BTDParams) -> JLDExpansionT e m (ActiveContext, Map Text Bool)
 buildTermDefinition activeContext localContext term paramsFn = do
     BTDState{..} <-
         (buildTermDefinition' term >> get)