diff options
Diffstat (limited to 'src/Data/JLD.hs')
-rw-r--r-- | src/Data/JLD.hs | 53 |
1 files changed, 34 insertions, 19 deletions
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 ( | |||
2 | module Data.JLD.Mime, | 2 | module Data.JLD.Mime, |
3 | module Data.JLD.Error, | 3 | module Data.JLD.Error, |
4 | module Data.JLD.Options, | 4 | module Data.JLD.Options, |
5 | JLDExpandParams (..), | 5 | JLDExpansionParams (..), |
6 | expand, | 6 | expand, |
7 | ) where | 7 | ) where |
8 | 8 | ||
9 | import Data.JLD.Prelude | 9 | import Data.JLD.Prelude |
10 | 10 | ||
11 | import Data.JLD.Context (buildActiveContext) | ||
12 | import Data.JLD.Control.Monad.RES (evalREST, runREST) | 11 | import Data.JLD.Control.Monad.RES (evalREST, runREST) |
13 | import Data.JLD.Error | 12 | import Data.JLD.Error |
14 | import Data.JLD.Expansion (JLDEParams (..)) | 13 | import Data.JLD.Expansion (JLDEParams (..)) |
15 | import Data.JLD.Expansion qualified as E (expand) | 14 | import Data.JLD.Expansion qualified as E (expand) |
15 | import Data.JLD.Expansion.Context (buildActiveContext) | ||
16 | import Data.JLD.Expansion.Global (JLDExpansionEnv (..), JLDExpansionState (..)) | ||
16 | import Data.JLD.Mime | 17 | import Data.JLD.Mime |
17 | import Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext) | 18 | import Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext) |
18 | import Data.JLD.Model.Keyword (Keyword (..)) | 19 | import Data.JLD.Model.Keyword (Keyword (..)) |
19 | import Data.JLD.Model.URI (uriToIri) | 20 | import Data.JLD.Model.URI (uriToIri) |
20 | import Data.JLD.Monad (JLDEnv, JLDState, newEnv, newState) | ||
21 | import Data.JLD.Options | 21 | import Data.JLD.Options |
22 | import Data.JLD.Util (flattenSingletonArray, valueToArray) | 22 | import Data.JLD.Util (flattenSingletonArray, valueToArray) |
23 | 23 | ||
@@ -26,31 +26,46 @@ import Data.Aeson.KeyMap qualified as KM | |||
26 | import Data.Vector qualified as V (singleton) | 26 | import Data.Vector qualified as V (singleton) |
27 | import Text.URI (URI) | 27 | import Text.URI (URI) |
28 | 28 | ||
29 | data JLDExpandParams e m = JLDExpandParams | 29 | data JLDExpansionParams e m = JLDExpansionParams |
30 | { jldExpandParamsExpandContext :: Maybe Value | 30 | { jldExpansionParamsDocumentLoader :: DocumentLoader e m |
31 | , jldExpandParamsFrameExpansion :: Bool | 31 | , jldExpansionParamsProcessingMode :: JLDVersion |
32 | , jldExpandParamsEnv :: JLDEnv e m | 32 | , jldExpansionParamsMaxRemoteContexts :: Int |
33 | , jldExpandParamsState :: JLDState | 33 | , jldExpansionParamsExpandContext :: Maybe Value |
34 | , jldExpansionParamsFrameExpansion :: Bool | ||
35 | , jldExpansionParamsState :: JLDExpansionState | ||
34 | } | 36 | } |
35 | deriving (Show) | 37 | deriving (Show) |
36 | 38 | ||
37 | expand :: Monad m => Value -> URI -> (JLDExpandParams () m -> JLDExpandParams e m) -> m (Either (JLDError e) Value, JLDState) | 39 | expand :: Monad m => Value -> URI -> (JLDExpansionParams () m -> JLDExpansionParams e m) -> m (Either (JLDError e) Value, JLDExpansionState) |
38 | expand document baseUrl paramsFn = do | 40 | expand document baseUrl paramsFn = do |
39 | let JLDExpandParams{..} = | 41 | let JLDExpansionParams{..} = |
40 | paramsFn | 42 | paramsFn |
41 | JLDExpandParams | 43 | JLDExpansionParams |
42 | { jldExpandParamsExpandContext = Nothing | 44 | { jldExpansionParamsDocumentLoader = DocumentLoader <. const <. pure <| Left () |
43 | , jldExpandParamsFrameExpansion = False | 45 | , jldExpansionParamsProcessingMode = JLD1_1 |
44 | , jldExpandParamsEnv = newEnv id | 46 | , jldExpansionParamsMaxRemoteContexts = 20 |
45 | , jldExpandParamsState = newState id | 47 | , jldExpansionParamsExpandContext = Nothing |
48 | , jldExpansionParamsFrameExpansion = False | ||
49 | , jldExpansionParamsState = | ||
50 | JLDExpansionState | ||
51 | { jldExpansionStateContextCache = mempty | ||
52 | , jldExpansionStateDocumentCache = mempty | ||
53 | } | ||
46 | } | 54 | } |
47 | 55 | ||
56 | env = | ||
57 | JLDExpansionEnv | ||
58 | { jldExpansionEnvDocumentLoader = jldExpansionParamsDocumentLoader | ||
59 | , jldExpansionEnvProcessingMode = jldExpansionParamsProcessingMode | ||
60 | , jldExpansionEnvMaxRemoteContexts = jldExpansionParamsMaxRemoteContexts | ||
61 | } | ||
62 | |||
48 | activeContext = newActiveContext \ac -> ac{activeContextBaseUrl = Just baseUrl, activeContextBaseIri = uriToIri baseUrl} | 63 | activeContext = newActiveContext \ac -> ac{activeContextBaseUrl = Just baseUrl, activeContextBaseIri = uriToIri baseUrl} |
49 | expansionParams p = p{jldeParamsFrameExpansion = jldExpandParamsFrameExpansion} | 64 | expansionParams p = p{jldeParamsFrameExpansion = jldExpansionParamsFrameExpansion} |
50 | 65 | ||
51 | -- 6. | 66 | -- 6. |
52 | let maybeExpandContext = | 67 | let maybeExpandContext = |
53 | jldExpandParamsExpandContext <&> flattenSingletonArray .> \case | 68 | jldExpansionParamsExpandContext <&> flattenSingletonArray .> \case |
54 | Array expandedContext -> Array expandedContext | 69 | Array expandedContext -> Array expandedContext |
55 | (Object expandedContext) | Just ctx <- KM.lookup (show KeywordContext) expandedContext -> ctx | 70 | (Object expandedContext) | Just ctx <- KM.lookup (show KeywordContext) expandedContext -> ctx |
56 | expandedContext -> Array <| V.singleton expandedContext | 71 | expandedContext -> Array <| V.singleton expandedContext |
@@ -58,14 +73,14 @@ expand document baseUrl paramsFn = do | |||
58 | activeContext' <- case maybeExpandContext of | 73 | activeContext' <- case maybeExpandContext of |
59 | Just expandContext -> | 74 | Just expandContext -> |
60 | buildActiveContext activeContext expandContext (Just baseUrl) id | 75 | buildActiveContext activeContext expandContext (Just baseUrl) id |
61 | |> evalREST jldExpandParamsEnv jldExpandParamsState | 76 | |> evalREST env jldExpansionParamsState |
62 | |> fmap (fromRight activeContext) | 77 | |> fmap (fromRight activeContext) |
63 | Nothing -> pure activeContext | 78 | Nothing -> pure activeContext |
64 | 79 | ||
65 | -- 8. | 80 | -- 8. |
66 | (result, state') <- | 81 | (result, state') <- |
67 | E.expand activeContext' document baseUrl expansionParams | 82 | E.expand activeContext' document baseUrl expansionParams |
68 | |> runREST jldExpandParamsEnv jldExpandParamsState | 83 | |> runREST env jldExpansionParamsState |
69 | 84 | ||
70 | let result' = case result of | 85 | let result' = case result of |
71 | -- 8.1. | 86 | -- 8.1. |