aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD/Monad.hs
blob: 3ae929de01bfaaf59b7f40f0f47a2a3945c92f6d (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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)}