From 11d0fb47c292a0ca25a9c377499d2b221d97a5cb Mon Sep 17 00:00:00 2001 From: Volpeon Date: Fri, 26 May 2023 07:40:13 +0200 Subject: Init --- src/Data/JLD/Model/ActiveContext.hs | 44 ++++++++++++ src/Data/JLD/Model/Direction.hs | 13 ++++ src/Data/JLD/Model/GraphObject.hs | 22 ++++++ src/Data/JLD/Model/IRI.hs | 46 ++++++++++++ src/Data/JLD/Model/InverseContext.hs | 5 ++ src/Data/JLD/Model/Keyword.hs | 135 +++++++++++++++++++++++++++++++++++ src/Data/JLD/Model/Language.hs | 6 ++ src/Data/JLD/Model/ListObject.hs | 24 +++++++ src/Data/JLD/Model/NodeObject.hs | 21 ++++++ src/Data/JLD/Model/TermDefinition.hs | 43 +++++++++++ src/Data/JLD/Model/URI.hs | 13 ++++ src/Data/JLD/Model/ValueObject.hs | 27 +++++++ 12 files changed, 399 insertions(+) create mode 100644 src/Data/JLD/Model/ActiveContext.hs create mode 100644 src/Data/JLD/Model/Direction.hs create mode 100644 src/Data/JLD/Model/GraphObject.hs create mode 100644 src/Data/JLD/Model/IRI.hs create mode 100644 src/Data/JLD/Model/InverseContext.hs create mode 100644 src/Data/JLD/Model/Keyword.hs create mode 100644 src/Data/JLD/Model/Language.hs create mode 100644 src/Data/JLD/Model/ListObject.hs create mode 100644 src/Data/JLD/Model/NodeObject.hs create mode 100644 src/Data/JLD/Model/TermDefinition.hs create mode 100644 src/Data/JLD/Model/URI.hs create mode 100644 src/Data/JLD/Model/ValueObject.hs (limited to 'src/Data/JLD/Model') diff --git a/src/Data/JLD/Model/ActiveContext.hs b/src/Data/JLD/Model/ActiveContext.hs new file mode 100644 index 0000000..5423036 --- /dev/null +++ b/src/Data/JLD/Model/ActiveContext.hs @@ -0,0 +1,44 @@ +module Data.JLD.Model.ActiveContext ( ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm,) where + +import Data.JLD.Prelude + +import Data.JLD.Model.Direction (Direction) +import Data.JLD.Model.InverseContext (InverseContext) +import Data.JLD.Model.Language (Language) +import Data.JLD.Model.TermDefinition (TermDefinition (..)) + +import Data.Map.Strict qualified as M (lookup) +import Data.RDF (IRIRef) +import Text.URI (URI) + +data ActiveContext = ActiveContext + { activeContextTerms :: Map Text TermDefinition + , activeContextBaseIri :: Maybe IRIRef + , activeContextBaseUrl :: Maybe URI + , activeContextInverseContext :: InverseContext + , activeContextPreviousContext :: Maybe ActiveContext + , activeContextVocabularyMapping :: Maybe Text + , activeContextDefaultLanguage :: Maybe Language + , activeContextDefaultBaseDirection :: Maybe Direction + } + deriving (Eq, Show) + +newActiveContext :: (ActiveContext -> ActiveContext) -> ActiveContext +newActiveContext fn = + fn + ActiveContext + { activeContextTerms = mempty + , activeContextBaseIri = Nothing + , activeContextBaseUrl = Nothing + , activeContextInverseContext = mempty + , activeContextPreviousContext = Nothing + , activeContextVocabularyMapping = Nothing + , activeContextDefaultLanguage = Nothing + , activeContextDefaultBaseDirection = Nothing + } + +lookupTerm :: Text -> ActiveContext -> Maybe TermDefinition +lookupTerm key ActiveContext{..} = M.lookup key activeContextTerms + +containsProtectedTerm :: ActiveContext -> Bool +containsProtectedTerm = activeContextTerms .> any termDefinitionProtectedFlag diff --git a/src/Data/JLD/Model/Direction.hs b/src/Data/JLD/Model/Direction.hs new file mode 100644 index 0000000..2ed8e87 --- /dev/null +++ b/src/Data/JLD/Model/Direction.hs @@ -0,0 +1,13 @@ +module Data.JLD.Model.Direction (Direction (..)) where + +import Data.JLD.Prelude + +import Text.Show (Show (..)) + +data Direction = LTR | RTL | NoDirection + deriving (Eq, Ord) + +instance Show Direction where + show LTR = "ltr" + show RTL = "rtl" + show NoDirection = "none" diff --git a/src/Data/JLD/Model/GraphObject.hs b/src/Data/JLD/Model/GraphObject.hs new file mode 100644 index 0000000..3db9e6b --- /dev/null +++ b/src/Data/JLD/Model/GraphObject.hs @@ -0,0 +1,22 @@ +module Data.JLD.Model.GraphObject (isGraphObject, isNotGraphObject, toGraphObject) where + +import Data.JLD.Prelude + +import Data.JLD.Model.Keyword (Keyword (..), isKeyword) + +import Data.Aeson (Object, Value (..)) +import Data.Aeson.Key qualified as K (toText) +import Data.Aeson.KeyMap qualified as KM (keys, singleton, member) +import Data.Vector qualified as V (singleton) + +isGraphObject :: Value -> Bool +isGraphObject (Object o) + | KM.member (show KeywordGraph) o = + all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o) +isGraphObject _ = False + +isNotGraphObject :: Value -> Bool +isNotGraphObject = isGraphObject .> not + +toGraphObject :: Value -> Object +toGraphObject = V.singleton .> Array .> KM.singleton (show KeywordGraph) diff --git a/src/Data/JLD/Model/IRI.hs b/src/Data/JLD/Model/IRI.hs new file mode 100644 index 0000000..7c054eb --- /dev/null +++ b/src/Data/JLD/Model/IRI.hs @@ -0,0 +1,46 @@ +module Data.JLD.Model.IRI ( + CompactIRI (..), + compactIriPrefix, + compactIriSuffix, + isBlankIri, + endsWithGenericDelim, + parseCompactIri, + renderCompactIri, +) where + +import Data.JLD.Prelude + +import Data.Char (isAlphaNum) +import Data.Text qualified as T (drop, findIndex, isPrefixOf, take, uncons, unsnoc) + +data CompactIRI = CompactIRI Text Text | BlankIRI Text + deriving (Show, Eq) + +compactIriPrefix :: CompactIRI -> Text +compactIriPrefix (CompactIRI prefix _) = prefix +compactIriPrefix (BlankIRI _) = "_" + +compactIriSuffix :: CompactIRI -> Text +compactIriSuffix (CompactIRI _ suffix) = suffix +compactIriSuffix (BlankIRI suffix) = suffix + +renderCompactIri :: CompactIRI -> Text +renderCompactIri iri = compactIriPrefix iri <> ":" <> compactIriSuffix iri + +parseCompactIri :: Text -> Maybe CompactIRI +parseCompactIri value + | Just idx <- (+ 1) <$> T.findIndex (== ':') (T.drop 1 value) + , prefix <- T.take idx value + , suffix <- T.drop (idx + 1) value + , not ("/" `T.isPrefixOf` suffix) + , Just (prefixFirst, _) <- T.uncons prefix + , prefixFirst == '_' || isAlphaNum prefixFirst = + Just <| if prefix == "_" then BlankIRI suffix else CompactIRI prefix suffix + | otherwise = Nothing + +isBlankIri :: Text -> Bool +isBlankIri = T.isPrefixOf "_:" + +endsWithGenericDelim :: Text -> Bool +endsWithGenericDelim (T.unsnoc -> Just (_, c)) = c `elem` (":/?#[]@" :: String) +endsWithGenericDelim _ = False diff --git a/src/Data/JLD/Model/InverseContext.hs b/src/Data/JLD/Model/InverseContext.hs new file mode 100644 index 0000000..fe4b516 --- /dev/null +++ b/src/Data/JLD/Model/InverseContext.hs @@ -0,0 +1,5 @@ +module Data.JLD.Model.InverseContext (InverseContext) where + +import Data.JLD.Prelude + +type InverseContext = Map (Text, Text, Text, Text) Text diff --git a/src/Data/JLD/Model/Keyword.hs b/src/Data/JLD/Model/Keyword.hs new file mode 100644 index 0000000..10835a9 --- /dev/null +++ b/src/Data/JLD/Model/Keyword.hs @@ -0,0 +1,135 @@ +module Data.JLD.Model.Keyword ( + Keyword (..), + parseKeyword, + isKeyword, + isNotKeyword, + allKeywords, + isKeywordLike, +) where + +import Data.JLD.Prelude hiding (show) + +import Data.Char (isAlpha) +import Data.Foldable qualified as F +import Data.Text qualified as T (all, null, uncons) +import Text.Show (Show (..)) + +data Keyword + = KeywordAny + | KeywordBase + | KeywordContainer + | KeywordContext + | KeywordDefault + | KeywordDirection + | KeywordEmbed + | KeywordExplicit + | KeywordFirst + | KeywordGraph + | KeywordId + | KeywordImport + | KeywordIncluded + | KeywordIndex + | KeywordJson + | KeywordLanguage + | KeywordList + | KeywordNest + | KeywordNone + | KeywordNull + | KeywordOmitDefault + | KeywordPrefix + | KeywordPreserve + | KeywordPropagate + | KeywordProtected + | KeywordRequireAll + | KeywordReverse + | KeywordSet + | KeywordType + | KeywordValue + | KeywordVersion + | KeywordVocab + deriving (Eq, Ord) + +instance Show Keyword where + show = \case + KeywordAny -> "@any" + KeywordBase -> "@base" + KeywordContainer -> "@container" + KeywordContext -> "@context" + KeywordDefault -> "@default" + KeywordDirection -> "@direction" + KeywordEmbed -> "@embed" + KeywordExplicit -> "@explicit" + KeywordFirst -> "@first" + KeywordGraph -> "@graph" + KeywordId -> "@id" + KeywordImport -> "@import" + KeywordIncluded -> "@included" + KeywordIndex -> "@index" + KeywordJson -> "@json" + KeywordLanguage -> "@language" + KeywordList -> "@list" + KeywordNest -> "@nest" + KeywordNone -> "@none" + KeywordNull -> "@null" + KeywordOmitDefault -> "@omitDefault" + KeywordPrefix -> "@prefix" + KeywordPreserve -> "@preserve" + KeywordPropagate -> "@propagate" + KeywordProtected -> "@protected" + KeywordRequireAll -> "@requireAll" + KeywordReverse -> "@reverse" + KeywordSet -> "@set" + KeywordType -> "@type" + KeywordValue -> "@value" + KeywordVersion -> "@version" + KeywordVocab -> "@vocab" + +parseKeyword :: Text -> Maybe Keyword +parseKeyword = \case + "@any" -> Just KeywordAny + "@base" -> Just KeywordBase + "@container" -> Just KeywordContainer + "@context" -> Just KeywordContext + "@default" -> Just KeywordDefault + "@direction" -> Just KeywordDirection + "@embed" -> Just KeywordEmbed + "@explicit" -> Just KeywordExplicit + "@first" -> Just KeywordFirst + "@graph" -> Just KeywordGraph + "@id" -> Just KeywordId + "@import" -> Just KeywordImport + "@included" -> Just KeywordIncluded + "@index" -> Just KeywordIndex + "@json" -> Just KeywordJson + "@language" -> Just KeywordLanguage + "@list" -> Just KeywordList + "@nest" -> Just KeywordNest + "@none" -> Just KeywordNone + "@null" -> Just KeywordNull + "@omitDefault" -> Just KeywordOmitDefault + "@prefix" -> Just KeywordPrefix + "@preserve" -> Just KeywordPreserve + "@propagate" -> Just KeywordPropagate + "@protected" -> Just KeywordProtected + "@requireAll" -> Just KeywordRequireAll + "@reverse" -> Just KeywordReverse + "@set" -> Just KeywordSet + "@type" -> Just KeywordType + "@value" -> Just KeywordValue + "@version" -> Just KeywordVersion + "@vocab" -> Just KeywordVocab + _ -> Nothing + +isKeyword :: Foldable f => Text -> f Keyword -> Bool +isKeyword (parseKeyword -> Just keyword) (F.elem keyword -> True) = True +isKeyword _ _ = False + +isNotKeyword :: Foldable f => Text -> f Keyword -> Bool +isNotKeyword s = isKeyword s .> not + +allKeywords :: Foldable f => f Text -> f Keyword -> Bool +allKeywords values keywords = all (`isKeyword` keywords) values + +isKeywordLike :: Text -> Bool +isKeywordLike (T.uncons -> Just ('@', res)) = not (T.null res) && T.all isAlpha res +isKeywordLike _ = False diff --git a/src/Data/JLD/Model/Language.hs b/src/Data/JLD/Model/Language.hs new file mode 100644 index 0000000..c24994e --- /dev/null +++ b/src/Data/JLD/Model/Language.hs @@ -0,0 +1,6 @@ +module Data.JLD.Model.Language (Language (..)) where + +import Data.JLD.Prelude + +data Language = Language Text | NoLanguage + deriving (Show, Eq) diff --git a/src/Data/JLD/Model/ListObject.hs b/src/Data/JLD/Model/ListObject.hs new file mode 100644 index 0000000..8dda349 --- /dev/null +++ b/src/Data/JLD/Model/ListObject.hs @@ -0,0 +1,24 @@ +module Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) where + +import Data.JLD.Prelude + +import Data.JLD.Model.Keyword (Keyword (..)) + +import Data.Aeson (Value (..)) +import Data.Aeson.KeyMap qualified as KM +import Data.Vector qualified as V + +isListObject :: Value -> Bool +isListObject (Object o) = + KM.member (show KeywordList) o + && ( KM.size o == 1 + || (KM.size o == 2 && KM.member (show KeywordIndex) o) + ) +isListObject _ = False + +isNotListObject :: Value -> Bool +isNotListObject = isListObject .> not + +toListObject :: Value -> Value +toListObject value@(Array _) = Object <| KM.singleton (show KeywordList) value +toListObject value = Object <| KM.singleton (show KeywordList) (Array <| V.singleton value) diff --git a/src/Data/JLD/Model/NodeObject.hs b/src/Data/JLD/Model/NodeObject.hs new file mode 100644 index 0000000..d0bb4c5 --- /dev/null +++ b/src/Data/JLD/Model/NodeObject.hs @@ -0,0 +1,21 @@ +module Data.JLD.Model.NodeObject (isNodeObject, isNotNodeObject) where + +import Data.JLD.Prelude + +import Data.JLD.Model.Keyword (Keyword (..)) + +import Data.Aeson (Value (..)) +import Data.Aeson.Key qualified as K +import Data.Aeson.KeyMap qualified as KM + +isNodeObject :: Value -> Bool +isNodeObject (Object o) = + ( not (KM.member (show KeywordValue) o) + && not (KM.member (show KeywordList) o) + && not (KM.member (show KeywordSet) o) + ) + || (KM.keys o == ([KeywordContext, KeywordGraph] <&> show .> K.fromText)) +isNodeObject _ = False + +isNotNodeObject :: Value -> Bool +isNotNodeObject = isNodeObject .> not diff --git a/src/Data/JLD/Model/TermDefinition.hs b/src/Data/JLD/Model/TermDefinition.hs new file mode 100644 index 0000000..5f39eee --- /dev/null +++ b/src/Data/JLD/Model/TermDefinition.hs @@ -0,0 +1,43 @@ +module Data.JLD.Model.TermDefinition (TermDefinition (..), newTermDefinition) where + +import Data.JLD.Prelude + +import Data.JLD.Model.Direction (Direction) +import Data.JLD.Model.Language (Language) + +import Data.Aeson (Value) +import Text.URI (URI) + +data TermDefinition = TermDefinition + { termDefinitionIriMapping :: Maybe Text + , termDefinitionPrefixFlag :: Bool + , termDefinitionProtectedFlag :: Bool + , termDefinitionReversePropertyFlag :: Bool + , termDefinitionBaseUrl :: Maybe URI + , termDefinitionLocalContext :: Maybe Value + , termDefinitionContainerMapping :: Set Text + , termDefinitionIndexMapping :: Maybe Text + , termDefinitionNestValue :: Maybe Text + , termDefinitionTypeMapping :: Maybe Text + , termDefinitionDirectionMapping :: Maybe Direction + , termDefinitionLanguageMapping :: Maybe Language + } + deriving (Show, Eq) + +newTermDefinition :: Bool -> (TermDefinition -> TermDefinition) -> TermDefinition +newTermDefinition protectedFlag fn = + fn + TermDefinition + { termDefinitionIriMapping = Nothing + , termDefinitionPrefixFlag = False + , termDefinitionProtectedFlag = protectedFlag + , termDefinitionReversePropertyFlag = False + , termDefinitionBaseUrl = Nothing + , termDefinitionLocalContext = Nothing + , termDefinitionContainerMapping = mempty + , termDefinitionIndexMapping = Nothing + , termDefinitionNestValue = Nothing + , termDefinitionTypeMapping = Nothing + , termDefinitionDirectionMapping = Nothing + , termDefinitionLanguageMapping = Nothing + } diff --git a/src/Data/JLD/Model/URI.hs b/src/Data/JLD/Model/URI.hs new file mode 100644 index 0000000..07cf8a9 --- /dev/null +++ b/src/Data/JLD/Model/URI.hs @@ -0,0 +1,13 @@ +module Data.JLD.Model.URI (parseUri, uriToIri) where + +import Data.JLD.Prelude + +import Data.RDF (IRIRef, parseIRI) +import Text.Megaparsec (MonadParsec (..), Parsec, runParser) +import Text.URI (URI, parser, render) + +parseUri :: Text -> Maybe URI +parseUri = runParser (parser <* eof :: Parsec Void Text URI) "" .> either (const Nothing) Just + +uriToIri :: URI -> Maybe IRIRef +uriToIri = render .> parseIRI .> either (const Nothing) Just diff --git a/src/Data/JLD/Model/ValueObject.hs b/src/Data/JLD/Model/ValueObject.hs new file mode 100644 index 0000000..79bd94f --- /dev/null +++ b/src/Data/JLD/Model/ValueObject.hs @@ -0,0 +1,27 @@ +module Data.JLD.Model.ValueObject (isValueObject, isValueObject', isNotValueObject, isNotValueObject', valueObjectValue) where + +import Data.JLD.Prelude + +import Data.JLD.Model.Keyword (Keyword (..), isNotKeyword) + +import Data.Aeson (Object, Value (..)) +import Data.Aeson.Key qualified as K +import Data.Aeson.KeyMap qualified as KM + +isValueObject :: Value -> Bool +isValueObject (Object o) = isValueObject' o +isValueObject _ = False + +isValueObject' :: Object -> Bool +isValueObject' = KM.member (show KeywordValue) + +isNotValueObject :: Value -> Bool +isNotValueObject (Object o) = isNotValueObject' o +isNotValueObject _ = False + +isNotValueObject' :: Object -> Bool +isNotValueObject' = KM.keys .> fmap K.toText .> any (`isNotKeyword` [KeywordType, KeywordValue, KeywordDirection, KeywordLanguage, KeywordIndex]) + +valueObjectValue :: Value -> Maybe Value +valueObjectValue (Object o) = KM.lookup (show KeywordValue) o +valueObjectValue _ = Nothing -- cgit v1.2.3-70-g09d2