diff options
Diffstat (limited to 'src/Data/JLD/NodeMap.hs')
-rw-r--r-- | src/Data/JLD/NodeMap.hs | 88 |
1 files changed, 88 insertions, 0 deletions
diff --git a/src/Data/JLD/NodeMap.hs b/src/Data/JLD/NodeMap.hs new file mode 100644 index 0000000..0c40c9a --- /dev/null +++ b/src/Data/JLD/NodeMap.hs | |||
@@ -0,0 +1,88 @@ | |||
1 | module Data.JLD.NodeMap (NodeMap, BNMParams (..)) where | ||
2 | |||
3 | import Data.JLD.Prelude | ||
4 | |||
5 | import Data.JLD.Control.Monad.RES (REST, execREST, runREST, withEnvRES, withErrorRES, withErrorRES', withStateRES) | ||
6 | import Data.JLD.Error (JLDError (..)) | ||
7 | import Data.JLD.Model.ActiveContext (ActiveContext (..), containsProtectedTerm, lookupTerm, newActiveContext) | ||
8 | import Data.JLD.Model.Direction (Direction (..)) | ||
9 | import Data.JLD.Model.IRI (CompactIRI (..), endsWithGenericDelim, isBlankIri, parseCompactIri) | ||
10 | import Data.JLD.Model.Keyword (Keyword (..), allKeywords, isKeyword, isKeywordLike, isNotKeyword, parseKeyword) | ||
11 | import Data.JLD.Model.Language (Language (..)) | ||
12 | import Data.JLD.Model.TermDefinition (TermDefinition (..), newTermDefinition) | ||
13 | import Data.JLD.Model.URI (parseUri, uriToIri) | ||
14 | import Data.JLD.Options (ContextCache, Document (..), DocumentCache, DocumentLoader (..), JLDVersion (..)) | ||
15 | import Data.JLD.Util (flattenSingletonArray, valueContains, valueContainsAny, valueIsTrue, valueToArray) | ||
16 | |||
17 | import Control.Monad.Except (MonadError (..)) | ||
18 | import Data.Aeson (Object, Value (..)) | ||
19 | import Data.Aeson.Key qualified as K (fromText, toText) | ||
20 | import Data.Aeson.KeyMap qualified as KM (delete, keys, lookup, member, size) | ||
21 | import Data.Map.Strict qualified as M (delete, insert, lookup) | ||
22 | import Data.RDF (parseIRI, parseRelIRI, resolveIRI, serializeIRI, validateIRI) | ||
23 | import Data.Set qualified as S (insert, member, notMember, size) | ||
24 | import Data.Text qualified as T (drop, dropEnd, elem, findIndex, isPrefixOf, null, take, toLower) | ||
25 | import Data.Vector qualified as V (length) | ||
26 | import Text.URI (URI, isPathAbsolute, relativeTo) | ||
27 | import Text.URI qualified as U (render) | ||
28 | |||
29 | type NodeMap = Map (Text, Text, Text) Value | ||
30 | |||
31 | type BNMT e m = REST BNMEnv (JLDError e) BNMState m | ||
32 | |||
33 | data BNMEnv = BNMEnv | ||
34 | { bnmEnvDocument :: Value | ||
35 | , bnmEnvActiveGraph :: Text | ||
36 | , bnmEnvActiveSubject :: Maybe Text | ||
37 | , bnmEnvActiveProperty :: Maybe Text | ||
38 | } | ||
39 | deriving (Show) | ||
40 | |||
41 | newtype BNMState = BNMState | ||
42 | { bnmStateNodeMap :: NodeMap | ||
43 | } | ||
44 | deriving (Show, Eq) | ||
45 | |||
46 | data 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 | |||
55 | bnmModifyNodeMap :: Monad m => (NodeMap -> NodeMap) -> BNMT e m () | ||
56 | bnmModifyNodeMap fn = modify \s -> s{bnmStateNodeMap = fn (bnmStateNodeMap s)} | ||
57 | |||
58 | buildNodeMap' :: Monad m => BNMT e m () | ||
59 | buildNodeMap' = do | ||
60 | pure () | ||
61 | |||
62 | buildNodeMap :: Monad m => Value -> (BNMParams -> BNMParams) -> m NodeMap | ||
63 | buildNodeMap 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 | } | ||