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