Structural improvements

2 files changed, 1058 insertions, 0 deletions

diff --git a/src/Data/JLD/Expansion/Context.hs b/src/Data/JLD/Expansion/Context.hs
new file mode 100644
index 0000000..ce61644
--- /dev/null
+++ b/src/Data/JLD/Expansion/Context.hs
@@ -0,0 +1,1020 @@
+module Data.JLD.Expansion.Context (BTDParams (..), EIParams (..), BACParams (..), buildTermDefinition, expandIri, buildActiveContext) where
+
+import Data.JLD.Prelude
+
+import Data.JLD.Control.Monad.RES (REST, withEnvRES, withErrorRES, withErrorRES', withStateRES)
+import Data.JLD.Error (JLDError (..))
+import Data.JLD.Expansion.Global (JLDExpansionEnv (..), JLDExpansionState (..), JLDExpansionT, hoistEnv, modifyContextCache, modifyDocumentCache)
+import Data.JLD.Model.ActiveContext (ActiveContext (..), containsProtectedTerm, lookupTerm, newActiveContext)
+import Data.JLD.Model.Direction (Direction (..))
+import Data.JLD.Model.IRI (CompactIRI (..), endsWithGenericDelim, isBlankIri, parseCompactIri)
+import Data.JLD.Model.Keyword (Keyword (..), allKeywords, isKeyword, isKeywordLike, isNotKeyword, parseKeyword)
+import Data.JLD.Model.Language (Language (..))
+import Data.JLD.Model.TermDefinition (TermDefinition (..), newTermDefinition)
+import Data.JLD.Model.URI (parseUri, uriToIri)
+import Data.JLD.Options (ContextCache, Document (..), DocumentCache, DocumentLoader (..), JLDVersion (..))
+import Data.JLD.Util (flattenSingletonArray, valueContains, valueContainsAny, valueIsTrue, valueToArray)
+
+import Control.Monad.Except (MonadError (..))
+import Data.Aeson (Object, Value (..))
+import Data.Aeson.Key qualified as K (fromText, toText)
+import Data.Aeson.KeyMap qualified as KM (delete, keys, lookup, member, size)
+import Data.Map.Strict qualified as M (delete, insert, lookup)
+import Data.RDF (parseIRI, parseRelIRI, resolveIRI, serializeIRI, validateIRI)
+import Data.Set qualified as S (insert, member, notMember, size)
+import Data.Text qualified as T (drop, dropEnd, elem, findIndex, isPrefixOf, null, take, toLower)
+import Data.Vector qualified as V (length)
+import Text.URI (URI, isPathAbsolute, relativeTo)
+import Text.URI qualified as U (render)
+
+type BACT e m = REST (BACEnv e m) (Either (JLDError e) ()) BACState m
+
+data BACEnv e m = BACEnv
+    { bacEnvGlobal :: JLDExpansionEnv e m
+    , bacEnvOverrideProtected :: Bool
+    , bacEnvValidateScopedContext :: Bool
+    , bacEnvPropagate :: Bool
+    }
+    deriving (Show)
+
+data BACState = BACState
+    { bacStateGlobal :: JLDExpansionState
+    , bacStateActiveContext :: ActiveContext
+    , bacStateRemoteContexts :: Set Text
+    }
+    deriving (Show, Eq)
+
+data BACParams = BACParams
+    { bacParamsOverrideProtected :: Bool
+    , bacParamsPropagate :: Bool
+    , bacParamsValidateScopedContext :: Bool
+    , bacParamsRemoteContexts :: Set Text
+    }
+    deriving (Show, Eq)
+
+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 = modifyDocumentCache .> withStateRES bacStateGlobal (\s g -> s{bacStateGlobal = g})
+
+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 fn = modify \s -> s{bacStateRemoteContexts = fn (bacStateRemoteContexts s)}
+
+bacBuildTermDefinition :: Monad m => Object -> Maybe URI -> Text -> BACT e m ()
+bacBuildTermDefinition contextDefinition baseUrl term = do
+    BACEnv{..} <- ask
+    activeContext <- gets bacStateActiveContext
+    remoteContexts <- gets bacStateRemoteContexts
+    let params p =
+            p
+                { btdParamsBaseUrl = baseUrl
+                , btdParamsOverrideProtectedFlag = bacEnvOverrideProtected
+                , btdParamsProtectedFlag = contextDefinition |> KM.lookup (show KeywordProtected) .> maybe False valueIsTrue
+                , btdParamsRemoteContexts = remoteContexts
+                }
+    (activeContext', _) <-
+        buildTermDefinition activeContext contextDefinition term params
+            |> withEnvRES (const bacEnvGlobal)
+            |> withErrorRES Left
+            |> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
+    bacModifyActiveContext <| const activeContext'
+
+bacBuildActiveContext :: Monad m => Value -> URI -> BACT e m ()
+bacBuildActiveContext context uri = do
+    BACEnv{..} <- ask
+    activeContext <- gets bacStateActiveContext
+    remoteContexts <- gets bacStateRemoteContexts
+    let params p =
+            p
+                { bacParamsValidateScopedContext = bacEnvValidateScopedContext
+                , bacParamsRemoteContexts = remoteContexts
+                }
+    activeContext' <-
+        buildActiveContext activeContext context (Just uri) params
+            |> withEnvRES (const bacEnvGlobal)
+            |> withErrorRES Left
+            |> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
+    bacModifyActiveContext <| const activeContext'
+
+bacProcessItem :: Monad m => Maybe URI -> Value -> BACT e m ()
+bacProcessItem baseUrl item = do
+    BACEnv{..} <- ask
+    let JLDExpansionEnv{..} = hoistEnv (lift .> lift .> lift) bacEnvGlobal
+
+    result <- gets bacStateActiveContext
+
+    case item of
+        -- 5.1.
+        Null
+            -- 5.1.1.
+            | not bacEnvOverrideProtected && containsProtectedTerm result -> throwError <| Left InvalidContextNullification
+            -- 5.1.2.
+            | bacEnvPropagate ->
+                bacModifyActiveContext \ac -> newActiveContext \nac ->
+                    nac
+                        { activeContextBaseUrl = activeContextBaseUrl ac
+                        , activeContextBaseIri = uriToIri =<< activeContextBaseUrl ac
+                        }
+            | otherwise ->
+                bacModifyActiveContext \ac -> newActiveContext \nac ->
+                    nac
+                        { activeContextBaseUrl = activeContextBaseUrl ac
+                        , activeContextBaseIri = uriToIri =<< activeContextBaseUrl ac
+                        , activeContextPreviousContext = activeContextPreviousContext ac
+                        }
+        -- 5.2.
+        String value -> bacFetchRemoteContext value baseUrl
+        -- 5.4.
+        Object contextDefinition -> do
+            -- 5.5. 5.5.1. 5.5.2.
+            case KM.lookup (show KeywordVersion) contextDefinition of
+                Just (String "1.1")
+                    | JLD1_0 <- jldExpansionEnvProcessingMode -> throwError <| Left ProcessingModeConflict
+                    | otherwise -> pure ()
+                Just (Number 1.1)
+                    | JLD1_0 <- jldExpansionEnvProcessingMode -> throwError <| Left ProcessingModeConflict
+                    | otherwise -> pure ()
+                Just value -> throwError <. Left <| InvalidKeywordValue KeywordVersion value
+                --
+                Nothing -> pure ()
+
+            -- 5.6.
+            contextDefinition' <- case KM.lookup (show KeywordImport) contextDefinition of
+                -- 5.6.1.
+                Just _ | JLD1_0 <- jldExpansionEnvProcessingMode -> throwError <| Left InvalidContextEntry
+                -- 5.6.3.
+                Just (String value)
+                    | Just importUri <- parseUri value
+                    , Just contextUri <- relativeTo importUri =<< baseUrl ->
+                        runDocumentLoader jldExpansionEnvDocumentLoader contextUri >>= \case
+                            Right (Object document) -> case KM.lookup (show KeywordContext) document of
+                                Just (Object remoteContext)
+                                    -- 5.6.7.
+                                    | KM.member (show KeywordImport) remoteContext -> throwError <| Left InvalidContextEntry
+                                    -- 5.6.8.
+                                    | otherwise -> pure <| contextDefinition <> remoteContext
+                                -- 5.6.6.
+                                _ -> throwError <| Left InvalidRemoteContext
+                            -- 5.6.6.
+                            Right _ -> throwError <| Left InvalidRemoteContext
+                            -- 5.6.5.
+                            Left err -> throwError <. Left <| DocumentLoaderError err
+                -- 5.6.2.
+                Just value -> throwError <. Left <| InvalidKeywordValue KeywordImport value
+                --
+                Nothing -> pure contextDefinition
+
+            -- 5.7. 5.7.1.
+            case KM.lookup (show KeywordBase) contextDefinition' of
+                -- 5.7.2.
+                Just Null -> bacModifyActiveContext \ac -> ac{activeContextBaseIri = Nothing}
+                Just (String "") -> pure ()
+                Just (String value)
+                    -- 5.7.3.
+                    | Right iri <- parseIRI value -> bacModifyActiveContext \ac -> ac{activeContextBaseIri = Just iri}
+                    -- 5.7.4.
+                    | Just baseIri <- activeContextBaseIri result
+                    , Right iri <- parseIRI =<< resolveIRI (serializeIRI baseIri) value ->
+                        bacModifyActiveContext \ac -> ac{activeContextBaseIri = Just iri}
+                --
+                Just _ -> throwError <| Left InvalidBaseIri
+                --
+                Nothing -> pure ()
+
+            -- 5.8. 5.8.1.
+            case KM.lookup (show KeywordVocab) contextDefinition' of
+                -- 5.8.2.
+                Just Null -> bacModifyActiveContext \ac -> ac{activeContextVocabularyMapping = Nothing}
+                -- 5.8.3.
+                Just (String value) | T.null value || isBlankIri value || isRight (parseIRI value) || isRight (parseRelIRI value) -> do
+                    activeContext <- gets bacStateActiveContext
+                    let params p =
+                            p
+                                { eiParamsVocab = True
+                                , eiParamsDocumentRelative = True
+                                }
+                    (maybeVocabMapping, activeContext', _) <-
+                        expandIri activeContext value params
+                            |> withEnvRES (const bacEnvGlobal)
+                            |> withErrorRES Left
+                            |> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
+                    bacModifyActiveContext <| const activeContext'
+
+                    case maybeVocabMapping of
+                        Just vocabMapping | isBlankIri vocabMapping || isRight (parseIRI vocabMapping) ->
+                            bacModifyActiveContext \ac -> ac{activeContextVocabularyMapping = Just vocabMapping}
+                        _ ->
+                            throwError <| Left InvalidVocabMapping
+                Just _ -> throwError <| Left InvalidVocabMapping
+                --
+                Nothing -> pure ()
+
+            -- 5.9. 5.9.1.
+            case KM.lookup (show KeywordLanguage) contextDefinition' of
+                -- 5.9.2.
+                Just Null -> bacModifyActiveContext \ac -> ac{activeContextDefaultLanguage = Just NoLanguage}
+                -- 5.9.3.
+                Just (String language) -> bacModifyActiveContext \ac -> ac{activeContextDefaultLanguage = Just <| Language language}
+                Just _ -> throwError <| Left InvalidDefaultLanguage
+                --
+                Nothing -> pure ()
+
+            -- 5.10. 5.10.2.
+            case KM.lookup (show KeywordDirection) contextDefinition' of
+                -- 5.10.1.
+                Just _ | JLD1_0 <- jldExpansionEnvProcessingMode -> throwError <| Left InvalidContextEntry
+                -- 5.10.3.
+                Just Null -> bacModifyActiveContext \ac -> ac{activeContextDefaultBaseDirection = Nothing}
+                --
+                Just (String (T.toLower -> "ltr")) -> bacModifyActiveContext \ac -> ac{activeContextDefaultBaseDirection = Just LTR}
+                Just (String (T.toLower -> "rtl")) -> bacModifyActiveContext \ac -> ac{activeContextDefaultBaseDirection = Just RTL}
+                Just _ -> throwError <| Left InvalidBaseDirection
+                --
+                Nothing -> pure ()
+
+            -- 5.11.
+            case KM.lookup (show KeywordPropagate) contextDefinition' of
+                -- 5.11.1.
+                Just _ | JLD1_0 <- jldExpansionEnvProcessingMode -> throwError <| Left InvalidContextEntry
+                Just (Bool _) -> pure ()
+                Just invalid -> throwError <. Left <| InvalidKeywordValue KeywordPropagate invalid
+                --
+                Nothing -> pure ()
+
+            -- 5.13.
+            KM.keys contextDefinition'
+                |> fmap K.toText
+                .> filter
+                    ( `isNotKeyword`
+                        [ KeywordBase
+                        , KeywordDirection
+                        , KeywordImport
+                        , KeywordLanguage
+                        , KeywordPropagate
+                        , KeywordProtected
+                        , KeywordVersion
+                        , KeywordVocab
+                        ]
+                    )
+                .> mapM_ (bacBuildTermDefinition contextDefinition' baseUrl)
+        -- 5.3.
+        _ -> throwError <| Left InvalidLocalContext
+
+bacFetchRemoteContext :: Monad m => Text -> Maybe URI -> BACT e m ()
+bacFetchRemoteContext url maybeBaseUrl
+    | Just uri <- parseUri url
+    , Just contextUri <- relativeTo uri =<< maybeBaseUrl -- 5.2.1.
+    , isPathAbsolute contextUri
+    , contextKey <- U.render contextUri = do
+        BACEnv{..} <- ask
+        let JLDExpansionEnv{..} = hoistEnv (lift .> lift .> lift) bacEnvGlobal
+
+        remoteContexts <- gets bacStateRemoteContexts
+
+        -- 5.2.2.
+        when (not bacEnvValidateScopedContext && S.member contextKey remoteContexts) <| throwError (Right ())
+
+        -- 5.2.3.
+        when (S.size remoteContexts > jldExpansionEnvMaxRemoteContexts) <| throwError (Left ContextOverflow)
+
+        bacModifyRemoteContexts <| S.insert contextKey
+
+        -- 5.2.4.
+        gets (bacStateGlobal .> jldExpansionStateContextCache .> M.lookup contextKey) >>= \case
+            Just cachedContext -> do
+                bacBuildActiveContext cachedContext contextUri
+                throwError <| Right ()
+            --
+            Nothing -> pure ()
+
+        -- 5.2.5.
+        document <-
+            gets (bacStateGlobal .> jldExpansionStateDocumentCache .> M.lookup contextKey) >>= \case
+                Just document -> pure document
+                Nothing ->
+                    runDocumentLoader jldExpansionEnvDocumentLoader contextUri >>= \case
+                        Right (Object document) -> pure <| Document contextUri document
+                        -- 5.2.5.2.
+                        Right _ -> throwError <| Left InvalidRemoteContext
+                        -- 5.2.5.1.
+                        Left err -> throwError <. Left <| DocumentLoaderError err
+
+        -- 5.2.5.3.
+        importedContext <- case KM.lookup (show KeywordContext) (documentContent document) of
+            Just (Object context) -> pure <. Object <. KM.delete (show KeywordBase) <| context
+            Just context -> pure context
+            Nothing -> throwError <| Left InvalidRemoteContext
+
+        bacModifyDocumentCache <| M.insert contextKey document
+
+        -- 5.2.6.
+        bacBuildActiveContext importedContext (documentUri document)
+        bacModifyContextCache <| M.insert contextKey importedContext
+    | otherwise = throwError <| Left LoadingRemoteContextError
+
+buildActiveContext' :: Monad m => Value -> Maybe URI -> BACT e m ()
+buildActiveContext' localContext baseUrl = do
+    activeContext <- gets bacStateActiveContext
+
+    -- 1.
+    bacModifyActiveContext \ac -> ac{activeContextInverseContext = mempty}
+
+    -- 2.
+    propagate <- case localContext of
+        Object ctx | Just prop <- KM.lookup (show KeywordPropagate) ctx -> case prop of
+            Bool p -> pure p
+            _ -> throwError <. Left <| InvalidKeywordValue KeywordPropagate prop
+        _ -> asks bacEnvPropagate
+
+    -- 3.
+    previousContext <- gets <| activeContextPreviousContext <. bacStateActiveContext
+    when (not propagate && isNothing previousContext) do
+        bacModifyActiveContext \ac -> ac{activeContextPreviousContext = Just activeContext}
+
+    -- 4. 5.
+    forM_ (valueToArray localContext)
+        <| bacProcessItem baseUrl
+        .> withEnvRES (\env -> env{bacEnvPropagate = propagate})
+        .> withErrorRES' (either (Left .> throwError) pure)
+
+buildActiveContext :: Monad m => ActiveContext -> Value -> Maybe URI -> (BACParams -> BACParams) -> JLDExpansionT e m ActiveContext
+buildActiveContext activeContext localContext baseUrl paramsFn = do
+    BACState{..} <-
+        (buildActiveContext' localContext baseUrl >> get)
+            |> withEnvRES env
+            |> withErrorRES' (either throwError (const get))
+            |> withStateRES st (const bacStateGlobal)
+    pure bacStateActiveContext
+  where
+    BACParams{..} =
+        paramsFn
+            BACParams
+                { bacParamsOverrideProtected = False
+                , bacParamsPropagate = True
+                , bacParamsValidateScopedContext = True
+                , bacParamsRemoteContexts = mempty
+                }
+
+    env options =
+        BACEnv
+            { bacEnvGlobal = options
+            , bacEnvOverrideProtected = bacParamsOverrideProtected
+            , bacEnvValidateScopedContext = bacParamsValidateScopedContext
+            , bacEnvPropagate = bacParamsPropagate
+            }
+
+    st global =
+        BACState
+            { bacStateGlobal = global
+            , bacStateActiveContext = activeContext
+            , bacStateRemoteContexts = bacParamsRemoteContexts
+            }
+
+--
+
+type EIT e m = REST (EIEnv e m) (JLDError e) EIState m
+
+data EIEnv e m = EIEnv
+    { eiEnvGlobal :: JLDExpansionEnv e m
+    , eiEnvDocumentRelative :: Bool
+    , eiEnvVocab :: Bool
+    , eiEnvLocalContext :: Maybe Object
+    }
+    deriving (Show)
+
+data EIState = EIState
+    { eiStateGlobal :: JLDExpansionState
+    , eiStateDefined :: Map Text Bool
+    , eiStateActiveContext :: ActiveContext
+    }
+    deriving (Show, Eq)
+
+data EIParams = EIParams
+    { eiParamsDocumentRelative :: Bool
+    , eiParamsVocab :: Bool
+    , eiParamsLocalContext :: Maybe Object
+    , eiParamsDefined :: Map Text Bool
+    }
+    deriving (Show, Eq)
+
+eiBuildTermDefinition :: Monad m => Text -> EIT e m ()
+eiBuildTermDefinition value = do
+    EIEnv{..} <- ask
+    defined <- gets eiStateDefined
+    activeContext <- gets eiStateActiveContext
+    let params p = p{btdParamsDefined = defined}
+        localContext = fromMaybe mempty eiEnvLocalContext
+    (activeContext', defined') <-
+        buildTermDefinition activeContext localContext value params
+            |> withEnvRES (const eiEnvGlobal)
+            |> withStateRES eiStateGlobal (\ei global -> ei{eiStateGlobal = global})
+    modify \s ->
+        s
+            { eiStateActiveContext = activeContext'
+            , eiStateDefined = defined'
+            }
+
+eiInitLocalContext :: Monad m => Text -> EIT e m ()
+eiInitLocalContext value =
+    -- 3.
+    asks eiEnvLocalContext >>= \case
+        Just localContext | Just (String entry) <- KM.lookup (K.fromText value) localContext -> do
+            defined <- gets eiStateDefined
+            when (maybe True not (M.lookup entry defined)) <| eiBuildTermDefinition value
+        _ -> pure ()
+
+eiInitPropertyContext :: Monad m => Text -> Text -> Text -> EIT e m Text
+eiInitPropertyContext prefix suffix value = do
+    -- 6.3.
+    defined <- gets eiStateDefined
+    asks eiEnvLocalContext >>= \case
+        Just localContext
+            | KM.member (K.fromText prefix) localContext
+            , M.lookup prefix defined /= Just True ->
+                eiBuildTermDefinition prefix
+        _ -> pure ()
+
+    -- 6.4.
+    gets (eiStateActiveContext .> lookupTerm prefix) >>= \case
+        Just prefixDefiniton
+            | Just iriMapping <- termDefinitionIriMapping prefixDefiniton
+            , termDefinitionPrefixFlag prefixDefiniton ->
+                pure <| iriMapping <> suffix
+        _ -> pure value
+
+eiExpandResult :: Monad m => Text -> EIT e m (Maybe Text)
+eiExpandResult value = do
+    EIEnv{..} <- ask
+    activeContext <- gets eiStateActiveContext
+    case activeContextVocabularyMapping activeContext of
+        -- 7.
+        Just vocabMapping | eiEnvVocab -> pure <. Just <| vocabMapping <> value
+        -- 8.
+        _
+            | eiEnvDocumentRelative
+            , baseIri <- serializeIRI <$> activeContextBaseIri activeContext
+            , Right iri <- maybe (Right value) (`resolveIRI` value) baseIri ->
+                pure <| Just iri
+        -- 9.
+        _ -> pure <| Just value
+
+expandIri' :: Monad m => Text -> EIT e m (Maybe Text)
+expandIri' value
+    -- 1.
+    | Just _ <- parseKeyword value = pure <| Just value
+    -- 2.
+    | isKeywordLike value = pure Nothing
+    --
+    | otherwise = do
+        EIEnv{..} <- ask
+
+        -- 3.
+        eiInitLocalContext value
+
+        gets (eiStateActiveContext .> lookupTerm value) >>= \case
+            -- 4. 5.
+            Just definition
+                | Just iriMapping <- termDefinitionIriMapping definition
+                , Just _ <- parseKeyword iriMapping ->
+                    pure <| Just iriMapping
+                | eiEnvVocab ->
+                    pure <| termDefinitionIriMapping definition
+            -- 6. 6.1.
+            _
+                | Just idx <- (+ 1) <$> T.findIndex (== ':') (T.drop 1 value)
+                , prefix <- T.take idx value
+                , suffix <- T.drop (idx + 1) value ->
+                    -- 6.2.
+                    if "_" `T.isPrefixOf` prefix || "//" `T.isPrefixOf` suffix
+                        then pure <| Just value
+                        else do
+                            value' <- eiInitPropertyContext prefix suffix value
+
+                            if isBlankIri value' || isRight (validateIRI value')
+                                then pure <| Just value'
+                                else eiExpandResult value'
+            --
+            _ -> eiExpandResult value
+
+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,))
+            |> withEnvRES env
+            |> withStateRES st (const eiStateGlobal)
+    pure (value', eiStateActiveContext, eiStateDefined)
+  where
+    EIParams{..} =
+        paramsFn
+            EIParams
+                { eiParamsDocumentRelative = False
+                , eiParamsVocab = False
+                , eiParamsLocalContext = Nothing
+                , eiParamsDefined = mempty
+                }
+
+    env options =
+        EIEnv
+            { eiEnvGlobal = options
+            , eiEnvDocumentRelative = eiParamsDocumentRelative
+            , eiEnvVocab = eiParamsVocab
+            , eiEnvLocalContext = eiParamsLocalContext
+            }
+
+    st global =
+        EIState
+            { eiStateGlobal = global
+            , eiStateDefined = eiParamsDefined
+            , eiStateActiveContext = activeContext
+            }
+
+--
+
+type BTDT e m = REST (BTDEnv e m) (Either (JLDError e) ()) BTDState m
+
+data BTDEnv e m = BTDEnv
+    { btdEnvGlobal :: JLDExpansionEnv e m
+    , btdEnvLocalContext :: Object
+    , btdEnvBaseUrl :: Maybe URI
+    , btdEnvProtectedFlag :: Bool
+    , btdEnvOverrideProtectedFlag :: Bool
+    , btdEnvRemoteContexts :: Set Text
+    }
+    deriving (Show)
+
+data BTDState = BTDState
+    { btdStateGlobal :: JLDExpansionState
+    , btdStateDefined :: Map Text Bool
+    , btdStateTermDefinition :: TermDefinition
+    , btdStateActiveContext :: ActiveContext
+    }
+    deriving (Show, Eq)
+
+data BTDParams = BTDParams
+    { btdParamsBaseUrl :: Maybe URI
+    , btdParamsProtectedFlag :: Bool
+    , btdParamsOverrideProtectedFlag :: Bool
+    , btdParamsRemoteContexts :: Set Text
+    , btdParamsDefined :: Map Text Bool
+    , btdParamsTermDefinition :: TermDefinition
+    }
+    deriving (Show, Eq)
+
+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 fn = modify \s -> s{btdStateTermDefinition = fn (btdStateTermDefinition s)}
+
+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
+btdValidateContainer _ Null = False
+btdValidateContainer JLDExpansionEnv{..} value
+    | JLD1_0 <- jldExpansionEnvProcessingMode = case value of
+        String value' -> isNotKeyword value' [KeywordGraph, KeywordId, KeywordType]
+        _ -> False
+    | otherwise = case flattenSingletonArray value of
+        String container' ->
+            isKeyword
+                container'
+                [ KeywordGraph
+                , KeywordId
+                , KeywordIndex
+                , KeywordLanguage
+                , KeywordList
+                , KeywordSet
+                , KeywordType
+                ]
+        container@(Array (V.length -> len))
+            | len > 3 ->
+                False
+            | valueContains (show KeywordGraph) container
+            , valueContainsAny (show <$> [KeywordId, KeywordIndex]) container ->
+                len == 2 || valueContains (show KeywordSet) container
+            | len == 2
+            , valueContains (show KeywordSet) container
+            , valueContainsAny (show <$> [KeywordGraph, KeywordId, KeywordIndex, KeywordLanguage, KeywordType]) container ->
+                True
+        _ -> False
+
+btdExpandIri :: Monad m => Text -> BTDT e m (Maybe Text)
+btdExpandIri value = do
+    BTDEnv{..} <- ask
+    defined <- gets btdStateDefined
+    activeContext <- gets btdStateActiveContext
+    let params p =
+            p
+                { eiParamsLocalContext = Just btdEnvLocalContext
+                , eiParamsVocab = True
+                , eiParamsDefined = defined
+                }
+    (expanded, activeContext', defined') <-
+        expandIri activeContext value params
+            |> withEnvRES (const btdEnvGlobal)
+            |> withErrorRES Left
+            |> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
+    modify \s ->
+        s
+            { btdStateActiveContext = activeContext'
+            , btdStateDefined = defined'
+            }
+    pure expanded
+
+btdBuildTermDefinition :: Monad m => Text -> BTDT e m ()
+btdBuildTermDefinition term = do
+    BTDEnv{..} <- ask
+    defined <- gets btdStateDefined
+    activeContext <- gets btdStateActiveContext
+    let params p = p{btdParamsDefined = defined}
+    (activeContext', defined') <-
+        buildTermDefinition activeContext btdEnvLocalContext term params
+            |> withEnvRES (const btdEnvGlobal)
+            |> withErrorRES Left
+            |> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
+    modify \env ->
+        env
+            { btdStateActiveContext = activeContext'
+            , btdStateDefined = defined'
+            }
+
+buildTermDefinition' :: Monad m => Text -> BTDT e m ()
+buildTermDefinition' "" = throwError <| Left InvalidTermDefinition -- 2.
+buildTermDefinition' term = do
+    BTDEnv{..} <- ask
+    let JLDExpansionEnv{..} = btdEnvGlobal
+
+    -- 1.
+    gets (btdStateDefined .> M.lookup term) >>= \case
+        Just True -> throwError <| Right ()
+        Just False -> throwError <| Left CyclicIriMapping
+        Nothing -> pure ()
+
+    -- 2.
+    btdModifyDefined <| M.insert term False
+
+    -- 3.
+    let value = btdEnvLocalContext |> KM.lookup (K.fromText term) .> fromMaybe Null
+
+    -- 4.
+    case term of
+        ((`isKeyword` [KeywordType]) -> True)
+            | 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 ()
+            | otherwise -> throwError <| Left KeywordRedefinition
+        -- 5.
+        (parseKeyword -> Just _) -> throwError <| Left KeywordRedefinition
+        (isKeywordLike -> True) -> throwError <| Right ()
+        _ -> pure ()
+
+    -- 6.
+    maybePreviousDefinition <- gets (btdStateActiveContext .> lookupTerm term)
+    btdModifyActiveContext \ac -> ac{activeContextTerms = M.delete term (activeContextTerms ac)}
+
+    -- 7. 8. 9.
+    (valueObject, idValue, simpleTerm) <- case value of
+        Null -> pure (mempty, Just Null, False)
+        (String s) -> pure (mempty, Just (String s), True)
+        (Object o) -> pure (o, KM.lookup (show KeywordId) o, False)
+        _ -> throwError <| Left InvalidTermDefinition
+
+    -- 10.
+    btdModifyTermDefinition <| const (newTermDefinition btdEnvProtectedFlag id)
+
+    -- 11.
+    case KM.lookup (show KeywordProtected) valueObject of
+        Just _ | JLD1_0 <- jldExpansionEnvProcessingMode -> throwError <| Left InvalidTermDefinition
+        Just (Bool protected) -> btdModifyTermDefinition \d -> d{termDefinitionProtectedFlag = protected}
+        Just invalid -> throwError <. Left <| InvalidKeywordValue KeywordProtected invalid
+        Nothing -> pure ()
+
+    -- 12.
+    case KM.lookup (show KeywordType) valueObject of
+        -- 12.2.
+        Just (String type') ->
+            btdExpandIri type' >>= \case
+                Nothing -> throwError <| Left InvalidTypeMapping
+                Just expandedType
+                    -- 12.3.
+                    | isKeyword expandedType [KeywordJson, KeywordNone]
+                    , JLD1_0 <- jldExpansionEnvProcessingMode ->
+                        throwError <| Left InvalidTypeMapping
+                    -- 12.4.
+                    | isNotKeyword expandedType [KeywordId, KeywordJson, KeywordNone, KeywordVocab]
+                    , Left _ <- validateIRI expandedType ->
+                        throwError <| Left InvalidTypeMapping
+                    -- 12.5.
+                    | otherwise ->
+                        btdModifyTermDefinition \d -> d{termDefinitionTypeMapping = Just expandedType}
+        -- 12.1.
+        Just _ -> throwError <| Left InvalidTypeMapping
+        --
+        Nothing -> pure ()
+
+    -- 13.
+    case KM.lookup (show KeywordReverse) valueObject of
+        -- 13.1.
+        Just _ | KM.member (show KeywordId) valueObject || KM.member (show KeywordNest) valueObject -> throwError <| Left InvalidReverseProperty
+        Just (String (isKeywordLike -> True)) -> throwError <| Right ()
+        -- 13.3.
+        Just (String reverse') -> do
+            -- 13.4.
+            btdExpandIri reverse' >>= \case
+                Just (validateIRI -> Right expandedReverse) ->
+                    btdModifyTermDefinition \d -> d{termDefinitionIriMapping = Just expandedReverse}
+                _ -> throwError <| Left InvalidIriMapping
+
+            -- 13.5.
+            case KM.lookup (show KeywordContainer) valueObject of
+                Just (String container) | isKeyword container [KeywordSet, KeywordIndex] -> do
+                    btdModifyTermDefinition \d ->
+                        d
+                            { termDefinitionContainerMapping = S.insert container <| termDefinitionContainerMapping d
+                            }
+                Just Null -> pure ()
+                Just _ -> throwError <| Left InvalidReverseProperty
+                Nothing -> pure ()
+
+            -- 13.6.
+            btdModifyTermDefinition \d -> d{termDefinitionReversePropertyFlag = True}
+
+            -- 13.7.
+            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.
+            | Just idValue' <- idValue
+            , idValue' /= String term -> case idValue' of
+                Null -> pure ()
+                String id'
+                    -- 14.2.2.
+                    | isNothing (parseKeyword id') && isKeywordLike id' -> throwError <| Right ()
+                    | otherwise -> do
+                        -- 14.2.3.
+                        iriMapping <-
+                            btdExpandIri id' >>= \case
+                                Nothing -> throwError <| Left InvalidIriMapping
+                                Just expandedId
+                                    | isKeyword expandedId [KeywordContext] ->
+                                        throwError <| Left InvalidKeywordAlias
+                                    | Nothing <- parseKeyword expandedId
+                                    , Left _ <- validateIRI expandedId
+                                    , isBlankIri expandedId ->
+                                        throwError <| Left InvalidIriMapping
+                                    | otherwise ->
+                                        expandedId <$ btdModifyTermDefinition \d -> d{termDefinitionIriMapping = Just expandedId}
+
+                        -- 14.2.4.
+                        when (T.elem ':' (T.dropEnd 1 <. T.drop 1 <| term) || T.elem '/' term) do
+                            -- 14.2.4.1
+                            btdModifyDefined <| M.insert term True
+
+                            -- 14.2.4.2.
+                            expandedTerm <- btdExpandIri term
+                            when (expandedTerm /= Just iriMapping) <| throwError (Left InvalidIriMapping)
+
+                        -- 14.2.5.
+                        definition <- gets btdStateTermDefinition
+                        when (not <| termDefinitionPrefixFlag definition) do
+                            let validIri = isRight <. validateIRI <. T.dropEnd 1 <| iriMapping
+                            let prefix =
+                                    not (T.elem ':' term || T.elem '/' term)
+                                        && simpleTerm
+                                        && ((endsWithGenericDelim iriMapping && validIri) || isBlankIri iriMapping)
+                            btdModifyTermDefinition \d -> d{termDefinitionPrefixFlag = prefix}
+                -- 14.2.1.
+                _ -> throwError <| Left InvalidIriMapping
+            -- 15.
+            | T.elem ':' (T.drop 1 term) -> do
+                let maybeCompactIri = parseCompactIri term
+
+                -- 15.1.
+                case maybeCompactIri of
+                    Just (CompactIRI prefix _) | KM.member (K.fromText prefix) btdEnvLocalContext -> do
+                        btdBuildTermDefinition prefix
+                    _ -> pure ()
+
+                -- 15.2.
+                activeContextTerms <- gets (btdStateActiveContext .> activeContextTerms)
+                case maybeCompactIri of
+                    Just (CompactIRI prefix suffix)
+                        | Just term' <- M.lookup prefix activeContextTerms
+                        , iriMapping <- (<> suffix) <$> termDefinitionIriMapping term' ->
+                            btdModifyTermDefinition \d -> d{termDefinitionIriMapping = iriMapping}
+                    -- 15.3.
+                    _
+                        | isRight (validateIRI term) || isBlankIri term ->
+                            btdModifyTermDefinition \d -> d{termDefinitionIriMapping = Just term}
+                    _ -> pure ()
+            -- 16.
+            | T.elem '/' term ->
+                btdExpandIri term >>= \case
+                    Just expandedTerm -> btdModifyTermDefinition \d -> d{termDefinitionIriMapping = Just expandedTerm}
+                    Nothing -> throwError <| Left InvalidIriMapping
+            -- 17.
+            | isKeyword term [KeywordType] -> btdModifyTermDefinition \d -> d{termDefinitionIriMapping = Just term}
+            -- 18.
+            | Just vocabMapping <- maybeVocabMapping -> btdModifyTermDefinition \d -> d{termDefinitionIriMapping = Just (vocabMapping <> term)}
+            --
+            | otherwise -> throwError <| Left InvalidIriMapping
+
+    -- 19.
+    case KM.lookup (show KeywordContainer) valueObject of
+        Just container -> do
+            when (not <| btdValidateContainer btdEnvGlobal container) <| throwError (Left InvalidContainerMapping)
+
+            forM_ (valueToArray container) \case
+                String item -> btdModifyTermDefinition \d -> d{termDefinitionContainerMapping = termDefinitionContainerMapping d |> S.insert item}
+                _ -> pure ()
+
+            definition <- gets btdStateTermDefinition
+            when (S.member (show KeywordType) <| termDefinitionContainerMapping definition) do
+                let typeMapping = termDefinitionTypeMapping definition |> fromMaybe (show KeywordId)
+                btdModifyTermDefinition \d -> d{termDefinitionTypeMapping = Just typeMapping}
+                when (isNotKeyword typeMapping [KeywordId, KeywordVocab]) do
+                    throwError <| Left InvalidTypeMapping
+        --
+        Nothing -> pure ()
+
+    -- 20.
+    containerMapping <- gets (btdStateTermDefinition .> termDefinitionContainerMapping)
+    case KM.lookup (show KeywordIndex) valueObject of
+        -- 20.1.
+        Just _ | jldExpansionEnvProcessingMode == JLD1_0 || S.notMember (show KeywordIndex) containerMapping -> throwError <| Left InvalidTermDefinition
+        -- 20.2.
+        Just (String index) ->
+            btdExpandIri index >>= \case
+                Just (validateIRI -> Right _) -> btdModifyTermDefinition \d -> d{termDefinitionIndexMapping = Just index}
+                _ -> throwError <| Left InvalidTermDefinition
+        Just _ -> throwError <| Left InvalidTermDefinition
+        --
+        Nothing -> pure ()
+
+    -- 21.
+    case KM.lookup (show KeywordContext) valueObject of
+        -- 21.1.
+        Just _ | JLD1_0 <- jldExpansionEnvProcessingMode -> throwError <| Left InvalidTermDefinition
+        -- 21.2.
+        Just context -> do
+            -- 21.3.
+            activeContext <- gets btdStateActiveContext
+            let params p =
+                    p
+                        { bacParamsOverrideProtected = True
+                        , bacParamsRemoteContexts = btdEnvRemoteContexts
+                        , bacParamsValidateScopedContext = False
+                        }
+            buildActiveContext activeContext context btdEnvBaseUrl params
+                |> withEnvRES (const btdEnvGlobal)
+                |> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
+                |> withErrorRES (const <| Left InvalidScopedContext)
+                |> void
+
+            -- 21.4.
+            btdModifyTermDefinition \d ->
+                d
+                    { termDefinitionLocalContext = Just context
+                    , termDefinitionBaseUrl = btdEnvBaseUrl
+                    }
+        --
+        Nothing -> pure ()
+
+    -- 22. 23.
+    unless (KM.member (show KeywordType) valueObject) do
+        -- 22.
+        case KM.lookup (show KeywordLanguage) valueObject of
+            Just Null -> btdModifyTermDefinition \d -> d{termDefinitionLanguageMapping = Just NoLanguage}
+            Just (String language) -> btdModifyTermDefinition \d -> d{termDefinitionLanguageMapping = Just <| Language language}
+            Just _ -> throwError <| Left InvalidLanguageMapping
+            Nothing -> pure ()
+
+        -- 23.
+        case KM.lookup (show KeywordDirection) valueObject of
+            Just Null -> btdModifyTermDefinition \d -> d{termDefinitionDirectionMapping = Just NoDirection}
+            Just (String "ltr") -> btdModifyTermDefinition \d -> d{termDefinitionDirectionMapping = Just LTR}
+            Just (String "rtl") -> btdModifyTermDefinition \d -> d{termDefinitionDirectionMapping = Just RTL}
+            Just _ -> throwError <| Left InvalidBaseDirection
+            Nothing -> pure ()
+
+    -- 24.
+    case KM.lookup (show KeywordNest) valueObject of
+        -- 24.1.
+        Just _ | JLD1_0 <- jldExpansionEnvProcessingMode -> throwError <| Left InvalidTermDefinition
+        Just (String nest)
+            | parseKeyword nest /= Just KeywordNest -> throwError <. Left <| InvalidKeywordValue KeywordNest (String nest)
+            | otherwise -> btdModifyTermDefinition \d -> d{termDefinitionNestValue = Just nest}
+        Just invalid -> throwError <. Left <| InvalidKeywordValue KeywordNest invalid
+        Nothing -> pure ()
+
+    -- 25.
+    maybeIriMapping <- gets (btdStateTermDefinition .> termDefinitionIriMapping)
+    case KM.lookup (show KeywordPrefix) valueObject of
+        -- 25.1.
+        Just _
+            | jldExpansionEnvProcessingMode == JLD1_0 || T.elem ':' term || T.elem '/' term ->
+                throwError <| Left InvalidTermDefinition
+        Just (Bool prefix)
+            | prefix, Just _ <- parseKeyword =<< maybeIriMapping -> throwError <| Left InvalidTermDefinition
+            | otherwise -> btdModifyTermDefinition \d -> d{termDefinitionPrefixFlag = prefix}
+        Just invalid -> throwError <. Left <| InvalidKeywordValue KeywordPrefix invalid
+        Nothing -> pure ()
+
+    -- 26.
+    unless
+        ( allKeywords
+            (KM.keys valueObject <&> K.toText)
+            [ KeywordId
+            , KeywordReverse
+            , KeywordContainer
+            , KeywordContext
+            , KeywordDirection
+            , KeywordIndex
+            , KeywordLanguage
+            , KeywordNest
+            , KeywordPrefix
+            , KeywordProtected
+            , KeywordType
+            ]
+        )
+        do throwError <| Left InvalidTermDefinition
+
+    -- 27.
+    definition <- gets btdStateTermDefinition
+
+    case maybePreviousDefinition of
+        Just previousDefinition | not btdEnvOverrideProtectedFlag && termDefinitionProtectedFlag previousDefinition -> do
+            -- 27.1.
+            when (definition{termDefinitionProtectedFlag = True} /= previousDefinition) do
+                throwError <| Left ProtectedTermRedefinition
+
+            -- 27.2.
+            btdModifyActiveContext \ac -> ac{activeContextTerms = activeContextTerms ac |> M.insert term previousDefinition}
+        --
+        _ ->
+            btdModifyActiveContext \ac -> ac{activeContextTerms = activeContextTerms ac |> M.insert term definition}
+
+    btdModifyDefined <| M.insert term True
+
+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)
+            |> withEnvRES env
+            |> withErrorRES' (either throwError (const get))
+            |> withStateRES st (const btdStateGlobal)
+    pure (btdStateActiveContext, btdStateDefined)
+  where
+    BTDParams{..} =
+        paramsFn
+            BTDParams
+                { btdParamsBaseUrl = Nothing
+                , btdParamsProtectedFlag = False
+                , btdParamsOverrideProtectedFlag = False
+                , btdParamsRemoteContexts = mempty
+                , btdParamsDefined = mempty
+                , btdParamsTermDefinition = newTermDefinition False id
+                }
+
+    env options =
+        BTDEnv
+            { btdEnvGlobal = options
+            , btdEnvLocalContext = localContext
+            , btdEnvBaseUrl = btdParamsBaseUrl
+            , btdEnvProtectedFlag = btdParamsProtectedFlag
+            , btdEnvOverrideProtectedFlag = btdParamsOverrideProtectedFlag
+            , btdEnvRemoteContexts = btdParamsRemoteContexts
+            }
+
+    st global =
+        BTDState
+            { btdStateGlobal = global
+            , btdStateDefined = btdParamsDefined
+            , btdStateTermDefinition = btdParamsTermDefinition
+            , btdStateActiveContext = activeContext
+            }
diff --git a/src/Data/JLD/Expansion/Global.hs b/src/Data/JLD/Expansion/Global.hs
new file mode 100644
index 0000000..b92b4af
--- /dev/null
+++ b/src/Data/JLD/Expansion/Global.hs
@@ -0,0 +1,38 @@
+module Data.JLD.Expansion.Global (
+    JLDExpansionT,
+    JLDExpansionEnv (..),
+    JLDExpansionState (..),
+    hoistEnv,
+    modifyContextCache,
+    modifyDocumentCache,
+) where
+
+import Data.JLD.Prelude
+
+import Data.JLD.Control.Monad.RES (REST)
+import Data.JLD.Error (JLDError)
+import Data.JLD.Options (ContextCache, DocumentCache, DocumentLoader (..), JLDVersion (..), hoistDocumentLoader)
+
+type JLDExpansionT e m = REST (JLDExpansionEnv e m) (JLDError e) JLDExpansionState m
+
+data JLDExpansionEnv e m = JLDExpansionEnv
+    { jldExpansionEnvDocumentLoader :: DocumentLoader e m
+    , jldExpansionEnvProcessingMode :: JLDVersion
+    , jldExpansionEnvMaxRemoteContexts :: Int
+    }
+    deriving (Show)
+
+data JLDExpansionState = JLDExpansionState
+    { jldExpansionStateContextCache :: ContextCache
+    , jldExpansionStateDocumentCache :: DocumentCache
+    }
+    deriving (Show, Eq)
+
+hoistEnv :: (forall a. m a -> n a) -> JLDExpansionEnv e m -> JLDExpansionEnv e n
+hoistEnv map' options = options{jldExpansionEnvDocumentLoader = options |> jldExpansionEnvDocumentLoader .> hoistDocumentLoader map'}
+
+modifyContextCache :: MonadState JLDExpansionState m => (ContextCache -> ContextCache) -> m ()
+modifyContextCache fn = modify \s -> s{jldExpansionStateContextCache = fn (jldExpansionStateContextCache s)}
+
+modifyDocumentCache :: MonadState JLDExpansionState m => (DocumentCache -> DocumentCache) -> m ()
+modifyDocumentCache fn = modify \s -> s{jldExpansionStateDocumentCache = fn (jldExpansionStateDocumentCache s)}