WIP: Compaction

12 files changed, 477 insertions, 59 deletions

diff --git a/jsonld.cabal b/jsonld.cabal
index 376a647..a0c0c25 100644
--- a/jsonld.cabal
+++ b/jsonld.cabal
@@ -24,6 +24,9 @@ source-repository head
 library
   exposed-modules:
       Data.JLD
+      Data.JLD.Compaction.Global
+      Data.JLD.Compaction.InverseContext
+      Data.JLD.Compaction.IRI
       Data.JLD.Control.Monad.RES
       Data.JLD.Error
       Data.JLD.Expansion
diff --git a/src/Data/JLD.hs b/src/Data/JLD.hs
index a7042dc..40abae1 100644
--- a/src/Data/JLD.hs
+++ b/src/Data/JLD.hs
@@ -26,8 +26,7 @@ import Data.JLD.Options
 import Data.JLD.Util (flattenSingletonArray, valueToArray)
 
 import Data.Aeson (Value (..))
-import Data.Aeson.KeyMap qualified as KM
-import Data.Vector qualified as V (singleton)
+import Data.Aeson.KeyMap qualified as KM (lookup, size)
 import Text.URI (URI)
 
 data JLDExpansionParams e m = JLDExpansionParams
@@ -72,7 +71,7 @@ expand document baseUrl paramsFn = do
             jldExpansionParamsExpandContext <&> flattenSingletonArray .> \case
                 Array expandedContext -> Array expandedContext
                 (Object expandedContext) | Just ctx <- KM.lookup (show KeywordContext) expandedContext -> ctx
-                expandedContext -> Array <| V.singleton expandedContext
+                expandedContext -> Array <| pure expandedContext
 
     activeContext' <- case maybeExpandContext of
         Just expandContext ->
