aboutsummaryrefslogtreecommitdiffstats
path: root/src/Data/JLD/Model
diff options
context:
space:
mode:
authorVolpeon <github@volpeon.ink>2023-06-24 08:58:22 +0200
committerVolpeon <github@volpeon.ink>2023-06-24 08:58:22 +0200
commitb19440a4a30828f12f8eafaa7292152ecf733334 (patch)
tree00210fae1f860d76bb5319d10167d744c5d4037d /src/Data/JLD/Model
parentSmall code optimization (diff)
downloadhs-jsonld-b19440a4a30828f12f8eafaa7292152ecf733334.tar.gz
hs-jsonld-b19440a4a30828f12f8eafaa7292152ecf733334.tar.bz2
hs-jsonld-b19440a4a30828f12f8eafaa7292152ecf733334.zip
WIP: Compaction
Diffstat (limited to 'src/Data/JLD/Model')
-rw-r--r--src/Data/JLD/Model/ActiveContext.hs6
-rw-r--r--src/Data/JLD/Model/GraphObject.hs19
-rw-r--r--src/Data/JLD/Model/ListObject.hs16
3 files changed, 24 insertions, 17 deletions
diff --git a/src/Data/JLD/Model/ActiveContext.hs b/src/Data/JLD/Model/ActiveContext.hs
index 5423036..f2118c4 100644
--- a/src/Data/JLD/Model/ActiveContext.hs
+++ b/src/Data/JLD/Model/ActiveContext.hs
@@ -1,4 +1,4 @@
1module Data.JLD.Model.ActiveContext ( ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm,) where 1module Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm) where
2 2
3import Data.JLD.Prelude 3import Data.JLD.Prelude
4 4
@@ -15,7 +15,7 @@ data ActiveContext = ActiveContext
15 { activeContextTerms :: Map Text TermDefinition 15 { activeContextTerms :: Map Text TermDefinition
16 , activeContextBaseIri :: Maybe IRIRef 16 , activeContextBaseIri :: Maybe IRIRef
17 , activeContextBaseUrl :: Maybe URI 17 , activeContextBaseUrl :: Maybe URI
18 , activeContextInverseContext :: InverseContext 18 , activeContextInverseContext :: Maybe InverseContext
19 , activeContextPreviousContext :: Maybe ActiveContext 19 , activeContextPreviousContext :: Maybe ActiveContext
20 , activeContextVocabularyMapping :: Maybe Text 20 , activeContextVocabularyMapping :: Maybe Text
21 , activeContextDefaultLanguage :: Maybe Language 21 , activeContextDefaultLanguage :: Maybe Language
@@ -30,7 +30,7 @@ newActiveContext fn =
30 { activeContextTerms = mempty 30 { activeContextTerms = mempty
31 , activeContextBaseIri = Nothing 31 , activeContextBaseIri = Nothing
32 , activeContextBaseUrl = Nothing 32 , activeContextBaseUrl = Nothing
33 , activeContextInverseContext = mempty 33 , activeContextInverseContext = Nothing
34 , activeContextPreviousContext = Nothing 34 , activeContextPreviousContext = Nothing
35 , activeContextVocabularyMapping = Nothing 35 , activeContextVocabularyMapping = Nothing
36 , activeContextDefaultLanguage = Nothing 36 , activeContextDefaultLanguage = Nothing
diff --git a/src/Data/JLD/Model/GraphObject.hs b/src/Data/JLD/Model/GraphObject.hs
index 3db9e6b..4d7d3ad 100644
--- a/src/Data/JLD/Model/GraphObject.hs
+++ b/src/Data/JLD/Model/GraphObject.hs
@@ -1,4 +1,4 @@
1module Data.JLD.Model.GraphObject (isGraphObject, isNotGraphObject, toGraphObject) where 1module Data.JLD.Model.GraphObject (isGraphObject, isGraphObject', isNotGraphObject, isNotGraphObject', toGraphObject) where
2 2
3import Data.JLD.Prelude 3import Data.JLD.Prelude
4 4
@@ -6,17 +6,22 @@ import Data.JLD.Model.Keyword (Keyword (..), isKeyword)
6 6
7import Data.Aeson (Object, Value (..)) 7import Data.Aeson (Object, Value (..))
8import Data.Aeson.Key qualified as K (toText) 8import Data.Aeson.Key qualified as K (toText)
9import Data.Aeson.KeyMap qualified as KM (keys, singleton, member) 9import Data.Aeson.KeyMap qualified as KM (keys, member, singleton)
10import Data.Vector qualified as V (singleton)
11 10
12isGraphObject :: Value -> Bool 11isGraphObject :: Value -> Bool
13isGraphObject (Object o) 12isGraphObject (Object o) = isGraphObject' o
14 | KM.member (show KeywordGraph) o =
15 all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o)
16isGraphObject _ = False 13isGraphObject _ = False
17 14
15isGraphObject' :: Object -> Bool
16isGraphObject' o =
17 KM.member (show KeywordGraph) o
18 && all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o)
19
18isNotGraphObject :: Value -> Bool 20isNotGraphObject :: Value -> Bool
19isNotGraphObject = isGraphObject .> not 21isNotGraphObject = isGraphObject .> not
20 22
23isNotGraphObject' :: Object -> Bool
24isNotGraphObject' = isGraphObject' .> not
25
21toGraphObject :: Value -> Object 26toGraphObject :: Value -> Object
22toGraphObject = V.singleton .> Array .> KM.singleton (show KeywordGraph) 27toGraphObject = pure .> Array .> KM.singleton (show KeywordGraph)
diff --git a/src/Data/JLD/Model/ListObject.hs b/src/Data/JLD/Model/ListObject.hs
index 8dda349..6277d24 100644
--- a/src/Data/JLD/Model/ListObject.hs
+++ b/src/Data/JLD/Model/ListObject.hs
@@ -1,24 +1,26 @@
1module Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) where 1module Data.JLD.Model.ListObject (isListObject, isListObject', isNotListObject, toListObject) where
2 2
3import Data.JLD.Prelude 3import Data.JLD.Prelude
4 4
5import Data.JLD.Model.Keyword (Keyword (..)) 5import Data.JLD.Model.Keyword (Keyword (..))
6 6
7import Data.Aeson (Value (..)) 7import Data.Aeson (Object, Value (..))
8import Data.Aeson.KeyMap qualified as KM 8import Data.Aeson.KeyMap qualified as KM (member, singleton, size)
9import Data.Vector qualified as V
10 9
11isListObject :: Value -> Bool 10isListObject :: Value -> Bool
12isListObject (Object o) = 11isListObject (Object o) = isListObject' o
12isListObject _ = False
13
14isListObject' :: Object -> Bool
15isListObject' o =
13 KM.member (show KeywordList) o 16 KM.member (show KeywordList) o
14 && ( KM.size o == 1 17 && ( KM.size o == 1
15 || (KM.size o == 2 && KM.member (show KeywordIndex) o) 18 || (KM.size o == 2 && KM.member (show KeywordIndex) o)
16 ) 19 )
17isListObject _ = False
18 20
19isNotListObject :: Value -> Bool 21isNotListObject :: Value -> Bool
20isNotListObject = isListObject .> not 22isNotListObject = isListObject .> not
21 23
22toListObject :: Value -> Value 24toListObject :: Value -> Value
23toListObject value@(Array _) = Object <| KM.singleton (show KeywordList) value 25toListObject value@(Array _) = Object <| KM.singleton (show KeywordList) value
24toListObject value = Object <| KM.singleton (show KeywordList) (Array <| V.singleton value) 26toListObject value = Object <| KM.singleton (show KeywordList) (Array <| pure value)