module Data.JLD.Expansion (JLDEParams (..), expand) where import Data.JLD.Prelude import Data.JLD.Control.Monad.RES (REST, withEnvRES, withStateRES) import Data.JLD.Error (JLDError (..)) import Data.JLD.Expansion.Context (BACParams (..), EIParams (..), buildActiveContext, expandIri) import Data.JLD.Expansion.Global (JLDExpansionEnv (..), JLDExpansionState, JLDExpansionT) import Data.JLD.Model.ActiveContext (ActiveContext (..), lookupTerm) import Data.JLD.Model.Direction (Direction (..)) import Data.JLD.Model.GraphObject (isNotGraphObject, toGraphObject) import Data.JLD.Model.Keyword (Keyword (..), isKeyword, isNotKeyword, parseKeyword) import Data.JLD.Model.Language (Language (..)) import Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) import Data.JLD.Model.NodeObject (isNotNodeObject) import Data.JLD.Model.TermDefinition (TermDefinition (..)) import Data.JLD.Model.ValueObject (isNotValueObject', isValueObject, isValueObject') import Data.JLD.Options (JLDVersion (..)) import Data.JLD.Util ( allStrings, getMapDefault, ifindM, mapAddValue, valueContains, valueIsEmptyArray, valueIsNotArray, valueIsNotString, valueIsScalar, valueIsString, valueToArray, valueToString, ) import Control.Monad.Except (MonadError (..)) import Data.Aeson (Array, Key, KeyValue (..), Object, Value (..), object) import Data.Aeson.Key qualified as K (fromText, toText) import Data.Aeson.KeyMap qualified as KM (delete, fromList, insert, keys, lookup, member, null, singleton, size, toList) import Data.Foldable.WithIndex (ifoldlM, iforM_) import Data.RDF (parseIRI) import Data.Set qualified as S (insert, member) import Data.Text qualified as T (elem, toLower) import Data.Vector qualified as V (catMaybes, concat, cons, filter, fromList, mapMaybeM, maximum, modify, null, singleton, snoc, toList) import Data.Vector.Algorithms.Merge qualified as V import Text.URI (URI) type JLDET e m = REST (JLDEEnv e m) (JLDError e) JLDEState m data JLDEEnv e m = JLDEEnv { jldeEnvGlobal :: JLDExpansionEnv e m , jldeEnvFrameExpansion :: Bool , jldeEnvFromMap :: Bool , jldeEnvBaseUrl :: URI , jldeEnvActiveProperty :: Maybe Text } deriving (Show) data JLDEState = JLDEState { jldeStateGlobal :: JLDExpansionState , jldeStateActiveContext :: ActiveContext } deriving (Show, Eq) data JLDEParams = JLDEParams { jldeParamsFrameExpansion :: Bool , jldeParamsFromMap :: Bool , jldeParamsBaseUrl :: URI , jldeParamsActiveProperty :: Maybe Text } deriving (Show, Eq) modifyActiveContext :: MonadState JLDEState m => (ActiveContext -> ActiveContext) -> m () modifyActiveContext fn = modify \s -> s{jldeStateActiveContext = fn (jldeStateActiveContext s)} -- type EO1314T e m = REST (JLDEEnv e m) (JLDError e) EO1314State m data EO1314State = EO1314State { eo1314StateJlde :: JLDEState , eo1314StateNest :: Set Key , eo1314StateResult :: Object , eo1314StateTypeContext :: ActiveContext } deriving (Show, Eq) eo1314ModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> EO1314T e m () eo1314ModifyActiveContext = modifyActiveContext .> withStateRES eo1314StateJlde (\s g -> s{eo1314StateJlde = g}) eo1314ModifyTypeContext :: Monad m => (ActiveContext -> ActiveContext) -> EO1314T e m () eo1314ModifyTypeContext fn = modify \st -> st{eo1314StateTypeContext = fn (eo1314StateTypeContext st)} eo1314ModifyNest :: Monad m => (Set Key -> Set Key) -> EO1314T e m () eo1314ModifyNest fn = modify \s -> s{eo1314StateNest = fn (eo1314StateNest s)} eo1314ModifyResult :: Monad m => (Object -> Object) -> EO1314T e m () eo1314ModifyResult fn = modify \s -> s{eo1314StateResult = fn (eo1314StateResult s)} eo1314BuildActiveContext :: Monad m => ActiveContext -> Value -> Maybe URI -> (BACParams -> BACParams) -> EO1314T e m ActiveContext eo1314BuildActiveContext activeContext context baseUrl paramsFn = do buildActiveContext activeContext context baseUrl paramsFn |> withEnvRES jldeEnvGlobal |> withStateRES (eo1314StateJlde .> jldeStateGlobal) (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) eo1314ExpandAC :: Monad m => Maybe Text -> Value -> (JLDEParams -> JLDEParams) -> EO1314T e m Value eo1314ExpandAC activeProperty value fn = do activeContext <- gets <| jldeStateActiveContext <. eo1314StateJlde baseUrl <- asks jldeEnvBaseUrl frameExpansion <- asks jldeEnvFrameExpansion let params p = fn p{jldeParamsFrameExpansion = frameExpansion, jldeParamsActiveProperty = activeProperty} expand activeContext value baseUrl params |> withEnvRES jldeEnvGlobal |> withStateRES (eo1314StateJlde .> jldeStateGlobal) (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) eo1314ExpandTC :: Monad m => Maybe Text -> Value -> (JLDEParams -> JLDEParams) -> EO1314T e m Value eo1314ExpandTC activeProperty value fn = do typeContext <- gets <| eo1314StateTypeContext baseUrl <- asks jldeEnvBaseUrl frameExpansion <- asks jldeEnvFrameExpansion let params p = fn p{jldeParamsFrameExpansion = frameExpansion, jldeParamsActiveProperty = activeProperty} expand typeContext value baseUrl params |> withEnvRES jldeEnvGlobal |> withStateRES (eo1314StateJlde .> jldeStateGlobal) (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) eo1314Expand' :: Monad m => ActiveContext -> Maybe Text -> Value -> (JLDEParams -> JLDEParams) -> EO1314T e m Value eo1314Expand' activeContext activeProperty value fn = do baseUrl <- asks <| jldeEnvBaseUrl frameExpansion <- asks <| jldeEnvFrameExpansion let params p = fn p{jldeParamsFrameExpansion = frameExpansion, jldeParamsActiveProperty = activeProperty} expand activeContext value baseUrl params |> withEnvRES jldeEnvGlobal |> withStateRES (eo1314StateJlde .> jldeStateGlobal) (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) eo1314ExpandIriAC :: Monad m => Text -> (EIParams -> EIParams) -> EO1314T e m (Maybe Text) eo1314ExpandIriAC value fn = do activeContext <- gets <| jldeStateActiveContext <. eo1314StateJlde (value', activeContext', _) <- expandIri activeContext value fn |> withEnvRES jldeEnvGlobal |> withStateRES (eo1314StateJlde .> jldeStateGlobal) (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) eo1314ModifyActiveContext <| const activeContext' pure value' eo1314ExpandIriTC :: Monad m => Text -> (EIParams -> EIParams) -> EO1314T e m (Maybe Text) eo1314ExpandIriTC value fn = do typeContext <- gets <| eo1314StateTypeContext (value', typeContext', _) <- expandIri typeContext value fn |> withEnvRES jldeEnvGlobal |> withStateRES (eo1314StateJlde .> jldeStateGlobal) (\eo1314 jld -> eo1314{eo1314StateJlde = (eo1314StateJlde eo1314){jldeStateGlobal = jld}}) eo1314ModifyTypeContext <| const typeContext' pure value' eo1314ExpandValue :: Monad m => Text -> Value -> EO1314T e m Object eo1314ExpandValue activeProperty value = do expandValue activeProperty value |> withStateRES eo1314StateJlde (\eo1314 jld -> eo1314{eo1314StateJlde = jld}) eo1314ExpandKeywordItem :: Monad m => Maybe Text -> Key -> Keyword -> Value -> EO1314T e m () eo1314ExpandKeywordItem inputType key keyword value = do JLDEEnv{..} <- ask let JLDExpansionEnv{..} = jldeEnvGlobal -- 13.4.1. when (jldeEnvActiveProperty == Just (show KeywordReverse)) <| throwError InvalidReversePropertyMap -- 13.4.2. containsProp <- gets (eo1314StateResult .> KM.member (show keyword)) when (containsProp && keyword /= KeywordIncluded && keyword /= KeywordType) <| throwError (CollidingKeywords (K.toText key) keyword) maybeExpandedValue <- case keyword of -- 13.4.3. KeywordId -> case value of String stringValue -> do maybeExpandedStringValue <- eo1314ExpandIriAC stringValue \params -> params { eiParamsDocumentRelative = True , eiParamsVocab = False } case maybeExpandedStringValue of Just expandedStringValue | jldeEnvFrameExpansion -> pure <. Just <. Array <. V.singleton <| String expandedStringValue | otherwise -> pure <. Just <| String expandedStringValue Nothing -> pure <| Just Null -- Object (KM.null -> True) | jldeEnvFrameExpansion -> do pure <. Just <. Array <. V.singleton <| Object mempty -- Array (allStrings -> Just arrayValue) | jldeEnvFrameExpansion && not (V.null arrayValue) -> do Just <. Array <. V.concat <. V.toList <$> forM arrayValue \item -> do V.singleton <. maybe Null String <$> eo1314ExpandIriAC item \params -> params { eiParamsDocumentRelative = True , eiParamsVocab = False } -- _ -> throwError <| InvalidKeywordValue keyword value -- 13.4.4. KeywordType -> do expandedValue <- case value of -- 13.4.4.4. String stringValue -> do maybe Null String <$> eo1314ExpandIriTC stringValue \params -> params { eiParamsDocumentRelative = True , eiParamsVocab = True } -- 13.4.4.2. 13.4.4.3. Object objectValue -- 13.4.4.2. | jldeEnvFrameExpansion && KM.null objectValue -> pure value -- 13.4.4.3. | jldeEnvFrameExpansion , Just (String defaultValue) <- KM.lookup (show KeywordDefault) objectValue , Right _ <- parseIRI defaultValue -> do Object <. KM.singleton (show KeywordDefault) <. maybe Null String <$> eo1314ExpandIriTC defaultValue \params -> params { eiParamsDocumentRelative = True , eiParamsVocab = True } -- 13.4.4.4. Array (allStrings -> Just arrayValue) -> Array <. V.concat <. V.toList <$> forM arrayValue \item -> do V.singleton <. maybe Null String <$> eo1314ExpandIriTC item \params -> params { eiParamsDocumentRelative = True , eiParamsVocab = True } -- 13.4.4.1. _ -> throwError <| InvalidKeywordValue keyword value -- 13.4.4.5. gets <| eo1314StateResult .> KM.lookup (show KeywordType) .> \case Just (Array typeValue) -> Just <. Array <| V.snoc typeValue expandedValue Just typeValue -> Just <. Array <| V.fromList [typeValue, expandedValue] Nothing -> Just expandedValue -- 13.4.5. KeywordGraph -> Just <. Array <. valueToArray <$> eo1314ExpandTC (Just <| show KeywordGraph) value id -- 13.4.6. KeywordIncluded -- 13.4.6.1. | JLD1_0 <- jldExpansionEnvProcessingMode -> pure Nothing -- 13.4.6.2. | otherwise -> do expandedValue <- valueToArray <$> eo1314ExpandAC Nothing value id when (V.null expandedValue) <| throwError (InvalidKeywordValue keyword value) -- 13.4.6.3. when (any isNotNodeObject expandedValue) <| throwError (InvalidKeywordValue keyword value) -- 13.4.6.4. gets <| eo1314StateResult .> KM.lookup (show KeywordIncluded) .> \case Just (Array includedValue) -> Just <. Array <| includedValue <> expandedValue Just includedValue -> Just <. Array <| V.singleton includedValue <> expandedValue Nothing -> Just <| Array expandedValue -- 13.4.7. KeywordValue -> do expandedValue <- case value of -- 13.4.7.1. _ | inputType == Just (show KeywordJson) -> do if jldExpansionEnvProcessingMode == JLD1_0 then throwError InvalidValueObjectValue else pure value -- 13.4.7.2. _ | value == Null || valueIsScalar value -> do if jldeEnvFrameExpansion then pure <. Array <| V.singleton value else pure value Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <. Array <| V.singleton value Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure value -- _ -> throwError InvalidValueObjectValue -- 13.4.7.4. case expandedValue of Null -> Nothing <$ eo1314ModifyResult (KM.insert (show KeywordValue) Null) _ -> pure <| Just expandedValue -- 13.4.8. KeywordLanguage -> case value of String stringValue | jldeEnvFrameExpansion -> pure <. Just <. Array <. V.singleton <. String <| T.toLower stringValue | otherwise -> pure <. Just <. String <| T.toLower stringValue Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value _ -> throwError InvalidLanguageTaggedString -- 13.4.9. KeywordDirection | JLD1_0 <- jldExpansionEnvProcessingMode -> pure Nothing | otherwise -> case value of String ((`elem` ["ltr", "rtl"]) -> True) | jldeEnvFrameExpansion -> pure <. Just <. Array <| V.singleton value | otherwise -> pure <| Just value Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value _ -> throwError InvalidBaseDirection -- 13.4.10. KeywordIndex | String _ <- value -> pure <| Just value | otherwise -> throwError <| InvalidKeywordValue keyword value -- 13.4.11. KeywordList -- 13.4.11.1. | maybe True (== show KeywordGraph) jldeEnvActiveProperty -> pure Nothing -- 13.4.11.2. | otherwise -> do expandedValue <- eo1314ExpandAC jldeEnvActiveProperty value id case expandedValue of Array _ -> pure <| Just expandedValue _ -> pure <. Just <. Array <| V.singleton expandedValue -- 13.4.12. KeywordSet -> Just <$> eo1314ExpandAC jldeEnvActiveProperty value id -- 13.4.13. KeywordReverse -- 13.4.13.2. | Object _ <- value -> eo1314ExpandAC (Just <| show KeywordReverse) value id >>= \case Object expandedObjectValue -> do -- 13.4.13.3. case KM.lookup (show KeywordReverse) expandedObjectValue of Just (Object rev) -> iforM_ rev \key' item -> eo1314ModifyResult <| mapAddValue key' item True _ -> pure () -- 13.4.13.4. unless (KM.size expandedObjectValue == 1 && KM.member (show KeywordReverse) expandedObjectValue) do reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult reverseMap' <- (\fn -> ifoldlM fn reverseMap expandedObjectValue) <| \key' rm -> \case Array item | key' /= show KeywordReverse -> do (\fn -> foldlM fn rm item) <| \rm' i -> if isListObject i || isValueObject i then throwError <| InvalidReversePropertyValue else pure <| mapAddValue key' i True rm' _ -> pure rm if KM.null reverseMap' then eo1314ModifyResult <| KM.delete (show KeywordReverse) else eo1314ModifyResult <| KM.insert (show KeywordReverse) (Object reverseMap') -- 13.4.13.5. pure Nothing -- _ -> pure <| Just Null -- 13.4.13.1. | otherwise -> throwError <| InvalidKeywordValue keyword value -- 13.4.14. KeywordNest -> Nothing <$ eo1314ModifyNest (S.insert key) -- _ -> pure Nothing case maybeExpandedValue of Just expandedValue -> do -- 13.4.15. expandedValue' <- if jldeEnvFrameExpansion && keyword `elem` [KeywordDefault, KeywordEmbed, KeywordExplicit, KeywordOmitDefault, KeywordRequireAll] then eo1314ExpandAC (Just <| show keyword) expandedValue id else pure expandedValue -- 13.4.16. unless (expandedValue' == Null && keyword == KeywordValue && inputType /= Just (show KeywordJson)) <| eo1314ModifyResult (KM.insert (show keyword) expandedValue') -- Nothing -> pure () eo1314ExpandNonKeywordItem :: Monad m => Key -> Text -> Value -> EO1314T e m () eo1314ExpandNonKeywordItem key expandedProperty value = do -- 13.5. keyTermDefinition <- gets <| lookupTerm (K.toText key) <. jldeStateActiveContext <. eo1314StateJlde defaultBaseDirection <- gets <| activeContextDefaultBaseDirection <. jldeStateActiveContext <. eo1314StateJlde let containerMapping = maybe mempty termDefinitionContainerMapping keyTermDefinition -- 13.7.2. direction = (keyTermDefinition >>= termDefinitionDirectionMapping) <|> defaultBaseDirection -- 13.8.2. indexKey = fromMaybe (show KeywordIndex) (keyTermDefinition >>= termDefinitionIndexMapping) expandedValue <- case value of -- 13.6. _ | (keyTermDefinition >>= termDefinitionTypeMapping) == Just (show KeywordJson) -> do pure <| object [ show KeywordValue .= value , show KeywordType .= String (show KeywordJson) ] -- 13.7. Object objectValue | S.member (show KeywordLanguage) containerMapping -> -- 13.7.4. Array <. V.concat <$> forM (KM.toList objectValue) \(langCode, langValue) -> -- 13.7.4.1. 13.7.4.2. flip V.mapMaybeM (valueToArray langValue) \case -- 13.7.4.2.1. Null -> pure Nothing -- String item -> do -- 13.7.4.2.3. let langMap = KM.singleton (show KeywordValue) (String item) -- 13.7.4.2.4. langMap' <- if langCode /= show KeywordNone then do expandedLangCode <- maybe Null String <$> eo1314ExpandIriAC (K.toText langCode) \params -> params{eiParamsVocab = True} if expandedLangCode /= show KeywordNone then pure <| KM.insert (show KeywordLanguage) (String <. T.toLower <| K.toText langCode) langMap else pure langMap else pure langMap -- 13.7.4.2.5. let langMap'' = case direction of Nothing -> langMap' Just NoDirection -> langMap' Just dir -> KM.insert (show KeywordDirection) (String <| show dir) langMap' -- 13.7.4.2.6. pure <. Just <| Object langMap'' -- 13.7.4.2.2. _ -> throwError <| InvalidLanguageMapValue -- 13.8. | S.member (show KeywordIndex) containerMapping || S.member (show KeywordType) containerMapping || S.member (show KeywordId) containerMapping -> Array <. fmap Object <. V.concat <$> forM (KM.toList objectValue) \(index, indexValue) -> do -- 13.8.3.1. mapContext <- gets <| jldeStateActiveContext <. eo1314StateJlde let mapContext' = case activeContextPreviousContext mapContext of Just previousContext | S.member (show KeywordId) containerMapping || S.member (show KeywordType) containerMapping -> previousContext _ -> mapContext mapContext'' <- case lookupTerm (K.toText index) mapContext' of -- 13.8.3.2. Just termDefinition | Just localContext <- termDefinitionLocalContext termDefinition , S.member (show KeywordType) containerMapping -> eo1314BuildActiveContext mapContext' localContext (termDefinitionBaseUrl termDefinition) id -- 13.8.3.3. _ -> pure mapContext' -- 13.8.3.4. expandedIndex <- maybe Null String <$> eo1314ExpandIriAC (K.toText index) \params -> params { eiParamsVocab = True } -- 13.8.3.6. indexValue' <- eo1314Expand' mapContext'' (Just <| K.toText key) (Array <| valueToArray indexValue) \params -> params { jldeParamsFromMap = True } -- 13.8.3.7. -- 13.8.3.7.1. let ensureGraphObject item = if S.member (show KeywordGraph) containerMapping && isNotGraphObject item then Object <| toGraphObject item else item forM (valueToArray indexValue') <| ensureGraphObject .> \case Object item -- 13.8.3.7.2. | S.member (show KeywordIndex) containerMapping , indexKey /= show KeywordIndex , expandedIndex /= show KeywordNone -> do -- 13.8.3.7.2.1. reExpandedIndex <- eo1314ExpandValue indexKey (String <| K.toText index) -- 13.8.3.7.2.2. expandedIndexKey <- fmap K.fromText <$> eo1314ExpandIriAC indexKey \params -> params { eiParamsVocab = True } -- 13.8.3.7.2.3. let maybeExistingValues = expandedIndexKey >>= (`KM.lookup` item) indexPropertyValues = V.singleton (Object reExpandedIndex) |> case maybeExistingValues of Just (Array existingValues) -> (<> existingValues) Just existingValue -> (`V.snoc` existingValue) Nothing -> id -- 13.8.3.7.2.4. let item' = case expandedIndexKey of Just eiKey -> item |> KM.insert eiKey (Array indexPropertyValues) Nothing -> item -- 13.8.3.7.2.5. when (isValueObject' item' && KM.size item' > 1) <| throwError InvalidValueObject pure item' -- 13.8.3.7.3. | S.member (show KeywordIndex) containerMapping , not (KM.member (show KeywordIndex) item) , expandedIndex /= show KeywordNone -> pure <. KM.insert (show KeywordIndex) (String <| K.toText index) <| item -- 13.8.3.7.4. | S.member (show KeywordId) containerMapping , not (KM.member (show KeywordId) item) , expandedIndex /= show KeywordNone -> do expandedIndex' <- eo1314ExpandIriAC (K.toText index) \params -> params { eiParamsVocab = False , eiParamsDocumentRelative = True } pure <| KM.insert (show KeywordId) (maybe Null String expandedIndex') item -- 13.8.3.7.5. | S.member (show KeywordType) containerMapping , expandedIndex /= show KeywordNone -> do let types = case KM.lookup (show KeywordType) item of Just existingType -> V.cons expandedIndex <| valueToArray existingType Nothing -> V.singleton expandedIndex pure <. KM.insert (show KeywordType) (Array types) <| item -- 13.8.3.7.6. | otherwise -> pure item -- _ -> pure mempty -- 13.9. _ -> eo1314ExpandAC (Just <| K.toText key) value id -- 13.10. when (expandedValue /= Null) do -- 13.11. let expandedValue' = if S.member (show KeywordList) containerMapping && isNotListObject expandedValue then toListObject expandedValue else expandedValue -- 13.12. let expandedValue'' = if S.member (show KeywordGraph) containerMapping && not (S.member (show KeywordId) containerMapping) && not (S.member (show KeywordIndex) containerMapping) then Array <| Object <. toGraphObject <$> valueToArray expandedValue' else expandedValue' -- 13.13. if maybe False termDefinitionReversePropertyFlag keyTermDefinition then do reverseMap <- gets <| getMapDefault (show KeywordReverse) <. eo1314StateResult -- 13.13.3. 13.13.4. reverseMap' <- (\fn -> foldlM fn reverseMap (valueToArray expandedValue'')) <| \rm item -> if isListObject item || isValueObject item then -- 13.13.4.1. throwError InvalidReversePropertyValue else -- 13.13.4.3. pure <| mapAddValue (K.fromText expandedProperty) item True rm eo1314ModifyResult <| KM.insert (show KeywordReverse) (Object reverseMap') else -- 13.14. eo1314ModifyResult <| mapAddValue (K.fromText expandedProperty) expandedValue'' True eo1314ExpandItem :: Monad m => Maybe Text -> Key -> Value -> EO1314T e m () eo1314ExpandItem _ ((== K.fromText (show KeywordContext)) -> True) _ = pure () -- 13.1. eo1314ExpandItem inputType key value = do -- 13.2. 13.3. maybeExpandedProperty <- eo1314ExpandIriAC (K.toText key) \params -> params { eiParamsDocumentRelative = False , eiParamsVocab = True } case maybeExpandedProperty of Just expandedProperty -- 13.4. | Just keyword <- parseKeyword expandedProperty -> eo1314ExpandKeywordItem inputType key keyword value -- 13.5. | ':' `T.elem` expandedProperty -> eo1314ExpandNonKeywordItem key expandedProperty value -- _ -> pure () eo1314Recurse :: Monad m => Text -> Maybe Text -> Object -> EO1314T e m () eo1314Recurse activeProperty inputType value = do -- 3. 8. activeContext <- gets <| jldeStateActiveContext <. eo1314StateJlde case lookupTerm activeProperty activeContext of Just propertyDefinition | Just propertyContext <- termDefinitionLocalContext propertyDefinition -> do activeContext' <- eo1314BuildActiveContext activeContext propertyContext (termDefinitionBaseUrl propertyDefinition) \params -> params { bacParamsOverrideProtected = True } eo1314ModifyActiveContext <| const activeContext' _ -> pure () expandObject1314' inputType value expandObject1314' :: Monad m => Maybe Text -> Object -> EO1314T e m () expandObject1314' inputType value = do -- 13. iforM_ value <| eo1314ExpandItem inputType -- 14. gets eo1314StateNest >>= mapM_ \nestedKey -> KM.lookup nestedKey value |> fmap valueToArray .> fromMaybe mempty .> mapM_ \case Object nestValue -> do forM_ (KM.keys nestValue) \nestedValueKey -> do -- 14.2.1. expandedNestedValueKey <- eo1314ExpandIriTC (K.toText nestedValueKey) \params -> params{eiParamsVocab = True} when (expandedNestedValueKey == Just (show KeywordValue)) <| throwError (InvalidKeywordValue KeywordNest (Object nestValue)) -- 14.2.2. eo1314ModifyNest <| const mempty eo1314Recurse (K.toText nestedKey) inputType nestValue -- 14.2.1. invalid -> throwError <| InvalidKeywordValue KeywordNest invalid -- eoExpandObject1314 :: Monad m => ActiveContext -> Maybe Text -> Object -> JLDET e m Object eoExpandObject1314 typeContext inputType value = do EO1314State{..} <- (expandObject1314' inputType value >> get) |> withStateRES ( \jld -> EO1314State { eo1314StateJlde = jld , eo1314StateNest = mempty , eo1314StateResult = mempty , eo1314StateTypeContext = typeContext } ) (const eo1314StateJlde) pure eo1314StateResult eoNormalizeObject :: Monad m => Object -> JLDET e m Value eoNormalizeObject result -- 18. | KM.size result == 1 && KM.member (show KeywordLanguage) result = pure Null -- | otherwise = do JLDEEnv{..} <- ask if -- 19.1. | maybe True (== show KeywordGraph) jldeEnvActiveProperty , not jldeEnvFrameExpansion , KM.null result || KM.member (show KeywordValue) result || KM.member (show KeywordList) result -> pure Null -- 19.2. | maybe True (== show KeywordGraph) jldeEnvActiveProperty , not jldeEnvFrameExpansion , KM.size result == 1 , KM.member (show KeywordId) result -> pure Null -- | otherwise -> pure <| Object result expandObject :: Monad m => Maybe Value -> Object -> JLDET e m Value expandObject maybePropertyContext value = do JLDEEnv{..} <- ask -- 7. gets (jldeStateActiveContext .> activeContextPreviousContext) >>= \case Just previousContext | not jldeEnvFromMap -> do noRevert <- flip anyM (KM.keys value) \k -> do expanded <- exExpandIri <| K.toText k pure <| expanded == Just (show KeywordValue) || (expanded == Just (show KeywordId) && KM.size value == 1) unless noRevert <| exModifyActiveContext (const previousContext) -- _ -> pure () -- 8. case (jldeEnvActiveProperty, maybePropertyContext) of (Just activeProperty, Just propertyContext) -> do baseUrl' <- gets (jldeStateActiveContext .> lookupTerm activeProperty >=> termDefinitionBaseUrl) exBuildActiveContext baseUrl' propertyContext \params -> params{bacParamsOverrideProtected = True} -- _ -> pure () -- 9. case KM.lookup (show KeywordContext) value of Just context -> exBuildActiveContext (Just jldeEnvBaseUrl) context id -- _ -> pure () -- 10. typeContext <- gets jldeStateActiveContext -- 11. inputType <- do maybeType <- value |> ifindM \key item -> do -- 11.2. isType <- (Just (show KeywordType) ==) <$> exExpandIri (K.toText key) when isType do valueToArray item |> fmap valueToString .> V.catMaybes .> V.modify V.sort .> mapM_ \term -> case lookupTerm term typeContext >>= termDefinitionLocalContext of Just localContext -> do valueBaseUrl <- gets <| termDefinitionBaseUrl <=< lookupTerm term <. jldeStateActiveContext exBuildActiveContext valueBaseUrl localContext \params -> params { bacParamsPropagate = False } _ -> pure () pure isType case maybeType of Just (Array type') | not (V.null type') -> exExpandIri <. V.maximum <. V.catMaybes <| valueToString <$> type' Just (String type') -> exExpandIri type' -- _ -> pure Nothing -- 13. 14. result <- eoExpandObject1314 typeContext inputType value if -- 15. | Just resultValue <- KM.lookup (show KeywordValue) result -> do -- 15.1. when (isNotValueObject' result) <| throwError InvalidValueObject when ( KM.member (show KeywordType) result && (KM.member (show KeywordDirection) result || KM.member (show KeywordLanguage) result) ) <| throwError InvalidValueObject case KM.lookup (show KeywordType) result of -- 15.2. Just type' | valueContains (show KeywordJson) type' -> do eoNormalizeObject result _ -- 15.3. | resultValue == Null || valueIsEmptyArray resultValue -> pure Null -- 15.4. | not jldeEnvFrameExpansion , valueIsNotString resultValue , KM.member (show KeywordLanguage) result -> throwError InvalidLanguageTaggedValue -- 15.5. Just (String (parseIRI -> Left _)) | not jldeEnvFrameExpansion -> do throwError InvalidTypedValue Just (valueIsNotString -> True) | not jldeEnvFrameExpansion -> do throwError InvalidTypedValue -- _ -> eoNormalizeObject result -- 16. | Just resultType <- KM.lookup (show KeywordType) result -> eoNormalizeObject <| if valueIsNotArray resultType && resultType /= Null then KM.insert (show KeywordType) (Array <| V.singleton resultType) result else result -- 17. | KM.member (show KeywordList) result || KM.member (show KeywordSet) result -> do -- 17.1. when (KM.size result > 2 || (KM.size result == 2 && not (KM.member (show KeywordIndex) result))) <| throwError InvalidSetOrListObject -- 17.2. if | Just (Object set) <- KM.lookup (show KeywordSet) result -> eoNormalizeObject set | Just set <- KM.lookup (show KeywordSet) result -> pure set | otherwise -> eoNormalizeObject result -- | otherwise -> eoNormalizeObject result -- expandArrayItem :: Monad m => Value -> JLDET e m Array expandArrayItem item = do JLDEEnv{..} <- ask -- 5.2.1. item' <- exExpand item id -- 5.2.2. activeContext <- gets jldeStateActiveContext let item'' = case item' of Array a | Just activeProperty <- jldeEnvActiveProperty , Just term <- lookupTerm activeProperty activeContext , S.member (show KeywordList) (termDefinitionContainerMapping term) -> toListObject <| Array a _ -> item' case item'' of -- 5.2.3. Array a -> pure <| V.filter (/= Null) a Null -> pure mempty _ -> pure <| V.singleton item'' -- expandValue :: Monad m => Text -> Value -> JLDET e m Object expandValue activeProperty value = do definition <- gets <| lookupTerm activeProperty <. jldeStateActiveContext case definition >>= termDefinitionTypeMapping of -- 1. 2. Just typeMapping | String stringValue <- value , typeMapping `isKeyword` [KeywordId, KeywordVocab] -> KM.singleton (show KeywordId) <. maybe Null String <$> evExpandIri stringValue \params -> params { eiParamsDocumentRelative = True , eiParamsVocab = typeMapping == show KeywordVocab } -- 3. 4. | typeMapping `isNotKeyword` [KeywordId, KeywordVocab, KeywordNone] -> pure <| KM.fromList [(show KeywordType, String typeMapping), (show KeywordValue, value)] -- 5. _ | String _ <- value -> do defaultLanguage <- gets <| activeContextDefaultLanguage <. jldeStateActiveContext defaultDirection <- gets <| activeContextDefaultBaseDirection <. jldeStateActiveContext -- 5.1. 5.2. 5.3. 5.4. KM.singleton (show KeywordValue) value |> case definition >>= termDefinitionLanguageMapping of Nothing | Just (Language def) <- defaultLanguage -> KM.insert (show KeywordLanguage) (String def) | otherwise -> id Just NoLanguage -> id Just (Language lang) -> KM.insert (show KeywordLanguage) (String lang) |> case definition >>= termDefinitionDirectionMapping of Nothing | Just def <- defaultDirection -> KM.insert (show KeywordDirection) (show def) | otherwise -> id Just NoDirection -> id Just dir -> KM.insert (show KeywordDirection) (show dir) |> pure -- 6. _ -> pure <| KM.singleton (show KeywordValue) value -- exModifyActiveContext :: Monad m => (ActiveContext -> ActiveContext) -> JLDET e m () exModifyActiveContext fn = modify \st -> st{jldeStateActiveContext = fn (jldeStateActiveContext st)} evExpandIri :: Monad m => Text -> (EIParams -> EIParams) -> JLDET e m (Maybe Text) evExpandIri value fn = do JLDEEnv{..} <- ask activeContext <- gets jldeStateActiveContext (value', activeContext', _) <- expandIri activeContext value fn |> withEnvRES (const jldeEnvGlobal) |> withStateRES jldeStateGlobal (\s jlde -> s{jldeStateGlobal = jlde}) exModifyActiveContext <| const activeContext' pure value' exExpandIri :: Monad m => Text -> JLDET e m (Maybe Text) exExpandIri value = do JLDEEnv{..} <- ask activeContext <- gets jldeStateActiveContext let params p = p{eiParamsVocab = True} (value', activeContext', _) <- expandIri activeContext value params |> withEnvRES (const jldeEnvGlobal) |> withStateRES jldeStateGlobal (\s jlde -> s{jldeStateGlobal = jlde}) exModifyActiveContext <| const activeContext' pure value' exBuildActiveContext :: Monad m => Maybe URI -> Value -> (BACParams -> BACParams) -> JLDET e m () exBuildActiveContext baseUrl localContext fn = do JLDEEnv{..} <- ask activeContext <- gets jldeStateActiveContext activeContext' <- buildActiveContext activeContext localContext baseUrl fn |> withEnvRES (const jldeEnvGlobal) |> withStateRES jldeStateGlobal (\s jlde -> s{jldeStateGlobal = jlde}) exModifyActiveContext (const activeContext') exExpand :: Monad m => Value -> (JLDEParams -> JLDEParams) -> JLDET e m Value exExpand value fn = do JLDEEnv{..} <- ask activeContext <- gets jldeStateActiveContext let params p = fn p{jldeParamsActiveProperty = jldeEnvActiveProperty} expand activeContext value jldeEnvBaseUrl params |> withEnvRES (const jldeEnvGlobal) |> withStateRES jldeStateGlobal (\s jlde -> s{jldeStateGlobal = jlde}) expand' :: Monad m => Value -> JLDET e m Value expand' = \case -- 1. Null -> pure Null -- 5. Array value -> Array <. V.concat <. V.toList <$> forM value expandArrayItem -- 6. Object value -> do JLDEEnv{..} <- ask -- 3. maybePropertyContext <- case jldeEnvActiveProperty of Just activeProperty -> gets (jldeStateActiveContext .> lookupTerm activeProperty >=> termDefinitionLocalContext) Nothing -> pure Nothing -- 6. expandObject maybePropertyContext value |> withEnvRES \env -> env{jldeEnvFrameExpansion = jldeEnvFrameExpansion && maybePropertyContext /= Just (show KeywordDefault)} -- 4. value -> do JLDEEnv{..} <- ask maybePropertyTerm <- case jldeEnvActiveProperty of Just activeProperty -> gets <| lookupTerm activeProperty <. jldeStateActiveContext Nothing -> pure Nothing case jldeEnvActiveProperty of -- 4.1. Nothing -> pure Null -- Just activeProperty -- 4.1. | activeProperty == show KeywordGraph -> pure Null -- 4.2. | Just propertyTerm <- maybePropertyTerm , Just propertyContext <- termDefinitionLocalContext propertyTerm -> do exBuildActiveContext (termDefinitionBaseUrl propertyTerm) propertyContext id Object <$> expandValue activeProperty value -- 4.3. | otherwise -> Object <$> expandValue activeProperty value expand :: Monad m => ActiveContext -> Value -> URI -> (JLDEParams -> JLDEParams) -> JLDExpansionT e m Value expand activeContext value baseUrl paramsFn = expand' value |> withEnvRES env |> withStateRES st (const jldeStateGlobal) where JLDEParams{..} = paramsFn JLDEParams { jldeParamsFrameExpansion = False , jldeParamsFromMap = False , jldeParamsBaseUrl = baseUrl , jldeParamsActiveProperty = Nothing } env global = JLDEEnv { jldeEnvGlobal = global , jldeEnvFrameExpansion = jldeParamsFrameExpansion , jldeEnvFromMap = jldeParamsFromMap , jldeEnvBaseUrl = jldeParamsBaseUrl , jldeEnvActiveProperty = jldeParamsActiveProperty } st global = JLDEState { jldeStateGlobal = global , jldeStateActiveContext = activeContext }