diff --git a/src/Data/JLD/Compaction/Global.hs b/src/Data/JLD/Compaction/Global.hs
new file mode 100644
index 0000000..76b2db7
--- /dev/null
+++ b/src/Data/JLD/Compaction/Global.hs
@@ -0,0 +1,13 @@
+module Data.JLD.Compaction.Global (JLDCompactionT, JLDCompactionEnv (..)) where
+
+import Data.JLD.Prelude
+
+import Data.JLD.Error (JLDError)
+import Data.JLD.Options (JLDVersion (..))
+
+type JLDCompactionT e m = ReaderT JLDCompactionEnv (ExceptT (JLDError e) m)
+
+newtype JLDCompactionEnv = JLDCompactionEnv
+    { jldCompactionEnvProcessingMode :: JLDVersion
+    }
+    deriving (Show)
diff --git a/src/Data/JLD/Compaction/IRI.hs b/src/Data/JLD/Compaction/IRI.hs
new file mode 100644
index 0000000..34379d2
--- /dev/null
+++ b/src/Data/JLD/Compaction/IRI.hs
@@ -0,0 +1,342 @@
+module Data.JLD.Compaction.IRI (compactIri) where
+
+import Data.JLD.Prelude
+
+import Data.JLD (JLDError (InvalidKeywordValue), 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, runREST, withEnvRES, withStateRES)
+import Data.JLD.Model.ActiveContext (ActiveContext (..))
+import Data.JLD.Model.InverseContext (InverseContext)
+
+import Control.Monad.Except (MonadError (..))
+import Data.Aeson (Value (..))
+import Data.Aeson.KeyMap qualified as KM (lookup, member, size)
+import Data.JLD.Model.Direction (Direction (..))
+import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject, isNotGraphObject')
+import Data.JLD.Model.Keyword (Keyword (..))
+import Data.JLD.Model.Language (Language (..))
+import Data.JLD.Model.ListObject (isListObject')
+import Data.JLD.Model.ValueObject (isValueObject')
+import Data.JLD.Util (valueToArray)
+import Data.Set qualified as S
+import Data.Text (toLower)
+import Data.Text qualified as T (drop, findIndex, isPrefixOf, take)
+import Data.Vector (Vector, (!?))
+import Data.Vector qualified as V (cons, snoc)
+
+type CIT e m = REST CIEnv (JLDError e) CIState m
+
+data CIEnv = CIEnv
+    { ciEnvGlobal :: JLDCompactionEnv
+    , ciEnvActiveContext :: ActiveContext
+    , ciEnvValue :: Maybe Value
+    , ciEnvVocab :: Bool
+    , ciEnvReverse :: Bool
+    }
+    deriving (Show)
+
+data CIState = CIState
+    { ciStateContainers :: Set Text
+    , ciStateTypeLanguage :: Keyword
+    , ciStateTypeLanguageValue :: Text
+    , ciStatePreferredValues :: Vector Text
+    }
+    deriving (Show, Eq)
+
+data CIParams = CIParams
+    { ciParamsActiveContext :: ActiveContext
+    , ciParamsValue :: Maybe Value
+    , ciParamsVocab :: Bool
+    , ciParamsReverse :: Bool
+    }
+    deriving (Show, Eq)
+
+ciModifyContainers :: Monad m => (Set Text -> Set Text) -> CIT e m ()
+ciModifyContainers fn = modify \s -> s{ciStateContainers = fn (ciStateContainers s)}
+
+ciModifyPreferredValues :: Monad m => (Vector Text -> Vector Text) -> CIT e m ()
+ciModifyPreferredValues fn = modify \s -> s{ciStatePreferredValues = fn (ciStatePreferredValues s)}
+
+ciPutTypeLanguage :: Monad m => Keyword -> CIT e m ()
+ciPutTypeLanguage v = modify \s -> s{ciStateTypeLanguage = v}
+
+ciPutTypeLanguageValue :: Monad m => Text -> CIT e m ()
+ciPutTypeLanguageValue v = modify \s -> s{ciStateTypeLanguageValue = v}
+
+compactIri4 :: Monad m => InverseContext -> Text -> CIT e m (Maybe Text)
+compactIri4 inverseContext var = do
+    CIEnv{..} <- ask
+    let ActiveContext{..} = ciEnvActiveContext
+
+    -- 4.1.
+    let defaultLanguage = case (activeContextDefaultLanguage, activeContextDefaultBaseDirection) of
+            (Just (Language language), Just dir) -> language <> show dir
+            (Nothing, Just dir) -> "_" <> show dir
+            _ -> show KeywordNone
+
+        -- 4.2.
+        value = case ciEnvValue of
+            Just v@(Object o) -> case KM.lookup (show KeywordPreserve) o of
+                Just Null -> Just v
+                Just preserve -> valueToArray preserve !? 0
+                _ -> Just v
+            _ -> Nothing
+
+    -- 4.5.
+    case value of
+        Just (Object o)
+            | KM.member (show KeywordIndex) o && isNotGraphObject' o ->
+                ciModifyContainers
+                    <| S.insert (show KeywordIndex)
+                    .> S.insert (show KeywordIndex <> show KeywordSet)
+        _ -> pure ()
+
+    case value of
+        -- 4.6.
+        _ | ciEnvReverse -> do
+            ciPutTypeLanguage KeywordType
+            ciPutTypeLanguageValue <| show KeywordReverse
+        --
+        Just (Object o)
+            -- 4.7.
+            | isListObject' o
+            , Just (Array list) <- KM.lookup (show KeywordList) o -> do
+                -- 4.7.1.
+                unless (KM.member (show KeywordIndex) o) <| ciModifyContainers (S.insert (show KeywordList))
+
+                -- 4.7.4.
+                let go (commonType, commonLanguage) item
+                        -- 4.7.4.8.
+                        | commonLanguage == Just (show KeywordNone)
+                        , commonType == Just (show KeywordNone) =
+                            (commonType, commonLanguage)
+                        --
+                        | otherwise = (Just commonType', Just commonLanguage')
+                      where
+                        (itemLanguage, itemType) = case item of
+                            Object objectItem
+                                | KM.member (show KeywordValue) objectItem ->
+                                    if
+                                            -- 4.7.4.2.1.
+                                            | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem
+                                            , Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
+                                                (toLower lang <> "_" <> toLower dir, show KeywordId)
+                                            | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem ->
+                                                ("_" <> toLower dir, show KeywordId)
+                                            -- 4.7.4.2.2.
+                                            | Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
+                                                (toLower lang, show KeywordId)
+                                            -- 4.7.4.2.3.
+                                            | Just (String type') <- KM.lookup (show KeywordType) objectItem ->
+                                                (show KeywordNone, type')
+                                            -- 4.7.4.2.4.
+                                            | otherwise ->
+                                                (show KeywordNone, show KeywordId)
+                            -- 4.7.4.2.4.
+                            _ -> (show KeywordNone, show KeywordId)
+
+                        commonLanguage' = case commonLanguage of
+                            -- 4.7.4.4.
+                            Nothing -> itemLanguage
+                            -- 4.7.4.5.
+                            Just lang
+                                | itemLanguage /= lang
+                                , Object itemObject <- item
+                                , KM.member (show KeywordValue) itemObject ->
+                                    show KeywordNone
+                                | otherwise -> lang
+
+                        commonType' = case commonType of
+                            Nothing -> itemType
+                            Just it
+                                | itemType /= it -> show KeywordNone
+                                | otherwise -> it
+
+                    -- 4.7.3. 4.7.5. 4.7.6.
+                    (commonType'', commonLanguage'') =
+                        list
+                            |> foldl' go (Nothing, if null list then Just defaultLanguage else Nothing)
+                            .> bimap (fromMaybe (show KeywordNone)) (fromMaybe (show KeywordNone))
+
+                -- 4.7.7.
+                if commonType'' /= show KeywordNone
+                    then do
+                        ciPutTypeLanguage KeywordType
+                        ciPutTypeLanguageValue (show commonType'')
+                    else -- 4.7.8.
+                        ciPutTypeLanguageValue (show commonLanguage'')
+            -- 4.8.
+            | isGraphObject' o -> do
+                -- 4.8.1.
+                when (KM.member (show KeywordIndex) o) do
+                    ciModifyContainers
+                        <| S.insert (show KeywordGraph <> show KeywordIndex)
+                        .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet)
+                -- 4.8.2.
+                when (KM.member (show KeywordId) o) do
+                    ciModifyContainers
+                        <| S.insert (show KeywordGraph <> show KeywordId)
+                        .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet)
+                -- 4.8.3.
+                ciModifyContainers
+                    <| S.insert (show KeywordGraph)
+                    .> S.insert (show KeywordGraph <> show KeywordSet)
+                    .> S.insert (show KeywordSet)
+                -- 4.8.4.
+                unless (KM.member (show KeywordIndex) o) do
+                    ciModifyContainers
+                        <| S.insert (show KeywordGraph <> show KeywordIndex)
+                        .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet)
+                -- 4.8.5.
+                unless (KM.member (show KeywordId) o) do
+                    ciModifyContainers
+                        <| S.insert (show KeywordGraph <> show KeywordId)
+                        .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet)
+                -- 4.8.6.
+                ciModifyContainers
+                    <| S.insert (show KeywordIndex)
+                    .> S.insert (show KeywordIndex <> show KeywordSet)
+                -- 4.8.7.
+                ciPutTypeLanguage KeywordType
+                ciPutTypeLanguageValue (show KeywordId)
+            -- 4.9. 4.9.1.
+            | isValueObject' o -> do
+                if
+                        -- 4.9.1.1.
+                        | Just (String dir) <- KM.lookup (show KeywordDirection) o
+                        , Just (String lang) <- KM.lookup (show KeywordLanguage) o
+                        , not (KM.member (show KeywordIndex) o) -> do
+                            ciPutTypeLanguageValue (toLower lang <> "_" <> toLower dir)
+                            ciModifyContainers
+                                <| S.insert (show KeywordLanguage)
+                                .> S.insert (show KeywordLanguage <> show KeywordSet)
+                        | Just (String dir) <- KM.lookup (show KeywordDirection) o
+                        , not (KM.member (show KeywordIndex) o) -> do
+                            ciPutTypeLanguageValue ("_" <> toLower dir)
+                            ciModifyContainers
+                                <| S.insert (show KeywordLanguage)
+                                .> S.insert (show KeywordLanguage <> show KeywordSet)
+                        -- 4.9.1.2.
+                        | Just (String lang) <- KM.lookup (show KeywordLanguage) o
+                        , not (KM.member (show KeywordIndex) o) -> do
+                            ciPutTypeLanguageValue (toLower lang)
+                            ciModifyContainers
+                                <| S.insert (show KeywordLanguage)
+                                .> S.insert (show KeywordLanguage <> show KeywordSet)
+                        -- 4.9.1.3.
+                        | Just (String type') <- KM.lookup (show KeywordType) o -> do
+                            ciPutTypeLanguage KeywordType
+                            ciPutTypeLanguageValue type'
+                        --
+                        | otherwise -> pure ()
+                -- 4.9.3.
+                ciModifyContainers <| S.insert (show KeywordSet)
+        -- 4.9.2.
+        _ -> do
+            ciPutTypeLanguage KeywordType
+            ciPutTypeLanguageValue (show KeywordId)
+            -- 4.9.3.
+            ciModifyContainers
+                <| S.insert (show KeywordId)
+                .> S.insert (show KeywordId <> show KeywordSet)
+                .> S.insert (show KeywordType)
+                .> S.insert (show KeywordSet <> show KeywordType)
+                .> S.insert (show KeywordSet)
+
+    -- 4.10.
+    ciModifyContainers <| S.insert (show KeywordNone)
+
+    -- 4.11.
+    case value of
+        Just (Object o)
+            | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
+            , not (KM.member (show KeywordIndex) o) ->
+                ciModifyContainers
+                    <| S.insert (show KeywordIndex)
+                    .> S.insert (show KeywordIndex <> show KeywordSet)
+        _
+            | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0 ->
+                ciModifyContainers
+                    <| S.insert (show KeywordIndex)
+                    .> S.insert (show KeywordIndex <> show KeywordSet)
+            --
+            | otherwise -> pure ()
+
+    -- 4.12.
+    case value of
+        Just (Object o)
+            | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
+            , KM.member (show KeywordIndex) o
+            , KM.size o == 1 ->
+                ciModifyContainers
+                    <| S.insert (show KeywordLanguage)
+                    .> S.insert (show KeywordLanguage <> show KeywordSet)
+        --
+        _ -> pure ()
+
+    -- 4.15.
+    typeLanguageValue <- gets ciStateTypeLanguageValue
+    when (typeLanguageValue == show KeywordReverse) <| ciModifyPreferredValues (V.cons (show KeywordReverse))
+
+    -- 4.16.
+    case value of
+        Just (Object o)
+            | typeLanguageValue == show KeywordReverse || typeLanguageValue == show KeywordId
+            , Just idValue <- KM.lookup (show KeywordId) o -> case idValue of
+                String idValue' -> pure ()
+                _ -> throwError <| InvalidKeywordValue KeywordId idValue
+        --
+        _ -> pure ()
+
+    --
+    pure Nothing
+
+compactIri' :: Monad m => Text -> CIT e m (Text, InverseContext)
+compactIri' var = do
+    CIEnv{..} <- ask
+
+    -- 2. 3.
+    let inverseContext = case activeContextInverseContext ciEnvActiveContext of
+            Nothing -> buildInverseContext ciEnvActiveContext
+            Just ic -> ic
+
+    compactIri4 inverseContext var >>= \case
+        Just var' -> pure (var', inverseContext)
+        Nothing -> pure (var, inverseContext)
+
+compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext)
+compactIri activeContext var paramsFn = do
+    envGlobal <- ask
+    result <-
+        compactIri' var
+            |> evalREST (env envGlobal) st
+    case result of
+        Left err -> throwError err
+        Right res -> pure res
+  where
+    CIParams{..} =
+        paramsFn
+            CIParams
+                { ciParamsActiveContext = activeContext
+                , ciParamsValue = Nothing
+                , ciParamsVocab = False
+                , ciParamsReverse = False
+                }
+
+    env global =
+        CIEnv
+            { ciEnvGlobal = global
+            , ciEnvActiveContext = ciParamsActiveContext
+            , ciEnvValue = ciParamsValue
+            , ciEnvVocab = ciParamsVocab
+            , ciEnvReverse = ciParamsReverse
+            }
+
+    st =
+        CIState
+            { ciStateContainers = mempty
+            , ciStateTypeLanguage = KeywordLanguage
+            , ciStateTypeLanguageValue = show KeywordNull
+            , ciStatePreferredValues = mempty
+            }
diff --git a/src/Data/JLD/Compaction/InverseContext.hs b/src/Data/JLD/Compaction/InverseContext.hs
new file mode 100644
index 0000000..b351e34
--- /dev/null
+++ b/src/Data/JLD/Compaction/InverseContext.hs
@@ -0,0 +1,54 @@
+module Data.JLD.Compaction.InverseContext (buildInverseContext) where
+
+import Data.JLD.Prelude
+
+import Data.JLD.Model.ActiveContext (ActiveContext (..))
+import Data.JLD.Model.Direction (Direction (..))
+import Data.JLD.Model.InverseContext (InverseContext)
+import Data.JLD.Model.Keyword (Keyword (..))
+import Data.JLD.Model.Language (Language (Language))
+import Data.JLD.Model.TermDefinition (TermDefinition (..))
+
+import Data.Map qualified as M
+
+processTerm :: Text -> InverseContext -> Text -> TermDefinition -> InverseContext
+processTerm defaultLangDir out termName TermDefinition{..}
+    | Just variableName <- termDefinitionIriMapping =
+        out
+            |> M.insert (variableName, container, show KeywordAny, show KeywordNone) termName
+            .> if
+                    | termDefinitionReversePropertyFlag ->
+                        M.insert (variableName, container, show KeywordType, show KeywordReverse) termName
+                    | termDefinitionTypeMapping == Just (show KeywordNone) ->
+                        M.insert (variableName, container, show KeywordLanguage, show KeywordAny) termName
+                            .> M.insert (variableName, container, show KeywordType, show KeywordAny) termName
+                    | Just typeMapping <- termDefinitionTypeMapping ->
+                        M.insert (variableName, container, show KeywordType, typeMapping) termName
+                    | Just langDir <- maybeLangDir ->
+                        M.insert (variableName, container, show KeywordLanguage, langDir) termName
+                    | otherwise ->
+                        M.insert (variableName, container, show KeywordLanguage, defaultLangDir) termName
+                            .> M.insert (variableName, container, show KeywordLanguage, show KeywordNone) termName
+                            .> M.insert (variableName, container, show KeywordType, show KeywordNone) termName
+    | otherwise = out
+  where
+    container = if null termDefinitionContainerMapping then show KeywordNone else fold termDefinitionContainerMapping
+    maybeLangDir = case (termDefinitionLanguageMapping, termDefinitionDirectionMapping) of
+        (Just (Language language), Just LTR) -> Just <| language <> "_ltr"
+        (Just (Language language), Just RTL) -> Just <| language <> "_rtl"
+        (Just (Language language), _) -> Just <| language
+        (Just _, Just LTR) -> Just "_ltr"
+        (Just _, Just RTL) -> Just "_rtl"
+        (Just _, _) -> Just <| show KeywordNull
+        (Nothing, Just LTR) -> Just "_ltr"
+        (Nothing, Just RTL) -> Just "_rtl"
+        (Nothing, Just NoDirection) -> Just <| show KeywordNone
+        (Nothing, Nothing) -> Nothing
+
+buildInverseContext :: ActiveContext -> InverseContext
+buildInverseContext ActiveContext{..} = M.foldlWithKey (processTerm defaultLangDir) mempty activeContextTerms
+  where
+    defaultLangDir = case (activeContextDefaultBaseDirection, activeContextDefaultLanguage) of
+        (Just bd, Just (Language dl)) -> dl <> "_" <> show bd
+        (Just bd, _) -> "_" <> show bd
+        (_, _) -> show KeywordNone
diff --git a/src/Data/JLD/Expansion.hs b/src/Data/JLD/Expansion.hs
index beb10a3..983c126 100644
--- a/src/Data/JLD/Expansion.hs
+++ b/src/Data/JLD/Expansion.hs
@@ -39,7 +39,7 @@ import Data.Foldable.WithIndex (ifoldlM, iforM_)
 import Data.RDF (parseIRI)
 import Data.Set qualified as S (insert, member)
 import Data.Text qualified as T (elem, toLower)
