From 1bb6f74645e39bb45e33a7413771ea7f971628c9 Mon Sep 17 00:00:00 2001
From: Volpeon <github@volpeon.ink>
Date: Sat, 27 May 2023 12:10:51 +0200
Subject: Structural improvements

---
 src/Data/JLD.hs | 53 ++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 34 insertions(+), 19 deletions(-)

(limited to 'src/Data/JLD.hs')

diff --git a/src/Data/JLD.hs b/src/Data/JLD.hs
index d60e5a1..1f894bb 100644
--- a/src/Data/JLD.hs
+++ b/src/Data/JLD.hs
@@ -2,22 +2,22 @@ module Data.JLD (
     module Data.JLD.Mime,
     module Data.JLD.Error,
     module Data.JLD.Options,
-    JLDExpandParams (..),
+    JLDExpansionParams (..),
     expand,
 ) where
 
 import Data.JLD.Prelude
 
-import Data.JLD.Context (buildActiveContext)
 import Data.JLD.Control.Monad.RES (evalREST, runREST)
 import Data.JLD.Error
 import Data.JLD.Expansion (JLDEParams (..))
 import Data.JLD.Expansion qualified as E (expand)
+import Data.JLD.Expansion.Context (buildActiveContext)
+import Data.JLD.Expansion.Global (JLDExpansionEnv (..), JLDExpansionState (..))
 import Data.JLD.Mime
 import Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext)
 import Data.JLD.Model.Keyword (Keyword (..))
 import Data.JLD.Model.URI (uriToIri)
-import Data.JLD.Monad (JLDEnv, JLDState, newEnv, newState)
 import Data.JLD.Options
 import Data.JLD.Util (flattenSingletonArray, valueToArray)
 
@@ -26,31 +26,46 @@ import Data.Aeson.KeyMap qualified as KM
 import Data.Vector qualified as V (singleton)
 import Text.URI (URI)
 
-data JLDExpandParams e m = JLDExpandParams
-    { jldExpandParamsExpandContext :: Maybe Value
-    , jldExpandParamsFrameExpansion :: Bool
-    , jldExpandParamsEnv :: JLDEnv e m
-    , jldExpandParamsState :: JLDState
+data JLDExpansionParams e m = JLDExpansionParams
+    { jldExpansionParamsDocumentLoader :: DocumentLoader e m
+    , jldExpansionParamsProcessingMode :: JLDVersion
+    , jldExpansionParamsMaxRemoteContexts :: Int
+    , jldExpansionParamsExpandContext :: Maybe Value
+    , jldExpansionParamsFrameExpansion :: Bool
+    , jldExpansionParamsState :: JLDExpansionState
     }
     deriving (Show)
 
-expand :: Monad m => Value -> URI -> (JLDExpandParams () m -> JLDExpandParams e m) -> m (Either (JLDError e) Value, JLDState)
+expand :: Monad m => Value -> URI -> (JLDExpansionParams () m -> JLDExpansionParams e m) -> m (Either (JLDError e) Value, JLDExpansionState)
 expand document baseUrl paramsFn = do
-    let JLDExpandParams{..} =
+    let JLDExpansionParams{..} =
             paramsFn
-                JLDExpandParams
-                    { jldExpandParamsExpandContext = Nothing
-                    , jldExpandParamsFrameExpansion = False
-                    , jldExpandParamsEnv = newEnv id
-                    , jldExpandParamsState = newState id
+                JLDExpansionParams
+                    { jldExpansionParamsDocumentLoader = DocumentLoader <. const <. pure <| Left ()
+                    , jldExpansionParamsProcessingMode = JLD1_1
+                    , jldExpansionParamsMaxRemoteContexts = 20
+                    , jldExpansionParamsExpandContext = Nothing
+                    , jldExpansionParamsFrameExpansion = False
+                    , jldExpansionParamsState =
+                        JLDExpansionState
+                            { jldExpansionStateContextCache = mempty
+                            , jldExpansionStateDocumentCache = mempty
+                            }
                     }
 
+        env =
+            JLDExpansionEnv
+                { jldExpansionEnvDocumentLoader = jldExpansionParamsDocumentLoader
+                , jldExpansionEnvProcessingMode = jldExpansionParamsProcessingMode
+                , jldExpansionEnvMaxRemoteContexts = jldExpansionParamsMaxRemoteContexts
+                }
+
         activeContext = newActiveContext \ac -> ac{activeContextBaseUrl = Just baseUrl, activeContextBaseIri = uriToIri baseUrl}
-        expansionParams p = p{jldeParamsFrameExpansion = jldExpandParamsFrameExpansion}
+        expansionParams p = p{jldeParamsFrameExpansion = jldExpansionParamsFrameExpansion}
 
     -- 6.
     let maybeExpandContext =
-            jldExpandParamsExpandContext <&> flattenSingletonArray .> \case
+            jldExpansionParamsExpandContext <&> flattenSingletonArray .> \case
                 Array expandedContext -> Array expandedContext
                 (Object expandedContext) | Just ctx <- KM.lookup (show KeywordContext) expandedContext -> ctx
                 expandedContext -> Array <| V.singleton expandedContext
@@ -58,14 +73,14 @@ expand document baseUrl paramsFn = do
     activeContext' <- case maybeExpandContext of
         Just expandContext ->
             buildActiveContext activeContext expandContext (Just baseUrl) id
-                |> evalREST jldExpandParamsEnv jldExpandParamsState
+                |> evalREST env jldExpansionParamsState
                 |> fmap (fromRight activeContext)
         Nothing -> pure activeContext
 
     -- 8.
     (result, state') <-
         E.expand activeContext' document baseUrl expansionParams
-            |> runREST jldExpandParamsEnv jldExpandParamsState
+            |> runREST env jldExpansionParamsState
 
     let result' = case result of
             -- 8.1.
-- 
cgit v1.2.3-54-g00ecf