aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD/Expansion.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/JLD/Expansion.hs')
-rw-r--r--src/Data/JLD/Expansion.hs56
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
3import Data.JLD.Prelude 3import Data.JLD.Prelude
4 4
5import Data.JLD.Control.Monad.RES (REST, withEnvRES, withStateRES) 5import Data.JLD.Control.Monad.RES (REST, withEnvRES, withStateRES)
6import Data.JLD.Context (BACParams (..), EIParams (..), buildActiveContext, expandIri) 6import Data.JLD.Error (JLDError (..))
7import Data.JLD.Expansion.Context (BACParams (..), EIParams (..), buildActiveContext, expandIri)
8import Data.JLD.Expansion.Global (JLDExpansionEnv (..), JLDExpansionState, JLDExpansionT)
7import Data.JLD.Model.ActiveContext (ActiveContext (..), lookupTerm) 9import Data.JLD.Model.ActiveContext (ActiveContext (..), lookupTerm)
8import Data.JLD.Model.Direction (Direction (..)) 10import Data.JLD.Model.Direction (Direction (..))
9import Data.JLD.Error (JLDError (..))
10import Data.JLD.Model.GraphObject (isNotGraphObject, toGraphObject) 11import Data.JLD.Model.GraphObject (isNotGraphObject, toGraphObject)
11import Data.JLD.Model.Keyword (Keyword (..), isKeyword, isNotKeyword, parseKeyword) 12import Data.JLD.Model.Keyword (Keyword (..), isKeyword, isNotKeyword, parseKeyword)
12import Data.JLD.Model.Language (Language (..)) 13import Data.JLD.Model.Language (Language (..))
13import Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) 14import Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject)
14import Data.JLD.Monad (JLDEEnv (..), JLDEState (..), JLDET, JLDEnv (..), JLDT, modifyActiveContext)
15import Data.JLD.Model.NodeObject (isNotNodeObject) 15import Data.JLD.Model.NodeObject (isNotNodeObject)
16import Data.JLD.Options (JLDVersion (..))
17import Data.JLD.Model.TermDefinition (TermDefinition (..)) 16import Data.JLD.Model.TermDefinition (TermDefinition (..))
18import Data.JLD.Model.ValueObject (isNotValueObject', isValueObject, isValueObject') 17import Data.JLD.Model.ValueObject (isNotValueObject', isValueObject, isValueObject')
18import Data.JLD.Options (JLDVersion (..))
19import Data.JLD.Util ( 19import 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
44import Data.Vector.Algorithms.Merge qualified as V 44import Data.Vector.Algorithms.Merge qualified as V
45import Text.URI (URI) 45import Text.URI (URI)
46 46
47type JLDET e m = REST (JLDEEnv e m) (JLDError e) JLDEState m
48
49data 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
58data JLDEState = JLDEState
59 { jldeStateGlobal :: JLDExpansionState
60 , jldeStateActiveContext :: ActiveContext
61 }
62 deriving (Show, Eq)
63
64data JLDEParams = JLDEParams
65 { jldeParamsFrameExpansion :: Bool
66 , jldeParamsFromMap :: Bool
67 , jldeParamsBaseUrl :: URI
68 , jldeParamsActiveProperty :: Maybe Text
69 }
70 deriving (Show, Eq)
71
72modifyActiveContext :: MonadState JLDEState m => (ActiveContext -> ActiveContext) -> m ()
73modifyActiveContext fn = modify \s -> s{jldeStateActiveContext = fn (jldeStateActiveContext s)}
74
75--
76
47type EO1314T e m = REST (JLDEEnv e m) (JLDError e) EO1314State m 77type EO1314T e m = REST (JLDEEnv e m) (JLDError e) EO1314State m
48 78
49data EO1314State = EO1314State 79data EO1314State = EO1314State
@@ -141,7 +171,7 @@ eo1314ExpandValue activeProperty value = do
141eo1314ExpandKeywordItem :: Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m () 171eo1314ExpandKeywordItem :: Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m ()
142eo1314ExpandKeywordItem inputType key keyword value = do 172eo1314ExpandKeywordItem 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
818data JLDEParams = JLDEParams
819 { jldeParamsFrameExpansion :: Bool
820 , jldeParamsFromMap :: Bool
821 , jldeParamsBaseUrl :: URI
822 , jldeParamsActiveProperty :: Maybe Text
823 }
824 deriving (Show, Eq)
825
826exModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> JLDET e m () 848exModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> JLDET e m ()
827exModifyActiveContext fn = modify \st -> st{jldeStateActiveContext = fn (jldeStateActiveContext st)} 849exModifyActiveContext 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
914expand :: Monad m => ActiveContext -> Value -> URI -> (JLDEParams -> JLDEParams) -> JLDT e m Value 936expand :: Monad m => ActiveContext -> Value -> URI -> (JLDEParams -> JLDEParams) -> JLDExpansionT e m Value
915expand activeContext value baseUrl paramsFn = 937expand activeContext value baseUrl paramsFn =
916 expand' value 938 expand' value
917 |> withEnvRES env 939 |> withEnvRES env