-import Data.Vector qualified as V (catMaybes, concat, cons, filter, fromList, mapMaybeM, maximum, modify, null, singleton, snoc, toList)
+import Data.Vector qualified as V (catMaybes, concat, cons, filter, fromList, mapMaybeM, maximum, modify, null, snoc, toList)
 import Data.Vector.Algorithms.Merge qualified as V
 import Text.URI (URI)
 
@@ -190,16 +190,16 @@ eo1314ExpandKeywordItem inputType key keyword value = do
                         }
                 case maybeExpandedStringValue of
                     Just expandedStringValue
-                        | jldeEnvFrameExpansion -> pure <. Just <. Array <. V.singleton <| String expandedStringValue
+                        | jldeEnvFrameExpansion -> pure <. Just <. Array <. pure <| String expandedStringValue
                         | otherwise -> pure <. Just <| String expandedStringValue
                     Nothing -> pure <| Just Null
             --
             Object (KM.null -> True) | jldeEnvFrameExpansion -> do
-                pure <. Just <. Array <. V.singleton <| Object mempty
+                pure <. Just <. Array <. pure <| Object mempty
             --
             Array (allStrings -> Just arrayValue) | jldeEnvFrameExpansion && not (V.null arrayValue) -> do
                 Just <. Array <. V.concat <. V.toList <$> forM arrayValue \item -> do
