aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD/Model
diff options
context:
space:
mode:
authorVolpeon <github@volpeon.ink>2023-05-26 07:40:13 +0200
committerVolpeon <github@volpeon.ink>2023-05-26 07:40:13 +0200
commit11d0fb47c292a0ca25a9c377499d2b221d97a5cb (patch)
treee729e2a4508763b3073b7eae9a56bc9c6a9ca0f7 /src/Data/JLD/Model
downloadhs-jsonld-11d0fb47c292a0ca25a9c377499d2b221d97a5cb.tar.gz
hs-jsonld-11d0fb47c292a0ca25a9c377499d2b221d97a5cb.tar.bz2
hs-jsonld-11d0fb47c292a0ca25a9c377499d2b221d97a5cb.zip
Init
Diffstat (limited to 'src/Data/JLD/Model')
-rw-r--r--src/Data/JLD/Model/ActiveContext.hs44
-rw-r--r--src/Data/JLD/Model/Direction.hs13
-rw-r--r--src/Data/JLD/Model/GraphObject.hs22
-rw-r--r--src/Data/JLD/Model/IRI.hs46
-rw-r--r--src/Data/JLD/Model/InverseContext.hs5
-rw-r--r--src/Data/JLD/Model/Keyword.hs135
-rw-r--r--src/Data/JLD/Model/Language.hs6
-rw-r--r--src/Data/JLD/Model/ListObject.hs24
-rw-r--r--src/Data/JLD/Model/NodeObject.hs21
-rw-r--r--src/Data/JLD/Model/TermDefinition.hs43
-rw-r--r--src/Data/JLD/Model/URI.hs13
-rw-r--r--src/Data/JLD/Model/ValueObject.hs27
12 files changed, 399 insertions, 0 deletions
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 @@
1module Data.JLD.Model.ActiveContext ( ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm,) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Model.Direction (Direction)
6import Data.JLD.Model.InverseContext (InverseContext)
7import Data.JLD.Model.Language (Language)
8import Data.JLD.Model.TermDefinition (TermDefinition (..))
9
10import Data.Map.Strict qualified as M (lookup)
11import Data.RDF (IRIRef)
12import Text.URI (URI)
13
14data ActiveContext = ActiveContext
15 { activeContextTerms :: Map Text TermDefinition
16 , activeContextBaseIri :: Maybe IRIRef
17 , activeContextBaseUrl :: Maybe URI
18 , activeContextInverseContext :: InverseContext
19 , activeContextPreviousContext :: Maybe ActiveContext
20 , activeContextVocabularyMapping :: Maybe Text
21 , activeContextDefaultLanguage :: Maybe Language
22 , activeContextDefaultBaseDirection :: Maybe Direction
23 }
24 deriving (Eq, Show)
25
26newActiveContext :: (ActiveContext -> ActiveContext) -> ActiveContext
27newActiveContext fn =
28 fn
29 ActiveContext
30 { activeContextTerms = mempty
31 , activeContextBaseIri = Nothing
32 , activeContextBaseUrl = Nothing
33 , activeContextInverseContext = mempty
34 , activeContextPreviousContext = Nothing
35 , activeContextVocabularyMapping = Nothing
36 , activeContextDefaultLanguage = Nothing
37 , activeContextDefaultBaseDirection = Nothing
38 }
39
40lookupTerm :: Text -> ActiveContext -> Maybe TermDefinition
41lookupTerm key ActiveContext{..} = M.lookup key activeContextTerms
42
43containsProtectedTerm :: ActiveContext -> Bool
44containsProtectedTerm = 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 @@
1module Data.JLD.Model.Direction (Direction (..)) where
2
3import Data.JLD.Prelude
4
5import Text.Show (Show (..))
6
7data Direction = LTR | RTL | NoDirection
8 deriving (Eq, Ord)
9
10instance Show Direction where
11 show LTR = "ltr"
12 show RTL = "rtl"
13 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 @@
1module Data.JLD.Model.GraphObject (isGraphObject, isNotGraphObject, toGraphObject) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Model.Keyword (Keyword (..), isKeyword)
6
7import Data.Aeson (Object, Value (..))
8import Data.Aeson.Key qualified as K (toText)
9import Data.Aeson.KeyMap qualified as KM (keys, singleton, member)
10import Data.Vector qualified as V (singleton)
11
12isGraphObject :: Value -> Bool
13isGraphObject (Object o)
14 | KM.member (show KeywordGraph) o =
15 all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o)
16isGraphObject _ = False
17
18isNotGraphObject :: Value -> Bool
19isNotGraphObject = isGraphObject .> not
20
21toGraphObject :: Value -> Object
22toGraphObject = 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 @@
1module Data.JLD.Model.IRI (
2 CompactIRI (..),
3 compactIriPrefix,
4 compactIriSuffix,
5 isBlankIri,
6 endsWithGenericDelim,
7 parseCompactIri,
8 renderCompactIri,
9) where
10
11import Data.JLD.Prelude
12
13import Data.Char (isAlphaNum)
14import Data.Text qualified as T (drop, findIndex, isPrefixOf, take, uncons, unsnoc)
15
16data CompactIRI = CompactIRI Text Text | BlankIRI Text
17 deriving (Show, Eq)
18
19compactIriPrefix :: CompactIRI -> Text
20compactIriPrefix (CompactIRI prefix _) = prefix
21compactIriPrefix (BlankIRI _) = "_"
22
23compactIriSuffix :: CompactIRI -> Text
24compactIriSuffix (CompactIRI _ suffix) = suffix
25compactIriSuffix (BlankIRI suffix) = suffix
26
27renderCompactIri :: CompactIRI -> Text
28renderCompactIri iri = compactIriPrefix iri <> ":" <> compactIriSuffix iri
29
30parseCompactIri :: Text -> Maybe CompactIRI
31parseCompactIri value
32 | Just idx <- (+ 1) <$> T.findIndex (== ':') (T.drop 1 value)
33 , prefix <- T.take idx value
34 , suffix <- T.drop (idx + 1) value
35 , not ("/" `T.isPrefixOf` suffix)
36 , Just (prefixFirst, _) <- T.uncons prefix
37 , prefixFirst == '_' || isAlphaNum prefixFirst =
38 Just <| if prefix == "_" then BlankIRI suffix else CompactIRI prefix suffix
39 | otherwise = Nothing
40
41isBlankIri :: Text -> Bool
42isBlankIri = T.isPrefixOf "_:"
43
44endsWithGenericDelim :: Text -> Bool
45endsWithGenericDelim (T.unsnoc -> Just (_, c)) = c `elem` (":/?#[]@" :: String)
46endsWithGenericDelim _ = 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 @@
1module Data.JLD.Model.InverseContext (InverseContext) where
2
3import Data.JLD.Prelude
4
5type 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 @@
1module Data.JLD.Model.Keyword (
2 Keyword (..),
3 parseKeyword,
4 isKeyword,
5 isNotKeyword,
6 allKeywords,
7 isKeywordLike,
8) where
9
10import Data.JLD.Prelude hiding (show)
11
12import Data.Char (isAlpha)
13import Data.Foldable qualified as F
14import Data.Text qualified as T (all, null, uncons)
15import Text.Show (Show (..))
16
17data Keyword
18 = KeywordAny
19 | KeywordBase
20 | KeywordContainer
21 | KeywordContext
22 | KeywordDefault
23 | KeywordDirection
24 | KeywordEmbed
25 | KeywordExplicit
26 | KeywordFirst
27 | KeywordGraph
28 | KeywordId
29 | KeywordImport
30 | KeywordIncluded
31 | KeywordIndex
32 | KeywordJson
33 | KeywordLanguage
34 | KeywordList
35 | KeywordNest
36 | KeywordNone
37 | KeywordNull
38 | KeywordOmitDefault
39 | KeywordPrefix
40 | KeywordPreserve
41 | KeywordPropagate
42 | KeywordProtected
43 | KeywordRequireAll
44 | KeywordReverse
45 | KeywordSet
46 | KeywordType
47 | KeywordValue
48 | KeywordVersion
49 | KeywordVocab
50 deriving (Eq, Ord)
51
52instance Show Keyword where
53 show = \case
54 KeywordAny -> "@any"
55 KeywordBase -> "@base"
56 KeywordContainer -> "@container"
57 KeywordContext -> "@context"
58 KeywordDefault -> "@default"
59 KeywordDirection -> "@direction"
60 KeywordEmbed -> "@embed"
61 KeywordExplicit -> "@explicit"
62 KeywordFirst -> "@first"
63 KeywordGraph -> "@graph"
64 KeywordId -> "@id"
65 KeywordImport -> "@import"
66 KeywordIncluded -> "@included"
67 KeywordIndex -> "@index"
68 KeywordJson -> "@json"
69 KeywordLanguage -> "@language"
70 KeywordList -> "@list"
71 KeywordNest -> "@nest"
72 KeywordNone -> "@none"
73 KeywordNull -> "@null"
74 KeywordOmitDefault -> "@omitDefault"
75 KeywordPrefix -> "@prefix"
76 KeywordPreserve -> "@preserve"
77 KeywordPropagate -> "@propagate"
78 KeywordProtected -> "@protected"
79 KeywordRequireAll -> "@requireAll"
80 KeywordReverse -> "@reverse"
81 KeywordSet -> "@set"
82 KeywordType -> "@type"
83 KeywordValue -> "@value"
84 KeywordVersion -> "@version"
85 KeywordVocab -> "@vocab"
86
87parseKeyword :: Text -> Maybe Keyword
88parseKeyword = \case
89 "@any" -> Just KeywordAny
90 "@base" -> Just KeywordBase
91 "@container" -> Just KeywordContainer
92 "@context" -> Just KeywordContext
93 "@default" -> Just KeywordDefault
94 "@direction" -> Just KeywordDirection
95 "@embed" -> Just KeywordEmbed
96 "@explicit" -> Just KeywordExplicit
97 "@first" -> Just KeywordFirst
98 "@graph" -> Just KeywordGraph
99 "@id" -> Just KeywordId
100 "@import" -> Just KeywordImport
101 "@included" -> Just KeywordIncluded
102 "@index" -> Just KeywordIndex
103 "@json" -> Just KeywordJson
104 "@language" -> Just KeywordLanguage
105 "@list" -> Just KeywordList
106 "@nest" -> Just KeywordNest
107 "@none" -> Just KeywordNone
108 "@null" -> Just KeywordNull
109 "@omitDefault" -> Just KeywordOmitDefault
110 "@prefix" -> Just KeywordPrefix
111 "@preserve" -> Just KeywordPreserve
112 "@propagate" -> Just KeywordPropagate
113 "@protected" -> Just KeywordProtected
114 "@requireAll" -> Just KeywordRequireAll
115 "@reverse" -> Just KeywordReverse
116 "@set" -> Just KeywordSet
117 "@type" -> Just KeywordType
118 "@value" -> Just KeywordValue
119 "@version" -> Just KeywordVersion
120 "@vocab" -> Just KeywordVocab
121 _ -> Nothing
122
123isKeyword :: Foldable f => Text -> f Keyword -> Bool
124isKeyword (parseKeyword -> Just keyword) (F.elem keyword -> True) = True
125isKeyword _ _ = False
126
127isNotKeyword :: Foldable f => Text -> f Keyword -> Bool
128isNotKeyword s = isKeyword s .> not
129
130allKeywords :: Foldable f => f Text -> f Keyword -> Bool
131allKeywords values keywords = all (`isKeyword` keywords) values
132
133isKeywordLike :: Text -> Bool
134isKeywordLike (T.uncons -> Just ('@', res)) = not (T.null res) && T.all isAlpha res
135isKeywordLike _ = 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 @@
1module Data.JLD.Model.Language (Language (..)) where
2
3import Data.JLD.Prelude
4
5data Language = Language Text | NoLanguage
6 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 @@
1module Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Model.Keyword (Keyword (..))
6
7import Data.Aeson (Value (..))
8import Data.Aeson.KeyMap qualified as KM
9import Data.Vector qualified as V
10
11isListObject :: Value -> Bool
12isListObject (Object o) =
13 KM.member (show KeywordList) o
14 && ( KM.size o == 1
15 || (KM.size o == 2 && KM.member (show KeywordIndex) o)
16 )
17isListObject _ = False
18
19isNotListObject :: Value -> Bool
20isNotListObject = isListObject .> not
21
22toListObject :: Value -> Value
23toListObject value@(Array _) = Object <| KM.singleton (show KeywordList) value
24toListObject 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 @@
1module Data.JLD.Model.NodeObject (isNodeObject, isNotNodeObject) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Model.Keyword (Keyword (..))
6
7import Data.Aeson (Value (..))
8import Data.Aeson.Key qualified as K
9import Data.Aeson.KeyMap qualified as KM
10
11isNodeObject :: Value -> Bool
12isNodeObject (Object o) =
13 ( not (KM.member (show KeywordValue) o)
14 && not (KM.member (show KeywordList) o)
15 && not (KM.member (show KeywordSet) o)
16 )
17 || (KM.keys o == ([KeywordContext, KeywordGraph] <&> show .> K.fromText))
18isNodeObject _ = False
19
20isNotNodeObject :: Value -> Bool
21isNotNodeObject = 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 @@
1module Data.JLD.Model.TermDefinition (TermDefinition (..), newTermDefinition) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Model.Direction (Direction)
6import Data.JLD.Model.Language (Language)
7
8import Data.Aeson (Value)
9import Text.URI (URI)
10
11data TermDefinition = TermDefinition
12 { termDefinitionIriMapping :: Maybe Text
13 , termDefinitionPrefixFlag :: Bool
14 , termDefinitionProtectedFlag :: Bool
15 , termDefinitionReversePropertyFlag :: Bool
16 , termDefinitionBaseUrl :: Maybe URI
17 , termDefinitionLocalContext :: Maybe Value
18 , termDefinitionContainerMapping :: Set Text
19 , termDefinitionIndexMapping :: Maybe Text
20 , termDefinitionNestValue :: Maybe Text
21 , termDefinitionTypeMapping :: Maybe Text
22 , termDefinitionDirectionMapping :: Maybe Direction
23 , termDefinitionLanguageMapping :: Maybe Language
24 }
25 deriving (Show, Eq)
26
27newTermDefinition :: Bool -> (TermDefinition -> TermDefinition) -> TermDefinition
28newTermDefinition protectedFlag fn =
29 fn
30 TermDefinition
31 { termDefinitionIriMapping = Nothing
32 , termDefinitionPrefixFlag = False
33 , termDefinitionProtectedFlag = protectedFlag
34 , termDefinitionReversePropertyFlag = False
35 , termDefinitionBaseUrl = Nothing
36 , termDefinitionLocalContext = Nothing
37 , termDefinitionContainerMapping = mempty
38 , termDefinitionIndexMapping = Nothing
39 , termDefinitionNestValue = Nothing
40 , termDefinitionTypeMapping = Nothing
41 , termDefinitionDirectionMapping = Nothing
42 , termDefinitionLanguageMapping = Nothing
43 }
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 @@
1module Data.JLD.Model.URI (parseUri, uriToIri) where
2
3import Data.JLD.Prelude
4
5import Data.RDF (IRIRef, parseIRI)
6import Text.Megaparsec (MonadParsec (..), Parsec, runParser)
7import Text.URI (URI, parser, render)
8
9parseUri :: Text -> Maybe URI
10parseUri = runParser (parser <* eof :: Parsec Void Text URI) "" .> either (const Nothing) Just
11
12uriToIri :: URI -> Maybe IRIRef
13uriToIri = 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 @@
1module Data.JLD.Model.ValueObject (isValueObject, isValueObject', isNotValueObject, isNotValueObject', valueObjectValue) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Model.Keyword (Keyword (..), isNotKeyword)
6
7import Data.Aeson (Object, Value (..))
8import Data.Aeson.Key qualified as K
9import Data.Aeson.KeyMap qualified as KM
10
11isValueObject :: Value -> Bool
12isValueObject (Object o) = isValueObject' o
13isValueObject _ = False
14
15isValueObject' :: Object -> Bool
16isValueObject' = KM.member (show KeywordValue)
17
18isNotValueObject :: Value -> Bool
19isNotValueObject (Object o) = isNotValueObject' o
20isNotValueObject _ = False
21
22isNotValueObject' :: Object -> Bool
23isNotValueObject' = KM.keys .> fmap K.toText .> any (`isNotKeyword` [KeywordType, KeywordValue, KeywordDirection, KeywordLanguage, KeywordIndex])
24
25valueObjectValue :: Value -> Maybe Value
26valueObjectValue (Object o) = KM.lookup (show KeywordValue) o
27valueObjectValue _ = Nothing
generated by cgit v1.2.3-70-g09d2 (git 2.50.0) at 2025-10-31 22:02:59 +0000