diff options
Diffstat (limited to 'src/Data/JLD/Model')
| -rw-r--r-- | src/Data/JLD/Model/ActiveContext.hs | 6 | ||||
| -rw-r--r-- | src/Data/JLD/Model/GraphObject.hs | 19 | ||||
| -rw-r--r-- | src/Data/JLD/Model/ListObject.hs | 16 |
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 @@ | |||
| 1 | module Data.JLD.Model.ActiveContext ( ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm,) where | 1 | module Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm) where |
| 2 | 2 | ||
| 3 | import Data.JLD.Prelude | 3 | import 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 @@ | |||
| 1 | module Data.JLD.Model.GraphObject (isGraphObject, isNotGraphObject, toGraphObject) where | 1 | module Data.JLD.Model.GraphObject (isGraphObject, isGraphObject', isNotGraphObject, isNotGraphObject', toGraphObject) where |
| 2 | 2 | ||
| 3 | import Data.JLD.Prelude | 3 | import Data.JLD.Prelude |
| 4 | 4 | ||
| @@ -6,17 +6,22 @@ import Data.JLD.Model.Keyword (Keyword (..), isKeyword) | |||
| 6 | 6 | ||
| 7 | import Data.Aeson (Object, Value (..)) | 7 | import Data.Aeson (Object, Value (..)) |
| 8 | import Data.Aeson.Key qualified as K (toText) | 8 | import Data.Aeson.Key qualified as K (toText) |
| 9 | import Data.Aeson.KeyMap qualified as KM (keys, singleton, member) | 9 | import Data.Aeson.KeyMap qualified as KM (keys, member, singleton) |
| 10 | import Data.Vector qualified as V (singleton) | ||
| 11 | 10 | ||
| 12 | isGraphObject :: Value -> Bool | 11 | isGraphObject :: Value -> Bool |
| 13 | isGraphObject (Object o) | 12 | isGraphObject (Object o) = isGraphObject' o |
| 14 | | KM.member (show KeywordGraph) o = | ||
| 15 | all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o) | ||
| 16 | isGraphObject _ = False | 13 | isGraphObject _ = False |
| 17 | 14 | ||
| 15 | isGraphObject' :: Object -> Bool | ||
| 16 | isGraphObject' o = | ||
| 17 | KM.member (show KeywordGraph) o | ||
| 18 | && all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o) | ||
| 19 | |||
| 18 | isNotGraphObject :: Value -> Bool | 20 | isNotGraphObject :: Value -> Bool |
| 19 | isNotGraphObject = isGraphObject .> not | 21 | isNotGraphObject = isGraphObject .> not |
| 20 | 22 | ||
| 23 | isNotGraphObject' :: Object -> Bool | ||
| 24 | isNotGraphObject' = isGraphObject' .> not | ||
| 25 | |||
| 21 | toGraphObject :: Value -> Object | 26 | toGraphObject :: Value -> Object |
| 22 | toGraphObject = V.singleton .> Array .> KM.singleton (show KeywordGraph) | 27 | toGraphObject = 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 @@ | |||
| 1 | module Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) where | 1 | module Data.JLD.Model.ListObject (isListObject, isListObject', isNotListObject, toListObject) where |
| 2 | 2 | ||
| 3 | import Data.JLD.Prelude | 3 | import Data.JLD.Prelude |
| 4 | 4 | ||
| 5 | import Data.JLD.Model.Keyword (Keyword (..)) | 5 | import Data.JLD.Model.Keyword (Keyword (..)) |
| 6 | 6 | ||
| 7 | import Data.Aeson (Value (..)) | 7 | import Data.Aeson (Object, Value (..)) |
| 8 | import Data.Aeson.KeyMap qualified as KM | 8 | import Data.Aeson.KeyMap qualified as KM (member, singleton, size) |
| 9 | import Data.Vector qualified as V | ||
| 10 | 9 | ||
| 11 | isListObject :: Value -> Bool | 10 | isListObject :: Value -> Bool |
| 12 | isListObject (Object o) = | 11 | isListObject (Object o) = isListObject' o |
| 12 | isListObject _ = False | ||
| 13 | |||
| 14 | isListObject' :: Object -> Bool | ||
| 15 | isListObject' 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 | ) |
| 17 | isListObject _ = False | ||
| 18 | 20 | ||
| 19 | isNotListObject :: Value -> Bool | 21 | isNotListObject :: Value -> Bool |
| 20 | isNotListObject = isListObject .> not | 22 | isNotListObject = isListObject .> not |
| 21 | 23 | ||
| 22 | toListObject :: Value -> Value | 24 | toListObject :: Value -> Value |
| 23 | toListObject value@(Array _) = Object <| KM.singleton (show KeywordList) value | 25 | toListObject value@(Array _) = Object <| KM.singleton (show KeywordList) value |
| 24 | toListObject value = Object <| KM.singleton (show KeywordList) (Array <| V.singleton value) | 26 | toListObject value = Object <| KM.singleton (show KeywordList) (Array <| pure value) |
