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. |
