diff options
Diffstat (limited to 'src/Data/JLD/Monad.hs')
-rw-r--r-- | src/Data/JLD/Monad.hs | 86 |
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 @@ | |||
1 | module Data.JLD.Monad ( | ||
2 | JLDT, | ||
3 | JLDEnv (..), | ||
4 | JLDState (..), | ||
5 | newEnv, | ||
6 | newState, | ||
7 | hoistEnv, | ||
8 | modifyContextCache, | ||
9 | modifyDocumentCache, | ||
10 | JLDET, | ||
11 | JLDEEnv (..), | ||
12 | JLDEState (..), | ||
13 | modifyActiveContext, | ||
14 | ) where | ||
15 | |||
16 | import Data.JLD.Prelude | ||
17 | |||
18 | import Data.JLD.Control.Monad.RES (REST) | ||
19 | import Data.JLD.Error (JLDError) | ||
20 | import Data.JLD.Model.ActiveContext (ActiveContext) | ||
21 | import Data.JLD.Options (ContextCache, DocumentCache, DocumentLoader (..), JLDVersion (..), hoistDocumentLoader) | ||
22 | |||
23 | import Text.URI (URI) | ||
24 | |||
25 | type JLDT e m = REST (JLDEnv e m) (JLDError e) JLDState m | ||
26 | |||
27 | data JLDEnv e m = JLDEnv | ||
28 | { jldEnvDocumentLoader :: DocumentLoader e m | ||
29 | , jldEnvProcessingMode :: JLDVersion | ||
30 | , jldEnvMaxRemoteContexts :: Int | ||
31 | } | ||
32 | deriving (Show) | ||
33 | |||
34 | data JLDState = JLDState | ||
35 | { jldStateContextCache :: ContextCache | ||
36 | , jldStateDocumentCache :: DocumentCache | ||
37 | } | ||
38 | deriving (Show, Eq) | ||
39 | |||
40 | newEnv :: Applicative m => (JLDEnv () m -> JLDEnv e m) -> JLDEnv e m | ||
41 | newEnv fn = | ||
42 | fn | ||
43 | JLDEnv | ||
44 | { jldEnvDocumentLoader = DocumentLoader (const <. pure <| Left ()) | ||
45 | , jldEnvProcessingMode = JLD1_1 | ||
46 | , jldEnvMaxRemoteContexts = 20 | ||
47 | } | ||
48 | |||
49 | newState :: (JLDState -> JLDState) -> JLDState | ||
50 | newState fn = | ||
51 | fn | ||
52 | JLDState | ||
53 | { jldStateContextCache = mempty | ||
54 | , jldStateDocumentCache = mempty | ||
55 | } | ||
56 | |||
57 | hoistEnv :: (forall a. m a -> n a) -> JLDEnv e m -> JLDEnv e n | ||
58 | hoistEnv map' options = options{jldEnvDocumentLoader = options |> jldEnvDocumentLoader .> hoistDocumentLoader map'} | ||
59 | |||
60 | modifyContextCache :: MonadState JLDState m => (ContextCache -> ContextCache) -> m () | ||
61 | modifyContextCache fn = modify \s -> s{jldStateContextCache = fn (jldStateContextCache s)} | ||
62 | |||
63 | modifyDocumentCache :: MonadState JLDState m => (DocumentCache -> DocumentCache) -> m () | ||
64 | modifyDocumentCache fn = modify \s -> s{jldStateDocumentCache = fn (jldStateDocumentCache s)} | ||
65 | |||
66 | -- | ||
67 | |||
68 | type JLDET e m = REST (JLDEEnv e m) (JLDError e) JLDEState m | ||
69 | |||
70 | data JLDEEnv e m = JLDEEnv | ||
71 | { jldeEnvGlobal :: JLDEnv e m | ||
72 | , jldeEnvFrameExpansion :: Bool | ||
73 | , jldeEnvFromMap :: Bool | ||
74 | , jldeEnvBaseUrl :: URI | ||
75 | , jldeEnvActiveProperty :: Maybe Text | ||
76 | } | ||
77 | deriving (Show) | ||
78 | |||
79 | data JLDEState = JLDEState | ||
80 | { jldeStateGlobal :: JLDState | ||
81 | , jldeStateActiveContext :: ActiveContext | ||
82 | } | ||
83 | deriving (Show, Eq) | ||
84 | |||
85 | modifyActiveContext :: MonadState JLDEState m => (ActiveContext -> ActiveContext) -> m () | ||
86 | modifyActiveContext fn = modify \s -> s{jldeStateActiveContext = fn (jldeStateActiveContext s)} | ||