diff options
Diffstat (limited to 'src/Data/JLD/Expansion.hs')
| -rw-r--r-- | src/Data/JLD/Expansion.hs | 56 |
1 files changed, 39 insertions, 17 deletions
diff --git a/src/Data/JLD/Expansion.hs b/src/Data/JLD/Expansion.hs index 18d7fc6..ff2d9c3 100644 --- a/src/Data/JLD/Expansion.hs +++ b/src/Data/JLD/Expansion.hs | |||
| @@ -3,19 +3,19 @@ module Data.JLD.Expansion (JLDEParams (..), expand) where | |||
| 3 | import Data.JLD.Prelude | 3 | import Data.JLD.Prelude |
| 4 | 4 | ||
| 5 | import Data.JLD.Control.Monad.RES (REST, withEnvRES, withStateRES) | 5 | import Data.JLD.Control.Monad.RES (REST, withEnvRES, withStateRES) |
| 6 | import Data.JLD.Context (BACParams (..), EIParams (..), buildActiveContext, expandIri) | 6 | import Data.JLD.Error (JLDError (..)) |
| 7 | import Data.JLD.Expansion.Context (BACParams (..), EIParams (..), buildActiveContext, expandIri) | ||
| 8 | import Data.JLD.Expansion.Global (JLDExpansionEnv (..), JLDExpansionState, JLDExpansionT) | ||
| 7 | import Data.JLD.Model.ActiveContext (ActiveContext (..), lookupTerm) | 9 | import Data.JLD.Model.ActiveContext (ActiveContext (..), lookupTerm) |
| 8 | import Data.JLD.Model.Direction (Direction (..)) | 10 | import Data.JLD.Model.Direction (Direction (..)) |
| 9 | import Data.JLD.Error (JLDError (..)) | ||
| 10 | import Data.JLD.Model.GraphObject (isNotGraphObject, toGraphObject) | 11 | import Data.JLD.Model.GraphObject (isNotGraphObject, toGraphObject) |
| 11 | import Data.JLD.Model.Keyword (Keyword (..), isKeyword, isNotKeyword, parseKeyword) | 12 | import Data.JLD.Model.Keyword (Keyword (..), isKeyword, isNotKeyword, parseKeyword) |
| 12 | import Data.JLD.Model.Language (Language (..)) | 13 | import Data.JLD.Model.Language (Language (..)) |
| 13 | import Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) | 14 | import Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) |
| 14 | import Data.JLD.Monad (JLDEEnv (..), JLDEState (..), JLDET, JLDEnv (..), JLDT, modifyActiveContext) | ||
| 15 | import Data.JLD.Model.NodeObject (isNotNodeObject) | 15 | import Data.JLD.Model.NodeObject (isNotNodeObject) |
| 16 | import Data.JLD.Options (JLDVersion (..)) | ||
| 17 | import Data.JLD.Model.TermDefinition (TermDefinition (..)) | 16 | import Data.JLD.Model.TermDefinition (TermDefinition (..)) |
| 18 | import Data.JLD.Model.ValueObject (isNotValueObject', isValueObject, isValueObject') | 17 | import Data.JLD.Model.ValueObject (isNotValueObject', isValueObject, isValueObject') |
| 18 | import Data.JLD.Options (JLDVersion (..)) | ||
| 19 | import Data.JLD.Util ( | 19 | import Data.JLD.Util ( |
| 20 | allStrings, | 20 | allStrings, |
| 21 | getMapDefault, | 21 | getMapDefault, |
| @@ -44,6 +44,36 @@ import Data.Vector qualified as V (catMaybes, concat, cons, filter, fromList, ma | |||
| 44 | import Data.Vector.Algorithms.Merge qualified as V | 44 | import Data.Vector.Algorithms.Merge qualified as V |
| 45 | import Text.URI (URI) | 45 | import Text.URI (URI) |
| 46 | 46 | ||
| 47 | type JLDET e m = REST (JLDEEnv e m) (JLDError e) JLDEState m | ||
| 48 | |||
| 49 | data JLDEEnv e m = JLDEEnv | ||
| 50 | { jldeEnvGlobal :: JLDExpansionEnv e m | ||
| 51 | , jldeEnvFrameExpansion :: Bool | ||
| 52 | , jldeEnvFromMap :: Bool | ||
| 53 | , jldeEnvBaseUrl :: URI | ||
| 54 | , jldeEnvActiveProperty :: Maybe Text | ||
| 55 | } | ||
| 56 | deriving (Show) | ||
| 57 | |||
| 58 | data JLDEState = JLDEState | ||
| 59 | { jldeStateGlobal :: JLDExpansionState | ||
| 60 | , jldeStateActiveContext :: ActiveContext | ||
| 61 | } | ||
| 62 | deriving (Show, Eq) | ||
| 63 | |||
| 64 | data JLDEParams = JLDEParams | ||
| 65 | { jldeParamsFrameExpansion :: Bool | ||
| 66 | , jldeParamsFromMap :: Bool | ||
| 67 | , jldeParamsBaseUrl :: URI | ||
| 68 | , jldeParamsActiveProperty :: Maybe Text | ||
| 69 | } | ||
| 70 | deriving (Show, Eq) | ||
| 71 | |||
| 72 | modifyActiveContext :: MonadState JLDEState m => (ActiveContext -> ActiveContext) -> m () | ||
| 73 | modifyActiveContext fn = modify \s -> s{jldeStateActiveContext = fn (jldeStateActiveContext s)} | ||
| 74 | |||
| 75 | -- | ||
| 76 | |||
| 47 | type EO1314T e m = REST (JLDEEnv e m) (JLDError e) EO1314State m | 77 | type EO1314T e m = REST (JLDEEnv e m) (JLDError e) EO1314State m |
| 48 | 78 | ||
| 49 | data EO1314State = EO1314State | 79 | data EO1314State = EO1314State |
| @@ -141,7 +171,7 @@ eo1314ExpandValue activeProperty value = do | |||
| 141 | eo1314ExpandKeywordItem :: Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m () | 171 | eo1314ExpandKeywordItem :: Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m () |
| 142 | eo1314ExpandKeywordItem inputType key keyword value = do | 172 | eo1314ExpandKeywordItem inputType key keyword value = do |
| 143 | JLDEEnv{..} <- ask | 173 | JLDEEnv{..} <- ask |
| 144 | let JLDEnv{..} = jldeEnvGlobal | 174 | let JLDExpansionEnv{..} = jldeEnvGlobal |
| 145 | 175 | ||
| 146 | -- 13.4.1. | 176 | -- 13.4.1. |
| 147 | when (jldeEnvActiveProperty == Just (show KeywordReverse)) <| throwError InvalidReversePropertyMap | 177 | when (jldeEnvActiveProperty == Just (show KeywordReverse)) <| throwError InvalidReversePropertyMap |
| @@ -222,7 +252,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do | |||
| 222 | -- 13.4.6. | 252 | -- 13.4.6. |
| 223 | KeywordIncluded | 253 | KeywordIncluded |
| 224 | -- 13.4.6.1. | 254 | -- 13.4.6.1. |
| 225 | | JLD1_0 <- jldEnvProcessingMode -> pure Nothing | 255 | | JLD1_0 <- jldExpansionEnvProcessingMode -> pure Nothing |
| 226 | -- 13.4.6.2. | 256 | -- 13.4.6.2. |
| 227 | | otherwise -> do | 257 | | otherwise -> do |
| 228 | expandedValue <- valueToArray <$> eo1314ExpandAC Nothing value id | 258 | expandedValue <- valueToArray <$> eo1314ExpandAC Nothing value id |
| @@ -242,7 +272,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do | |||
| 242 | expandedValue <- case value of | 272 | expandedValue <- case value of |
| 243 | -- 13.4.7.1. | 273 | -- 13.4.7.1. |
| 244 | _ | inputType == Just (show KeywordJson) -> do | 274 | _ | inputType == Just (show KeywordJson) -> do |
| 245 | if jldEnvProcessingMode == JLD1_0 | 275 | if jldExpansionEnvProcessingMode == JLD1_0 |
| 246 | then throwError InvalidValueObjectValue | 276 | then throwError InvalidValueObjectValue |
| 247 | else pure value | 277 | else pure value |
| 248 | -- 13.4.7.2. | 278 | -- 13.4.7.2. |
| @@ -269,7 +299,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do | |||
| 269 | _ -> throwError InvalidLanguageTaggedString | 299 | _ -> throwError InvalidLanguageTaggedString |
| 270 | -- 13.4.9. | 300 | -- 13.4.9. |
| 271 | KeywordDirection | 301 | KeywordDirection |
| 272 | | JLD1_0 <- jldEnvProcessingMode -> pure Nothing | 302 | | JLD1_0 <- jldExpansionEnvProcessingMode -> pure Nothing |
| 273 | | otherwise -> case value of | 303 | | otherwise -> case value of |
| 274 | String ((`elem` ["ltr", "rtl"]) -> True) | 304 | String ((`elem` ["ltr", "rtl"]) -> True) |
| 275 | | jldeEnvFrameExpansion -> pure <. Just <. Array <| V.singleton value | 305 | | jldeEnvFrameExpansion -> pure <. Just <. Array <| V.singleton value |
| @@ -815,14 +845,6 @@ expandValue activeProperty value = do | |||
| 815 | 845 | ||
| 816 | -- | 846 | -- |
| 817 | 847 | ||
| 818 | data JLDEParams = JLDEParams | ||
| 819 | { jldeParamsFrameExpansion :: Bool | ||
| 820 | , jldeParamsFromMap :: Bool | ||
| 821 | , jldeParamsBaseUrl :: URI | ||
| 822 | , jldeParamsActiveProperty :: Maybe Text | ||
| 823 | } | ||
| 824 | deriving (Show, Eq) | ||
| 825 | |||
| 826 | exModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> JLDET e m () | 848 | exModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> JLDET e m () |
| 827 | exModifyActiveContext fn = modify \st -> st{jldeStateActiveContext = fn (jldeStateActiveContext st)} | 849 | exModifyActiveContext fn = modify \st -> st{jldeStateActiveContext = fn (jldeStateActiveContext st)} |
| 828 | 850 | ||
| @@ -911,7 +933,7 @@ expand' = \case | |||
| 911 | -- 4.3. | 933 | -- 4.3. |
| 912 | | otherwise -> Object <$> expandValue activeProperty value | 934 | | otherwise -> Object <$> expandValue activeProperty value |
| 913 | 935 | ||
| 914 | expand :: Monad m => ActiveContext -> Value -> URI -> (JLDEParams -> JLDEParams) -> JLDT e m Value | 936 | expand :: Monad m => ActiveContext -> Value -> URI -> (JLDEParams -> JLDEParams) -> JLDExpansionT e m Value |
| 915 | expand activeContext value baseUrl paramsFn = | 937 | expand activeContext value baseUrl paramsFn = |
| 916 | expand' value | 938 | expand' value |
| 917 | |> withEnvRES env | 939 | |> withEnvRES env |