-                    V.singleton <. maybe Null String <$> eo1314ExpandIriAC item \params ->
+                    pure <. maybe Null String <$> eo1314ExpandIriAC item \params ->
                         params
                             { eiParamsDocumentRelative = True
                             , eiParamsVocab = False
@@ -233,7 +233,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
                 -- 13.4.4.4.
                 Array (allStrings -> Just arrayValue) ->
                     Array <. V.concat <. V.toList <$> forM arrayValue \item -> do
-                        V.singleton <. maybe Null String <$> eo1314ExpandIriTC item \params ->
+                        pure <. maybe Null String <$> eo1314ExpandIriTC item \params ->
                             params
                                 { eiParamsDocumentRelative = True
                                 , eiParamsVocab = True
@@ -264,7 +264,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
                 -- 13.4.6.4.
                 gets <| eo1314StateResult .> KM.lookup (show KeywordIncluded) .> \case
                     Just (Array includedValue) -> Just <. Array <| includedValue <> expandedValue
-                    Just includedValue -> Just <. Array <| V.singleton includedValue <> expandedValue
+                    Just includedValue -> Just <. Array <| pure includedValue <> expandedValue
                     Nothing -> Just <| Array expandedValue
         -- 13.4.7.
         KeywordValue -> do
@@ -277,9 +277,9 @@ eo1314ExpandKeywordItem inputType key keyword value = do
                 -- 13.4.7.2.
                 _ | value == Null || valueIsScalar value -> do
                     if jldeEnvFrameExpansion
-                        then pure <. Array <| V.singleton value
+                        then pure <. Array <| pure value
                         else pure value
-                Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <. Array <| V.singleton value
+                Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <. Array <| pure value
                 Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure value
                 --
                 _ -> throwError InvalidValueObjectValue
@@ -291,7 +291,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
         -- 13.4.8.
         KeywordLanguage -> case value of
             String stringValue
-                | jldeEnvFrameExpansion -> pure <. Just <. Array <. V.singleton <. String <| T.toLower stringValue
+                | jldeEnvFrameExpansion -> pure <. Just <. Array <. pure <. String <| T.toLower stringValue
                 | otherwise -> pure <. Just <. String <| T.toLower stringValue
             Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value
             Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value
@@ -301,7 +301,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
             | JLD1_0 <- jldExpansionEnvProcessingMode -> pure Nothing
             | otherwise -> case value of
                 String ((`elem` ["ltr", "rtl"]) -> True)
-                    | jldeEnvFrameExpansion -> pure <. Just <. Array <| V.singleton value
+                    | jldeEnvFrameExpansion -> pure <. Just <. Array <| pure value
                     | otherwise -> pure <| Just value
                 Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value
                 Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value
@@ -319,7 +319,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
                 expandedValue <- eo1314ExpandAC jldeEnvActiveProperty value id
                 case expandedValue of
                     Array _ -> pure <| Just expandedValue
-                    _ -> pure <. Just <. Array <| V.singleton expandedValue
+                    _ -> pure <. Just <. Array <| pure expandedValue
         -- 13.4.12.
         KeywordSet -> Just <$> eo1314ExpandAC jldeEnvActiveProperty value id
         -- 13.4.13.
@@ -491,7 +491,7 @@ eo1314ExpandNonKeywordItem key expandedProperty value = do
                                 let maybeExistingValues = expandedIndexKey >>= (`KM.lookup` item)
 
                                     indexPropertyValues =
-                                        V.singleton (Object reExpandedIndex)
+                                        pure (Object reExpandedIndex)
                                             |> case maybeExistingValues of
                                                 Just (Array existingValues) -> (<> existingValues)
                                                 Just existingValue -> (`V.snoc` existingValue)
@@ -526,7 +526,7 @@ eo1314ExpandNonKeywordItem key expandedProperty value = do
                             , expandedIndex /= show KeywordNone -> do
                                 let types = case KM.lookup (show KeywordType) item of
                                         Just existingType -> V.cons expandedIndex <| valueToArray existingType
-                                        Nothing -> V.singleton expandedIndex
+                                        Nothing -> pure expandedIndex
                                 pure <. KM.insert (show KeywordType) (Array types) <| item
                             -- 13.8.3.7.6.
                             | otherwise -> pure item
@@ -755,7 +755,7 @@ expandObject maybePropertyContext value = do
             | Just resultType <- KM.lookup (show KeywordType) result ->
                 eoNormalizeObject
                     <| if valueIsNotArray resultType && resultType /= Null
-                        then KM.insert (show KeywordType) (Array <| V.singleton resultType) result
+                        then KM.insert (show KeywordType) (Array <| pure resultType) result
                         else result
             -- 17.
             | KM.member (show KeywordList) result || KM.member (show KeywordSet) result -> do
@@ -793,7 +793,7 @@ expandArrayItem item = do
         -- 5.2.3.
         Array a -> pure <| V.filter (/= Null) a
         Null -> pure mempty
-        _ -> pure <| V.singleton item''
+        _ -> pure <| pure item''
 
 --
 
diff --git a/src/Data/JLD/Expansion/Context.hs b/src/Data/JLD/Expansion/Context.hs
index 99daba0..21350c8 100644
--- a/src/Data/JLD/Expansion/Context.hs
+++ b/src/Data/JLD/Expansion/Context.hs
@@ -96,8 +96,8 @@ bacBuildActiveContext context uri = do
     activeContext' <-
         buildActiveContext activeContext context (Just uri) params
             |> withEnvRES (const bacEnvGlobal)
-            |> withErrorRES Left
-            |> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
+            .> withErrorRES Left
+            .> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
     bacModifyActiveContext <| const activeContext'
 
 bacProcessItem :: Monad m => Maybe URI -> Value -> BACT e m ()
@@ -200,8 +200,8 @@ bacProcessItem baseUrl item = do
                     (maybeVocabMapping, activeContext', _) <-
                         expandIri activeContext value params
                             |> withEnvRES (const bacEnvGlobal)
-                            |> withErrorRES Left
-                            |> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
+                            .> withErrorRES Left
+                            .> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
                     bacModifyActiveContext <| const activeContext'
 
                     case maybeVocabMapping of
@@ -218,7 +218,7 @@ bacProcessItem baseUrl item = do
                 -- 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 (String language) -> bacModifyActiveContext \ac -> ac{activeContextDefaultLanguage = Just <. Language <| T.toLower language}
                 Just _ -> throwError <| Left InvalidDefaultLanguage
                 --
                 Nothing -> pure ()
@@ -345,8 +345,8 @@ buildActiveContext activeContext localContext baseUrl paramsFn = do
     BACState{..} <-
         (buildActiveContext' localContext baseUrl >> get)
             |> withEnvRES env
-            |> withErrorRES' (either throwError (const get))
-            |> withStateRES st (const bacStateGlobal)
+            .> withErrorRES' (either throwError (const get))
+            .> withStateRES st (const bacStateGlobal)
     pure bacStateActiveContext
   where
     BACParams{..} =
@@ -504,7 +504,7 @@ expandIri activeContext value paramsFn = do
     (value', EIState{..}) <-
         (expandIri' value >>= \v -> gets (v,))
             |> withEnvRES env
-            |> withStateRES st (const eiStateGlobal)
+            .> withStateRES st (const eiStateGlobal)
     pure (value', eiStateActiveContext, eiStateDefined)
   where
     EIParams{..} =
@@ -616,8 +616,8 @@ btdExpandIri value = do
     (expanded, activeContext', defined') <-
         expandIri activeContext value params
             |> withEnvRES (const btdEnvGlobal)
-            |> withErrorRES Left
-            |> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
+            .> withErrorRES Left
+            .> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
     modify \s ->
         s
             { btdStateActiveContext = activeContext'
@@ -634,8 +634,8 @@ btdBuildTermDefinition term = do
     (activeContext', defined') <-
         buildTermDefinition activeContext btdEnvLocalContext term params
             |> withEnvRES (const btdEnvGlobal)
-            |> withErrorRES Left
-            |> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
+            .> withErrorRES Left
+            .> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
     modify \env ->
         env
             { btdStateActiveContext = activeContext'
@@ -891,9 +891,9 @@ buildTermDefinition' term = do
                         }
             buildActiveContext activeContext context btdEnvBaseUrl params
                 |> withEnvRES (const btdEnvGlobal)
-                |> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
-                |> withErrorRES (const <| Left InvalidScopedContext)
-                |> void
+                .> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
+                .> withErrorRES (const <| Left InvalidScopedContext)
+                .> void
 
             -- 21.4.
             btdModifyTermDefinition \d ->
@@ -909,7 +909,7 @@ buildTermDefinition' term = 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 (String language) -> btdModifyTermDefinition \d -> d{termDefinitionLanguageMapping = Just <. Language <| T.toLower language}
             Just _ -> throwError <| Left InvalidLanguageMapping
             Nothing -> pure ()
 
@@ -985,8 +985,8 @@ buildTermDefinition activeContext localContext term paramsFn = do
     BTDState{..} <-
         (buildTermDefinition' term >> get)
             |> withEnvRES env
-            |> withErrorRES' (either throwError (const get))
-            |> withStateRES st (const btdStateGlobal)
+            .> withErrorRES' (either throwError (const get))
+            .> withStateRES st (const btdStateGlobal)
     pure (btdStateActiveContext, btdStateDefined)
   where
     BTDParams{..} =
diff --git a/src/Data/JLD/Flattening/NodeMap.hs b/src/Data/JLD/Flattening/NodeMap.hs
index 06af2d4..ef09757 100644
--- a/src/Data/JLD/Flattening/NodeMap.hs
+++ b/src/Data/JLD/Flattening/NodeMap.hs
@@ -18,7 +18,7 @@ import Data.Aeson.Key qualified as K (toText)
 import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member, singleton)
 import Data.Foldable.WithIndex (FoldableWithIndex (..), iforM_)
 import Data.Map.Strict qualified as M (insert, lookup)
-import Data.Vector qualified as V (singleton, snoc, uniq)
+import Data.Vector qualified as V (snoc, uniq)
 
 type BNMT e m = REST BNMEnv (Either (JLDError e) ()) BNMState m
 
@@ -133,7 +133,7 @@ buildNodeMap' element = case element of
                                     N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Array <| V.snoc activePropertyValue element) nodeMap
                                 | otherwise -> nodeMap
                             -- 4.2.2
-                            _ -> N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Array <| V.singleton element) nodeMap
+                            _ -> N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Array <| pure element) nodeMap
                         -- 4.2.
                         Just list -> bnmModifyList <. const <. Just <| V.snoc list element
                 -- 5.
diff --git a/src/Data/JLD/Model/ActiveContext.hs b/src/Data/JLD/Model/ActiveContext.hs
index 5423036..f2118c4 100644
--- a/src/Data/JLD/Model/ActiveContext.hs
+++ b/src/Data/JLD/Model/ActiveContext.hs
@@ -1,4 +1,4 @@
-module Data.JLD.Model.ActiveContext ( ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm,) where
+module Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm) where
 
 import Data.JLD.Prelude
 
@@ -15,7 +15,7 @@ data ActiveContext = ActiveContext
     { activeContextTerms :: Map Text TermDefinition
     , activeContextBaseIri :: Maybe IRIRef
     , activeContextBaseUrl :: Maybe URI
-    , activeContextInverseContext :: InverseContext
+    , activeContextInverseContext :: Maybe InverseContext
     , activeContextPreviousContext :: Maybe ActiveContext
     , activeContextVocabularyMapping :: Maybe Text
     , activeContextDefaultLanguage :: Maybe Language
@@ -30,7 +30,7 @@ newActiveContext fn =
             { activeContextTerms = mempty
             , activeContextBaseIri = Nothing
             , activeContextBaseUrl = Nothing
-            , activeContextInverseContext = mempty
+            , activeContextInverseContext = Nothing
             , activeContextPreviousContext = Nothing
             , activeContextVocabularyMapping = Nothing
             , activeContextDefaultLanguage = Nothing
diff --git a/src/Data/JLD/Model/GraphObject.hs b/src/Data/JLD/Model/GraphObject.hs
index 3db9e6b..4d7d3ad 100644
--- a/src/Data/JLD/Model/GraphObject.hs
+++ b/src/Data/JLD/Model/GraphObject.hs
@@ -1,4 +1,4 @@
-module Data.JLD.Model.GraphObject (isGraphObject, isNotGraphObject, toGraphObject) where
+module Data.JLD.Model.GraphObject (isGraphObject, isGraphObject', isNotGraphObject, isNotGraphObject', toGraphObject) where
 
 import Data.JLD.Prelude
 
@@ -6,17 +6,22 @@ import Data.JLD.Model.Keyword (Keyword (..), isKeyword)
 
 import Data.Aeson (Object, Value (..))
 import Data.Aeson.Key qualified as K (toText)
-import Data.Aeson.KeyMap qualified as KM (keys, singleton, member)
-import Data.Vector qualified as V (singleton)
+import Data.Aeson.KeyMap qualified as KM (keys, member, singleton)
 
 isGraphObject :: Value -> Bool
-isGraphObject (Object o)
-    | KM.member (show KeywordGraph) o =
-        all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o)
+isGraphObject (Object o) = isGraphObject' o
 isGraphObject _ = False
 
+isGraphObject' :: Object -> Bool
+isGraphObject' o =
+    KM.member (show KeywordGraph) o
+        && all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o)
+
 isNotGraphObject :: Value -> Bool
 isNotGraphObject = isGraphObject .> not
 
+isNotGraphObject' :: Object -> Bool
+isNotGraphObject' = isGraphObject' .> not
+
 toGraphObject :: Value -> Object
-toGraphObject = V.singleton .> Array .> KM.singleton (show KeywordGraph)
+toGraphObject = pure .> Array .> KM.singleton (show KeywordGraph)
diff --git a/src/Data/JLD/Model/ListObject.hs b/src/Data/JLD/Model/ListObject.hs
index 8dda349..6277d24 100644
--- a/src/Data/JLD/Model/ListObject.hs
+++ b/src/Data/JLD/Model/ListObject.hs
@@ -1,24 +1,26 @@
-module Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) where
+module Data.JLD.Model.ListObject (isListObject, isListObject', isNotListObject, toListObject) where
 
 import Data.JLD.Prelude
 
 import Data.JLD.Model.Keyword (Keyword (..))
 
-import Data.Aeson (Value (..))
-import Data.Aeson.KeyMap qualified as KM
-import Data.Vector qualified as V
+import Data.Aeson (Object, Value (..))
+import Data.Aeson.KeyMap qualified as KM (member, singleton, size)
 
 isListObject :: Value -> Bool
-isListObject (Object o) =
+isListObject (Object o) = isListObject' o
+isListObject _ = False
+
+isListObject' :: Object -> Bool
+isListObject' o =
     KM.member (show KeywordList) o
         && ( KM.size o == 1
                 || (KM.size o == 2 && KM.member (show KeywordIndex) o)
            )
-isListObject _ = False
 
 isNotListObject :: Value -> Bool
 isNotListObject = isListObject .> not
 
 toListObject :: Value -> Value
 toListObject value@(Array _) = Object <| KM.singleton (show KeywordList) value
-toListObject value = Object <| KM.singleton (show KeywordList) (Array <| V.singleton value)
+toListObject value = Object <| KM.singleton (show KeywordList) (Array <| pure value)
diff --git a/src/Data/JLD/Util.hs b/src/Data/JLD/Util.hs
index 26b2755..8d84778 100644
--- a/src/Data/JLD/Util.hs
+++ b/src/Data/JLD/Util.hs
@@ -25,7 +25,7 @@ import Data.Aeson.KeyMap qualified as KM (insert, lookup, member)
 import Data.Foldable qualified as F (Foldable (..), elem)
 import Data.Foldable.WithIndex (FoldableWithIndex (..), ifoldlM)
 import Data.Vector (Vector)
-import Data.Vector qualified as V (filter, fromList, null, singleton, snoc, uncons)
+import Data.Vector qualified as V (filter, fromList, null, snoc, uncons)
 
 valueContains :: Text -> Value -> Bool
 valueContains text = \case
@@ -78,13 +78,13 @@ flattenSingletonArray = \case
 valueToArray :: Value -> Array
 valueToArray = \case
     Array a -> a
-    value -> V.singleton value
+    value -> pure value
 
 valueToNonNullArray :: Value -> Array
 valueToNonNullArray = \case
     Null -> mempty
     Array a -> V.filter (/= Null) a
-    value -> V.singleton value
+    value -> pure value
 
 allStrings :: Array -> Maybe (Vector Text)
 allStrings = foldl' go (Just mempty)
@@ -106,7 +106,7 @@ mapAddValue key value True object = mapAddValue key value False <| KM.insert key
   where
     array = case KM.lookup key object of
         Just (Array a) -> a
-        Just original -> V.singleton original
+        Just original -> pure original
         Nothing -> mempty
 mapAddValue key (Array value) False object = foldl' (\o v -> mapAddValue key v False o) object value
 mapAddValue key value False object = case KM.lookup key object of