aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--jsonld.cabal3
-rw-r--r--src/Data/JLD.hs1
-rw-r--r--src/Data/JLD/Error.hs2
-rw-r--r--src/Data/JLD/Expansion.hs5
-rw-r--r--src/Data/JLD/Expansion/Context.hs27
-rw-r--r--src/Data/JLD/Flattening/NodeMap.hs302
-rw-r--r--src/Data/JLD/Model/NodeMap.hs45
-rw-r--r--src/Data/JLD/NodeMap.hs88
-rw-r--r--src/Data/JLD/Util.hs19
9 files changed, 375 insertions, 117 deletions
diff --git a/jsonld.cabal b/jsonld.cabal
index 1308318..9c9650c 100644
--- a/jsonld.cabal
+++ b/jsonld.cabal
@@ -29,6 +29,7 @@ library
29 Data.JLD.Expansion 29 Data.JLD.Expansion
30 Data.JLD.Expansion.Context 30 Data.JLD.Expansion.Context
31 Data.JLD.Expansion.Global 31 Data.JLD.Expansion.Global
32 Data.JLD.Flattening.NodeMap
32 Data.JLD.Mime 33 Data.JLD.Mime
33 Data.JLD.Model.ActiveContext 34 Data.JLD.Model.ActiveContext
34 Data.JLD.Model.Direction 35 Data.JLD.Model.Direction
@@ -38,11 +39,11 @@ library
38 Data.JLD.Model.Keyword 39 Data.JLD.Model.Keyword
39 Data.JLD.Model.Language 40 Data.JLD.Model.Language
40 Data.JLD.Model.ListObject 41 Data.JLD.Model.ListObject
42 Data.JLD.Model.NodeMap
41 Data.JLD.Model.NodeObject 43 Data.JLD.Model.NodeObject
42 Data.JLD.Model.TermDefinition 44 Data.JLD.Model.TermDefinition
43 Data.JLD.Model.URI 45 Data.JLD.Model.URI
44 Data.JLD.Model.ValueObject 46 Data.JLD.Model.ValueObject
45 Data.JLD.NodeMap
46 Data.JLD.Options 47 Data.JLD.Options
47 Data.JLD.Prelude 48 Data.JLD.Prelude
48 Data.JLD.Util 49 Data.JLD.Util
diff --git a/src/Data/JLD.hs b/src/Data/JLD.hs
index 1f894bb..c5c28eb 100644
--- a/src/Data/JLD.hs
+++ b/src/Data/JLD.hs
@@ -3,6 +3,7 @@ module Data.JLD (
3 module Data.JLD.Error, 3 module Data.JLD.Error,
4 module Data.JLD.Options, 4 module Data.JLD.Options,
5 JLDExpansionParams (..), 5 JLDExpansionParams (..),
6 JLDExpansionState (..),
6 expand, 7 expand,
7) where 8) where
8 9
diff --git a/src/Data/JLD/Error.hs b/src/Data/JLD/Error.hs
index 91c2a0b..fe59df0 100644
--- a/src/Data/JLD/Error.hs
+++ b/src/Data/JLD/Error.hs
@@ -41,6 +41,7 @@ data JLDError e
41 | InvalidTypedValue 41 | InvalidTypedValue
42 | InvalidSetOrListObject 42 | InvalidSetOrListObject
43 | InvalidScopedContext 43 | InvalidScopedContext
44 | ConflictingIndexes
44 deriving (Eq, Show) 45 deriving (Eq, Show)
45 46
46toJldErrorCode :: JLDError e -> Text 47toJldErrorCode :: JLDError e -> Text
@@ -79,3 +80,4 @@ toJldErrorCode InvalidLanguageTaggedValue = "invalid language-tagged value"
79toJldErrorCode InvalidTypedValue = "invalid typed value" 80toJldErrorCode InvalidTypedValue = "invalid typed value"
80toJldErrorCode InvalidSetOrListObject = "invalid set or list object" 81toJldErrorCode InvalidSetOrListObject = "invalid set or list object"
81toJldErrorCode InvalidScopedContext = "invalid scoped context" 82toJldErrorCode InvalidScopedContext = "invalid scoped context"
83toJldErrorCode ConflictingIndexes = "conflicting indexes"
diff --git a/src/Data/JLD/Expansion.hs b/src/Data/JLD/Expansion.hs
index ff2d9c3..79a992d 100644
--- a/src/Data/JLD/Expansion.hs
+++ b/src/Data/JLD/Expansion.hs
@@ -24,7 +24,6 @@ import Data.JLD.Util (
24 valueContains, 24 valueContains,
25 valueIsEmptyArray, 25 valueIsEmptyArray,
26 valueIsNotArray, 26 valueIsNotArray,
27 valueIsNotNull,
28 valueIsNotString, 27 valueIsNotString,
29 valueIsScalar, 28 valueIsScalar,
30 valueIsString, 29 valueIsString,
@@ -760,7 +759,7 @@ expandObject maybePropertyContext value = do
760 -- 16. 759 -- 16.
761 | Just resultType <- KM.lookup (show KeywordType) result -> 760 | Just resultType <- KM.lookup (show KeywordType) result ->
762 eoNormalizeObject 761 eoNormalizeObject
763 <| if valueIsNotArray resultType && valueIsNotNull resultType 762 <| if valueIsNotArray resultType && resultType /= Null
764 then KM.insert (show KeywordType) (Array <| V.singleton resultType) result 763 then KM.insert (show KeywordType) (Array <| V.singleton resultType) result
765 else result 764 else result
766 -- 17. 765 -- 17.
@@ -797,7 +796,7 @@ expandArrayItem item = do
797 796
798 case item'' of 797 case item'' of
799 -- 5.2.3. 798 -- 5.2.3.
800 Array a -> pure <| V.filter valueIsNotNull a 799 Array a -> pure <| V.filter (/= Null) a
801 Null -> pure mempty 800 Null -> pure mempty
802 _ -> pure <| V.singleton item'' 801 _ -> pure <| V.singleton item''
803 802
diff --git a/src/Data/JLD/Expansion/Context.hs b/src/Data/JLD/Expansion/Context.hs
index ce61644..99daba0 100644
--- a/src/Data/JLD/Expansion/Context.hs
+++ b/src/Data/JLD/Expansion/Context.hs
@@ -13,7 +13,7 @@ import Data.JLD.Model.Language (Language (..))
13import Data.JLD.Model.TermDefinition (TermDefinition (..), newTermDefinition) 13import Data.JLD.Model.TermDefinition (TermDefinition (..), newTermDefinition)
14import Data.JLD.Model.URI (parseUri, uriToIri) 14import Data.JLD.Model.URI (parseUri, uriToIri)
15import Data.JLD.Options (ContextCache, Document (..), DocumentCache, DocumentLoader (..), JLDVersion (..)) 15import Data.JLD.Options (ContextCache, Document (..), DocumentCache, DocumentLoader (..), JLDVersion (..))
16import Data.JLD.Util (flattenSingletonArray, valueContains, valueContainsAny, valueIsTrue, valueToArray) 16import Data.JLD.Util (flattenSingletonArray, valueContains, valueContainsAny, valueToArray)
17 17
18import Control.Monad.Except (MonadError (..)) 18import Control.Monad.Except (MonadError (..))
19import Data.Aeson (Object, Value (..)) 19import Data.Aeson (Object, Value (..))
@@ -73,7 +73,7 @@ bacBuildTermDefinition contextDefinition baseUrl term = do
73 p 73 p
74 { btdParamsBaseUrl = baseUrl 74 { btdParamsBaseUrl = baseUrl
75 , btdParamsOverrideProtectedFlag = bacEnvOverrideProtected 75 , btdParamsOverrideProtectedFlag = bacEnvOverrideProtected
76 , btdParamsProtectedFlag = contextDefinition |> KM.lookup (show KeywordProtected) .> maybe False valueIsTrue 76 , btdParamsProtectedFlag = contextDefinition |> KM.lookup (show KeywordProtected) .> maybe False (== Bool True)
77 , btdParamsRemoteContexts = remoteContexts 77 , btdParamsRemoteContexts = remoteContexts
78 } 78 }
79 (activeContext', _) <- 79 (activeContext', _) <-
@@ -246,20 +246,19 @@ bacProcessItem baseUrl item = do
246 Nothing -> pure () 246 Nothing -> pure ()
247 247
248 -- 5.13. 248 -- 5.13.
249 let filteredKeywords =
250 [ KeywordBase
251 , KeywordDirection
252 , KeywordImport
253 , KeywordLanguage
254 , KeywordPropagate
255 , KeywordProtected
256 , KeywordVersion
257 , KeywordVocab
258 ]
249 KM.keys contextDefinition' 259 KM.keys contextDefinition'
250 |> fmap K.toText 260 |> fmap K.toText
251 .> filter 261 .> filter (`isNotKeyword` filteredKeywords)
252 ( `isNotKeyword`
253 [ KeywordBase
254 , KeywordDirection
255 , KeywordImport
256 , KeywordLanguage
257 , KeywordPropagate
258 , KeywordProtected
259 , KeywordVersion
260 , KeywordVocab
261 ]
262 )
263 .> mapM_ (bacBuildTermDefinition contextDefinition' baseUrl) 262 .> mapM_ (bacBuildTermDefinition contextDefinition' baseUrl)
264 -- 5.3. 263 -- 5.3.
265 _ -> throwError <| Left InvalidLocalContext 264 _ -> throwError <| Left InvalidLocalContext
diff --git a/src/Data/JLD/Flattening/NodeMap.hs b/src/Data/JLD/Flattening/NodeMap.hs
new file mode 100644
index 0000000..3747402
--- /dev/null
+++ b/src/Data/JLD/Flattening/NodeMap.hs
@@ -0,0 +1,302 @@
1module Data.JLD.Flattening.NodeMap (NodeMap, BNMParams (..), buildNodeMap) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Control.Monad.RES (REST, execREST, withErrorRES')
6import Data.JLD.Error (JLDError (..))
7import Data.JLD.Model.IRI (isBlankIri)
8import Data.JLD.Model.Keyword (Keyword (..), isNotKeyword)
9import Data.JLD.Model.NodeMap (NodeMap)
10import Data.JLD.Model.NodeMap qualified as N (hasKey2, hasKey3, insert, lookup3, memberArray, modifyArray)
11import Data.JLD.Model.NodeObject (isNodeObject)
12import Data.JLD.Util (valueIsScalar, valueToArray, valueToNonNullArray)
13
14import Control.Monad.Except (MonadError (..))
15import Data.Aeson (Array, Object, Value (..))
16import Data.Aeson.Key qualified as K (toText)
17import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member, singleton)
18import Data.Foldable.WithIndex (iforM_)
19import Data.Map.Strict qualified as M (insert, lookup)
20import Data.Vector qualified as V (singleton, snoc, uniq)
21
22type BNMT e m = REST BNMEnv (Either (JLDError e) ()) BNMState m
23
24data BNMEnv = BNMEnv
25 { bnmEnvActiveGraph :: Text
26 , bnmEnvActiveSubject :: Maybe Text
27 , bnmEnvActiveProperty :: Maybe Text
28 , bnmEnvReferenceNode :: Maybe Object
29 }
30 deriving (Show)
31
32data BNMState = BNMState
33 { bnmStateNodeMap :: NodeMap
34 , bnmStateList :: Maybe Array
35 , bnmStateIdentifierCounter :: Int
36 , bnmStateIdentifierMap :: Map Text Text
37 }
38 deriving (Show, Eq)
39
40data BNMParams = BNMParams
41 { bnmParamsNodeMap :: NodeMap
42 , bnmParamsActiveGraph :: Text
43 , bnmParamsActiveSubject :: Maybe Text
44 , bnmParamsActiveProperty :: Maybe Text
45 , bnmParamsList :: Maybe Array
46 , bnmParamsReferenceNode :: Maybe Object
47 }
48 deriving (Show, Eq)
49
50listToObject :: Maybe Array -> Value
51listToObject = Object <. KM.singleton (show KeywordList) <. Array <. fromMaybe mempty
52
53bnmModifyNodeMap :: Monad m => (NodeMap -> NodeMap) -> BNMT e m ()
54bnmModifyNodeMap fn = modify \s -> s{bnmStateNodeMap = fn (bnmStateNodeMap s)}
55
56bnmModifyList :: Monad m => (Maybe Array -> Maybe Array) -> BNMT e m ()
57bnmModifyList fn = modify \s -> s{bnmStateList = fn (bnmStateList s)}
58
59bnmModifyIdentifierCounter :: Monad m => (Int -> Int) -> BNMT e m ()
60bnmModifyIdentifierCounter fn = modify \s -> s{bnmStateIdentifierCounter = fn (bnmStateIdentifierCounter s)}
61
62bnmModifyIdentifierMap :: Monad m => (Map Text Text -> Map Text Text) -> BNMT e m ()
63bnmModifyIdentifierMap fn = modify \s -> s{bnmStateIdentifierMap = fn (bnmStateIdentifierMap s)}
64
65bnmCreateIdentifier :: Monad m => Maybe Text -> BNMT e m Text
66bnmCreateIdentifier Nothing = do
67 n <- gets bnmStateIdentifierCounter
68 "_:b" <> show n <$ bnmModifyIdentifierCounter (const <| n + 1)
69bnmCreateIdentifier (Just identifier) =
70 gets (bnmStateIdentifierMap .> M.lookup identifier) >>= \case
71 Just nodeId -> pure nodeId
72 Nothing -> do
73 nodeId <- bnmCreateIdentifier Nothing
74 nodeId <$ bnmModifyIdentifierMap (M.insert identifier nodeId)
75
76bnmBuildNodeMap :: Monad m => Value -> (BNMParams -> BNMParams) -> BNMT e m (Maybe Array)
77bnmBuildNodeMap value paramsFn = do
78 BNMEnv{..} <- ask
79 nodeMap <- gets bnmStateNodeMap
80 let params p =
81 paramsFn
82 p
83 { bnmParamsNodeMap = nodeMap
84 , bnmParamsActiveGraph = bnmEnvActiveGraph
85 , bnmParamsActiveSubject = bnmEnvActiveSubject
86 , bnmParamsActiveProperty = bnmEnvActiveProperty
87 }
88 (nodeMap', list) <- buildNodeMap value params
89 bnmModifyNodeMap <| const nodeMap'
90 pure list
91
92buildNodeMap' :: Monad m => Value -> BNMT e m ()
93buildNodeMap' element = case element of
94 -- 1.
95 Array elementArray -> forM_ elementArray (buildNodeMap' .> withErrorRES' (either (Left .> throwError) pure))
96 -- 2.
97 Object elementObject -> do
98 BNMEnv{..} <- ask
99
100 -- 3.
101 elementObject' <- case KM.lookup (show KeywordType) elementObject of
102 Just type' -> do
103 types <-
104 Array <$> forM (valueToArray type') \case
105 String item | isBlankIri item -> String <$> bnmCreateIdentifier (Just item)
106 item -> pure item
107 pure <| KM.insert (show KeywordType) types elementObject
108 --
109 Nothing -> pure elementObject
110
111 if
112 -- 4.
113 | KM.member (show KeywordValue) elementObject' ->
114 gets bnmStateList >>= \case
115 -- 4.1.
116 Nothing ->
117 gets (bnmStateNodeMap .> N.lookup3 bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty) >>= \case
118 -- 4.1.1.
119 Just (Array activePropertyValue)
120 | notElem element activePropertyValue ->
121 bnmModifyNodeMap
122 <. N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty
123 <. Array
124 <| V.snoc activePropertyValue element
125 | otherwise -> pure ()
126 -- 4.2.2
127 _ ->
128 bnmModifyNodeMap
129 <. N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty
130 <. Array
131 <| V.singleton element
132 -- 4.2.
133 Just list -> bnmModifyList <. const <. Just <| V.snoc list element
134 -- 5.
135 | Just elemList <- KM.lookup (show KeywordList) elementObject' -> do
136 -- 5.1. 5.2.
137 subList <- listToObject <$> bnmBuildNodeMap elemList id
138
139 gets bnmStateList >>= \case
140 -- 5.3.
141 Nothing ->
142 bnmModifyNodeMap
143 <. N.modifyArray bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty
144 <| flip V.snoc subList
145 -- 5.4.
146 Just stateList -> bnmModifyList <. const <. Just <| V.snoc stateList subList
147 -- 6.
148 | isNodeObject (Object elementObject') -> do
149 id' <- case KM.lookup (show KeywordId) elementObject' of
150 -- 6.1.
151 Just (String idValue) | isBlankIri idValue -> bnmCreateIdentifier <| Just idValue
152 Just _ -> throwError <| Right ()
153 -- 6.2.
154 Nothing -> bnmCreateIdentifier Nothing
155
156 -- 6.3.
157 nodeMap <- gets bnmStateNodeMap
158 when (N.hasKey2 bnmEnvActiveGraph (Just id') nodeMap) do
159 bnmModifyNodeMap <| N.insert bnmEnvActiveGraph (Just id') (Just <| show KeywordId) (String id')
160
161 nodeMap' <- gets bnmStateNodeMap
162 if
163 -- 6.5.
164 | Just referenceNode <- bnmEnvReferenceNode ->
165 unless (N.memberArray bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Object referenceNode) nodeMap') do
166 bnmModifyNodeMap
167 <. N.modifyArray bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty
168 <| flip V.snoc (Object referenceNode)
169 -- 6.6.
170 | isJust bnmEnvActiveProperty -> do
171 -- 6.6.1.
172 let reference = Object <| KM.singleton (show KeywordId) (String id')
173
174 gets bnmStateList >>= \case
175 -- 6.6.2.
176 Nothing ->
177 unless (N.memberArray bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty reference nodeMap') do
178 bnmModifyNodeMap
179 <. N.modifyArray bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty
180 <| flip V.snoc reference
181 -- 6.6.3.
182 Just stateList -> bnmModifyList <. const <. Just <| V.snoc stateList reference
183 --
184 | otherwise -> pure ()
185
186 -- 6.7.
187 case KM.lookup (show KeywordType) elementObject' of
188 Just typeValue -> do
189 nodeType <-
190 Array
191 <. V.uniq
192 <. (<> valueToNonNullArray typeValue)
193 <. fromMaybe mempty
194 <. fmap valueToNonNullArray
195 <$> gets (bnmStateNodeMap .> N.lookup3 bnmEnvActiveGraph (Just id') (Just <| show KeywordType))
196 bnmModifyNodeMap <| N.insert bnmEnvActiveGraph (Just id') (Just <| show KeywordType) nodeType
197 --
198 Nothing -> pure ()
199
200 -- 6.8.
201 nodeMap'' <- gets bnmStateNodeMap
202 case KM.lookup (show KeywordIndex) elementObject' of
203 Just indexValue
204 | N.hasKey3 bnmEnvActiveGraph (Just id') (Just <| show KeywordIndex) nodeMap'' -> throwError <| Left ConflictingIndexes
205 | otherwise -> bnmModifyNodeMap <| N.insert bnmEnvActiveGraph (Just id') (Just <| show KeywordType) indexValue
206 --
207 Nothing -> pure ()
208
209 -- 6.9.
210 case KM.lookup (show KeywordReverse) elementObject' of
211 Just (Object reverseMap) -> do
212 -- 6.9.1.
213 let referenced = KM.singleton (show KeywordId) (String id')
214
215 -- 6.9.3.
216 iforM_ reverseMap \key ->
217 valueToArray .> mapM_ \value -> do
218 void <| bnmBuildNodeMap value \params ->
219 params
220 { bnmParamsReferenceNode = Just referenced
221 , bnmParamsActiveProperty = Just <| K.toText key
222 }
223 pure ()
224 --
225 _ -> pure ()
226
227 -- 6.10.
228 case KM.lookup (show KeywordGraph) elementObject' of
229 Just graphValue ->
230 void <| bnmBuildNodeMap graphValue \params -> params{bnmParamsActiveGraph = id'}
231 --
232 _ -> pure ()
233
234 -- 6.11.
235 case KM.lookup (show KeywordIncluded) elementObject' of
236 Just includedValue ->
237 void <| bnmBuildNodeMap includedValue id
238 --
239 _ -> pure ()
240
241 let filteredKeywords = [KeywordId, KeywordType, KeywordIndex, KeywordReverse, KeywordGraph, KeywordIncluded]
242 elementObject'' = KM.filterWithKey (\key _ -> isNotKeyword (K.toText key) filteredKeywords) elementObject'
243
244 -- 6.12.
245 iforM_ elementObject'' \(K.toText -> property) value ->
246 if value == Null || valueIsScalar value
247 then pure ()
248 else do
249 -- 6.12.1.
250 property' <-
251 if isBlankIri property
252 then bnmCreateIdentifier <| Just property
253 else pure property
254
255 -- 6.12.2.
256 gets (bnmStateNodeMap .> N.hasKey3 bnmEnvActiveGraph (Just id') (Just property')) >>= \case
257 True -> pure ()
258 False -> bnmModifyNodeMap <| N.insert bnmEnvActiveGraph (Just id') (Just property') (Array mempty)
259
260 void <| bnmBuildNodeMap value \params ->
261 params
262 { bnmParamsActiveSubject = Just id'
263 , bnmParamsActiveProperty = Just property
264 }
265
266 --
267 | otherwise -> pure ()
268 pure ()
269 --
270 _ -> pure ()
271
272buildNodeMap :: Monad m => Value -> (BNMParams -> BNMParams) -> m (NodeMap, Maybe Array)
273buildNodeMap document paramsFn = do
274 BNMState{..} <- buildNodeMap' document |> execREST env st
275 pure (bnmStateNodeMap, bnmStateList)
276 where
277 BNMParams{..} =
278 paramsFn
279 BNMParams
280 { bnmParamsNodeMap = mempty
281 , bnmParamsActiveGraph = show KeywordDefault
282 , bnmParamsActiveSubject = Nothing
283 , bnmParamsActiveProperty = Nothing
284 , bnmParamsList = mempty
285 , bnmParamsReferenceNode = Nothing
286 }
287
288 env =
289 BNMEnv
290 { bnmEnvActiveGraph = bnmParamsActiveGraph
291 , bnmEnvActiveSubject = bnmParamsActiveSubject
292 , bnmEnvActiveProperty = bnmParamsActiveProperty
293 , bnmEnvReferenceNode = bnmParamsReferenceNode
294 }
295
296 st =
297 BNMState
298 { bnmStateNodeMap = bnmParamsNodeMap
299 , bnmStateList = bnmParamsList
300 , bnmStateIdentifierCounter = 1
301 , bnmStateIdentifierMap = mempty
302 }
diff --git a/src/Data/JLD/Model/NodeMap.hs b/src/Data/JLD/Model/NodeMap.hs
new file mode 100644
index 0000000..48db17e
--- /dev/null
+++ b/src/Data/JLD/Model/NodeMap.hs
@@ -0,0 +1,45 @@
1module Data.JLD.Model.NodeMap (NodeMap, lookup, lookup2, lookup3, insert, modifyArray, hasKey2, hasKey3, memberArray) where
2
3import Data.JLD.Prelude hiding (modify)
4
5import Data.Aeson (Array, Value (..))
6import Data.JLD.Util (valueToArray)
7import Data.Map.Strict qualified as M (alter, insert, lookup, member)
8
9type PropertyKey = Maybe Text
10type PropertyMap = Map PropertyKey Value
11
12type SubjectKey = Maybe Text
13type SubjectMap = Map SubjectKey PropertyMap
14
15type GraphKey = Text
16type NodeMap = Map GraphKey SubjectMap
17
18lookup :: GraphKey -> NodeMap -> Maybe SubjectMap
19lookup = M.lookup
20
21lookup2 :: GraphKey -> SubjectKey -> NodeMap -> Maybe PropertyMap
22lookup2 graphName subject nodeMap = M.lookup graphName nodeMap >>= M.lookup subject
23
24lookup3 :: GraphKey -> SubjectKey -> PropertyKey -> NodeMap -> Maybe Value
25lookup3 graphName subject property nodeMap =
26 M.lookup graphName nodeMap >>= M.lookup subject >>= M.lookup property
27
28modifyArray :: GraphKey -> SubjectKey -> PropertyKey -> (Array -> Array) -> NodeMap -> NodeMap
29modifyArray graphName subject property fn =
30 M.alter (Just <. M.alter (Just <. M.alter (Just <. Array <. fn <. maybe mempty valueToArray) property <. fromMaybe mempty) subject <. fromMaybe mempty) graphName
31
32insert :: GraphKey -> SubjectKey -> PropertyKey -> Value -> NodeMap -> NodeMap
33insert graphName subject property value =
34 M.alter (Just <. M.alter (Just <. M.insert property value <. fromMaybe mempty) subject <. fromMaybe mempty) graphName
35
36hasKey2 :: GraphKey -> SubjectKey -> NodeMap -> Bool
37hasKey2 graphName subject nodeMap = maybe False (M.member subject) <| M.lookup graphName nodeMap
38
39hasKey3 :: GraphKey -> SubjectKey -> PropertyKey -> NodeMap -> Bool
40hasKey3 graphName subject property nodeMap = maybe False (M.member property) <| M.lookup subject =<< M.lookup graphName nodeMap
41
42memberArray :: GraphKey -> SubjectKey -> PropertyKey -> Value -> NodeMap -> Bool
43memberArray graphName subject property value nodeMap = case lookup3 graphName subject property nodeMap of
44 Just (Array a) -> value `elem` a
45 _ -> False
diff --git a/src/Data/JLD/NodeMap.hs b/src/Data/JLD/NodeMap.hs
deleted file mode 100644
index 0c40c9a..0000000
--- a/src/Data/JLD/NodeMap.hs
+++ /dev/null
@@ -1,88 +0,0 @@
1module Data.JLD.NodeMap (NodeMap, BNMParams (..)) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Control.Monad.RES (REST, execREST, runREST, withEnvRES, withErrorRES, withErrorRES', withStateRES)
6import Data.JLD.Error (JLDError (..))
7import Data.JLD.Model.ActiveContext (ActiveContext (..), containsProtectedTerm, lookupTerm, newActiveContext)
8import Data.JLD.Model.Direction (Direction (..))
9import Data.JLD.Model.IRI (CompactIRI (..), endsWithGenericDelim, isBlankIri, parseCompactIri)
10import Data.JLD.Model.Keyword (Keyword (..), allKeywords, isKeyword, isKeywordLike, isNotKeyword, parseKeyword)
11import Data.JLD.Model.Language (Language (..))
12import Data.JLD.Model.TermDefinition (TermDefinition (..), newTermDefinition)
13import Data.JLD.Model.URI (parseUri, uriToIri)
14import Data.JLD.Options (ContextCache, Document (..), DocumentCache, DocumentLoader (..), JLDVersion (..))
15import Data.JLD.Util (flattenSingletonArray, valueContains, valueContainsAny, valueIsTrue, valueToArray)
16
17import Control.Monad.Except (MonadError (..))
18import Data.Aeson (Object, Value (..))
19import Data.Aeson.Key qualified as K (fromText, toText)
20import Data.Aeson.KeyMap qualified as KM (delete, keys, lookup, member, size)
21import Data.Map.Strict qualified as M (delete, insert, lookup)
22import Data.RDF (parseIRI, parseRelIRI, resolveIRI, serializeIRI, validateIRI)
23import Data.Set qualified as S (insert, member, notMember, size)
24import Data.Text qualified as T (drop, dropEnd, elem, findIndex, isPrefixOf, null, take, toLower)
25import Data.Vector qualified as V (length)
26import Text.URI (URI, isPathAbsolute, relativeTo)
27import Text.URI qualified as U (render)
28
29type NodeMap = Map (Text, Text, Text) Value
30
31type BNMT e m = REST BNMEnv (JLDError e) BNMState m
32
33data BNMEnv = BNMEnv
34 { bnmEnvDocument :: Value
35 , bnmEnvActiveGraph :: Text
36 , bnmEnvActiveSubject :: Maybe Text
37 , bnmEnvActiveProperty :: Maybe Text
38 }
39 deriving (Show)
40
41newtype BNMState = BNMState
42 { bnmStateNodeMap :: NodeMap
43 }
44 deriving (Show, Eq)
45
46data BNMParams = BNMParams
47 { bnmParamsNodeMap :: NodeMap
48 , bnmParamsActiveGraph :: Text
49 , bnmParamsActiveSubject :: Maybe Text
50 , bnmParamsActiveProperty :: Maybe Text
51 , bnmParamsList :: Map Text Value
52 }
53 deriving (Show, Eq)
54
55bnmModifyNodeMap :: Monad m => (NodeMap -> NodeMap) -> BNMT e m ()
56bnmModifyNodeMap fn = modify \s -> s{bnmStateNodeMap = fn (bnmStateNodeMap s)}
57
58buildNodeMap' :: Monad m => BNMT e m ()
59buildNodeMap' = do
60 pure ()
61
62buildNodeMap :: Monad m => Value -> (BNMParams -> BNMParams) -> m NodeMap
63buildNodeMap document paramsFn = do
64 BNMState{..} <- buildNodeMap' |> execREST env st
65 pure bnmStateNodeMap
66 where
67 BNMParams{..} =
68 paramsFn
69 BNMParams
70 { bnmParamsNodeMap = mempty
71 , bnmParamsActiveGraph = show KeywordDefault
72 , bnmParamsActiveSubject = Nothing
73 , bnmParamsActiveProperty = Nothing
74 , bnmParamsList = mempty
75 }
76
77 env =
78 BNMEnv
79 { bnmEnvDocument = document
80 , bnmEnvActiveGraph = bnmParamsActiveGraph
81 , bnmEnvActiveSubject = bnmParamsActiveSubject
82 , bnmEnvActiveProperty = bnmParamsActiveProperty
83 }
84
85 st =
86 BNMState
87 { bnmStateNodeMap = bnmParamsNodeMap
88 }
diff --git a/src/Data/JLD/Util.hs b/src/Data/JLD/Util.hs
index 82cbdee..26b2755 100644
--- a/src/Data/JLD/Util.hs
+++ b/src/Data/JLD/Util.hs
@@ -1,7 +1,6 @@
1module Data.JLD.Util ( 1module Data.JLD.Util (
2 valueContains, 2 valueContains,
3 valueContainsAny, 3 valueContainsAny,
4 valueIsTrue,
5 valueIsString, 4 valueIsString,
6 valueIsArray, 5 valueIsArray,
7 valueIsNotArray, 6 valueIsNotArray,
@@ -9,9 +8,9 @@ module Data.JLD.Util (
9 valueIsScalar, 8 valueIsScalar,
10 valueToString, 9 valueToString,
11 valueIsNotString, 10 valueIsNotString,
12 valueIsNotNull,
13 flattenSingletonArray, 11 flattenSingletonArray,
14 valueToArray, 12 valueToArray,
13 valueToNonNullArray,
15 allStrings, 14 allStrings,
16 ifindM, 15 ifindM,
17 getMapDefault, 16 getMapDefault,
@@ -26,7 +25,7 @@ import Data.Aeson.KeyMap qualified as KM (insert, lookup, member)
26import Data.Foldable qualified as F (Foldable (..), elem) 25import Data.Foldable qualified as F (Foldable (..), elem)
27import Data.Foldable.WithIndex (FoldableWithIndex (..), ifoldlM) 26import Data.Foldable.WithIndex (FoldableWithIndex (..), ifoldlM)
28import Data.Vector (Vector) 27import Data.Vector (Vector)
29import Data.Vector qualified as V (fromList, null, singleton, snoc, uncons) 28import Data.Vector qualified as V (filter, fromList, null, singleton, snoc, uncons)
30 29
31valueContains :: Text -> Value -> Bool 30valueContains :: Text -> Value -> Bool
32valueContains text = \case 31valueContains text = \case
@@ -42,10 +41,6 @@ valueContainsAny texts = \case
42 Object o -> any (\text -> KM.member (K.fromText text) o) texts 41 Object o -> any (\text -> KM.member (K.fromText text) o) texts
43 _ -> False 42 _ -> False
44 43
45valueIsTrue :: Value -> Bool
46valueIsTrue (Bool True) = True
47valueIsTrue _ = False
48
49valueIsString :: Value -> Bool 44valueIsString :: Value -> Bool
50valueIsString (String _) = True 45valueIsString (String _) = True
51valueIsString _ = False 46valueIsString _ = False
@@ -75,10 +70,6 @@ valueToString :: Value -> Maybe Text
75valueToString (String s) = Just s 70valueToString (String s) = Just s
76valueToString _ = Nothing 71valueToString _ = Nothing
77 72
78valueIsNotNull :: Value -> Bool
79valueIsNotNull Null = False
80valueIsNotNull _ = True
81
82flattenSingletonArray :: Value -> Value 73flattenSingletonArray :: Value -> Value
83flattenSingletonArray = \case 74flattenSingletonArray = \case
84 Array (V.uncons -> Just (value, V.null -> True)) -> value 75 Array (V.uncons -> Just (value, V.null -> True)) -> value
@@ -89,6 +80,12 @@ valueToArray = \case
89 Array a -> a 80 Array a -> a
90 value -> V.singleton value 81 value -> V.singleton value
91 82
83valueToNonNullArray :: Value -> Array
84valueToNonNullArray = \case
85 Null -> mempty
86 Array a -> V.filter (/= Null) a
87 value -> V.singleton value
88
92allStrings :: Array -> Maybe (Vector Text) 89allStrings :: Array -> Maybe (Vector Text)
93allStrings = foldl' go (Just mempty) 90allStrings = foldl' go (Just mempty)
94 where 91 where
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-21 17:41:53 +0000