Init

1 files changed, 86 insertions, 0 deletions

diff --git a/src/Data/JLD/Monad.hs b/src/Data/JLD/Monad.hs
new file mode 100644
index 0000000..3ae929d
--- /dev/null
+++ b/src/Data/JLD/Monad.hs
@@ -0,0 +1,86 @@
+module Data.JLD.Monad (
+    JLDT,
+    JLDEnv (..),
+    JLDState (..),
+    newEnv,
+    newState,
+    hoistEnv,
+    modifyContextCache,
+    modifyDocumentCache,
+    JLDET,
+    JLDEEnv (..),
+    JLDEState (..),
+    modifyActiveContext,
+) where
+
+import Data.JLD.Prelude
+
+import Data.JLD.Control.Monad.RES (REST)
+import Data.JLD.Error (JLDError)
+import Data.JLD.Model.ActiveContext (ActiveContext)
+import Data.JLD.Options (ContextCache, DocumentCache, DocumentLoader (..), JLDVersion (..), hoistDocumentLoader)
+
+import Text.URI (URI)
+
+type JLDT e m = REST (JLDEnv e m) (JLDError e) JLDState m
+
+data JLDEnv e m = JLDEnv
+    { jldEnvDocumentLoader :: DocumentLoader e m
+    , jldEnvProcessingMode :: JLDVersion
+    , jldEnvMaxRemoteContexts :: Int
+    }
+    deriving (Show)
+
+data JLDState = JLDState
+    { jldStateContextCache :: ContextCache
+    , jldStateDocumentCache :: DocumentCache
+    }
+    deriving (Show, Eq)
+
+newEnv :: Applicative m => (JLDEnv () m -> JLDEnv e m) -> JLDEnv e m
+newEnv fn =
+    fn
+        JLDEnv
+            { jldEnvDocumentLoader = DocumentLoader (const <. pure <| Left ())
+            , jldEnvProcessingMode = JLD1_1
+            , jldEnvMaxRemoteContexts = 20
+            }
+
+newState :: (JLDState -> JLDState) -> JLDState
+newState fn =
+    fn
+        JLDState
+            { jldStateContextCache = mempty
+            , jldStateDocumentCache = mempty
+            }
+
+hoistEnv :: (forall a. m a -> n a) -> JLDEnv e m -> JLDEnv e n
+hoistEnv map' options = options{jldEnvDocumentLoader = options |> jldEnvDocumentLoader .> hoistDocumentLoader map'}
+
+modifyContextCache :: MonadState JLDState m => (ContextCache -> ContextCache) -> m ()
+modifyContextCache fn = modify \s -> s{jldStateContextCache = fn (jldStateContextCache s)}
+
+modifyDocumentCache :: MonadState JLDState m => (DocumentCache -> DocumentCache) -> m ()
+modifyDocumentCache fn = modify \s -> s{jldStateDocumentCache = fn (jldStateDocumentCache s)}
+
+--
+
+type JLDET e m = REST (JLDEEnv e m) (JLDError e) JLDEState m
+
+data JLDEEnv e m = JLDEEnv
+    { jldeEnvGlobal :: JLDEnv e m
+    , jldeEnvFrameExpansion :: Bool
+    , jldeEnvFromMap :: Bool
+    , jldeEnvBaseUrl :: URI
+    , jldeEnvActiveProperty :: Maybe Text
+    }
+    deriving (Show)
+
+data JLDEState = JLDEState
+    { jldeStateGlobal :: JLDState
+    , jldeStateActiveContext :: ActiveContext
+    }
+    deriving (Show, Eq)
+
+modifyActiveContext :: MonadState JLDEState m => (ActiveContext -> ActiveContext) -> m ()
+modifyActiveContext fn = modify \s -> s{jldeStateActiveContext = fn (jldeStateActiveContext s)}