From b19440a4a30828f12f8eafaa7292152ecf733334 Mon Sep 17 00:00:00 2001
From: Volpeon <github@volpeon.ink>
Date: Sat, 24 Jun 2023 08:58:22 +0200
Subject: WIP: Compaction

---
 src/Data/JLD/Expansion/Context.hs | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

(limited to 'src/Data/JLD/Expansion')

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{..} =
-- 
cgit v1.2.3-54-g00ecf