aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/JLD.hs')
-rw-r--r--src/Data/JLD.hs53
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
9import Data.JLD.Prelude 9import Data.JLD.Prelude
10 10
11import Data.JLD.Context (buildActiveContext)
12import Data.JLD.Control.Monad.RES (evalREST, runREST) 11import Data.JLD.Control.Monad.RES (evalREST, runREST)
13import Data.JLD.Error 12import Data.JLD.Error
14import Data.JLD.Expansion (JLDEParams (..)) 13import Data.JLD.Expansion (JLDEParams (..))
15import Data.JLD.Expansion qualified as E (expand) 14import Data.JLD.Expansion qualified as E (expand)
15import Data.JLD.Expansion.Context (buildActiveContext)
16import Data.JLD.Expansion.Global (JLDExpansionEnv (..), JLDExpansionState (..))
16import Data.JLD.Mime 17import Data.JLD.Mime
17import Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext) 18import Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext)
18import Data.JLD.Model.Keyword (Keyword (..)) 19import Data.JLD.Model.Keyword (Keyword (..))
19import Data.JLD.Model.URI (uriToIri) 20import Data.JLD.Model.URI (uriToIri)
20import Data.JLD.Monad (JLDEnv, JLDState, newEnv, newState)
21import Data.JLD.Options 21import Data.JLD.Options
22import Data.JLD.Util (flattenSingletonArray, valueToArray) 22import Data.JLD.Util (flattenSingletonArray, valueToArray)
23 23
@@ -26,31 +26,46 @@ import Data.Aeson.KeyMap qualified as KM
26import Data.Vector qualified as V (singleton) 26import Data.Vector qualified as V (singleton)
27import Text.URI (URI) 27import Text.URI (URI)
28 28
29data JLDExpandParams e m = JLDExpandParams 29data 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
37expand :: Monad m => Value -> URI -> (JLDExpandParams () m -> JLDExpandParams e m) -> m (Either (JLDError e) Value, JLDState) 39expand :: Monad m => Value -> URI -> (JLDExpansionParams () m -> JLDExpansionParams e m) -> m (Either (JLDError e) Value, JLDExpansionState)
38expand document baseUrl paramsFn = do 40expand 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.