aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--jsonld.cabal3
-rw-r--r--src/Data/JLD.hs5
-rw-r--r--src/Data/JLD/Compaction/Global.hs13
-rw-r--r--src/Data/JLD/Compaction/IRI.hs342
-rw-r--r--src/Data/JLD/Compaction/InverseContext.hs54
-rw-r--r--src/Data/JLD/Expansion.hs30
-rw-r--r--src/Data/JLD/Expansion/Context.hs36
-rw-r--r--src/Data/JLD/Flattening/NodeMap.hs4
-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
-rw-r--r--src/Data/JLD/Util.hs8
12 files changed, 477 insertions, 59 deletions
diff --git a/jsonld.cabal b/jsonld.cabal
index 376a647..a0c0c25 100644
--- a/jsonld.cabal
+++ b/jsonld.cabal
@@ -24,6 +24,9 @@ source-repository head
24library 24library
25 exposed-modules: 25 exposed-modules:
26 Data.JLD 26 Data.JLD
27 Data.JLD.Compaction.Global
28 Data.JLD.Compaction.InverseContext
29 Data.JLD.Compaction.IRI
27 Data.JLD.Control.Monad.RES 30 Data.JLD.Control.Monad.RES
28 Data.JLD.Error 31 Data.JLD.Error
29 Data.JLD.Expansion 32 Data.JLD.Expansion
diff --git a/src/Data/JLD.hs b/src/Data/JLD.hs
index a7042dc..40abae1 100644
--- a/src/Data/JLD.hs
+++ b/src/Data/JLD.hs
@@ -26,8 +26,7 @@ import Data.JLD.Options
26import Data.JLD.Util (flattenSingletonArray, valueToArray) 26import Data.JLD.Util (flattenSingletonArray, valueToArray)
27 27
28import Data.Aeson (Value (..)) 28import Data.Aeson (Value (..))
29import Data.Aeson.KeyMap qualified as KM 29import Data.Aeson.KeyMap qualified as KM (lookup, size)
30import Data.Vector qualified as V (singleton)
31import Text.URI (URI) 30import Text.URI (URI)
32 31
33data JLDExpansionParams e m = JLDExpansionParams 32data JLDExpansionParams e m = JLDExpansionParams
@@ -72,7 +71,7 @@ expand document baseUrl paramsFn = do
72 jldExpansionParamsExpandContext <&> flattenSingletonArray .> \case 71 jldExpansionParamsExpandContext <&> flattenSingletonArray .> \case
73 Array expandedContext -> Array expandedContext 72 Array expandedContext -> Array expandedContext
74 (Object expandedContext) | Just ctx <- KM.lookup (show KeywordContext) expandedContext -> ctx 73 (Object expandedContext) | Just ctx <- KM.lookup (show KeywordContext) expandedContext -> ctx
75 expandedContext -> Array <| V.singleton expandedContext 74 expandedContext -> Array <| pure expandedContext
76 75
77 activeContext' <- case maybeExpandContext of 76 activeContext' <- case maybeExpandContext of
78 Just expandContext -> 77 Just expandContext ->
diff --git a/src/Data/JLD/Compaction/Global.hs b/src/Data/JLD/Compaction/Global.hs
new file mode 100644
index 0000000..76b2db7
--- /dev/null
+++ b/src/Data/JLD/Compaction/Global.hs
@@ -0,0 +1,13 @@
1module Data.JLD.Compaction.Global (JLDCompactionT, JLDCompactionEnv (..)) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Error (JLDError)
6import Data.JLD.Options (JLDVersion (..))
7
8type JLDCompactionT e m = ReaderT JLDCompactionEnv (ExceptT (JLDError e) m)
9
10newtype JLDCompactionEnv = JLDCompactionEnv
11 { jldCompactionEnvProcessingMode :: JLDVersion
12 }
13 deriving (Show)
diff --git a/src/Data/JLD/Compaction/IRI.hs b/src/Data/JLD/Compaction/IRI.hs
new file mode 100644
index 0000000..34379d2
--- /dev/null
+++ b/src/Data/JLD/Compaction/IRI.hs
@@ -0,0 +1,342 @@
1module Data.JLD.Compaction.IRI (compactIri) where
2
3import Data.JLD.Prelude
4
5import Data.JLD (JLDError (InvalidKeywordValue), JLDVersion (JLD1_0))
6import Data.JLD.Compaction.Global (JLDCompactionEnv (jldCompactionEnvProcessingMode), JLDCompactionT)
7import Data.JLD.Compaction.InverseContext (buildInverseContext)
8import Data.JLD.Control.Monad.RES (REST, evalREST, runREST, withEnvRES, withStateRES)
9import Data.JLD.Model.ActiveContext (ActiveContext (..))
10import Data.JLD.Model.InverseContext (InverseContext)
11
12import Control.Monad.Except (MonadError (..))
13import Data.Aeson (Value (..))
14import Data.Aeson.KeyMap qualified as KM (lookup, member, size)
15import Data.JLD.Model.Direction (Direction (..))
16import Data.JLD.Model.GraphObject (isGraphObject', isNotGraphObject, isNotGraphObject')
17import Data.JLD.Model.Keyword (Keyword (..))
18import Data.JLD.Model.Language (Language (..))
19import Data.JLD.Model.ListObject (isListObject')
20import Data.JLD.Model.ValueObject (isValueObject')
21import Data.JLD.Util (valueToArray)
22import Data.Set qualified as S
23import Data.Text (toLower)
24import Data.Text qualified as T (drop, findIndex, isPrefixOf, take)
25import Data.Vector (Vector, (!?))
26import Data.Vector qualified as V (cons, snoc)
27
28type CIT e m = REST CIEnv (JLDError e) CIState m
29
30data CIEnv = CIEnv
31 { ciEnvGlobal :: JLDCompactionEnv
32 , ciEnvActiveContext :: ActiveContext
33 , ciEnvValue :: Maybe Value
34 , ciEnvVocab :: Bool
35 , ciEnvReverse :: Bool
36 }
37 deriving (Show)
38
39data CIState = CIState
40 { ciStateContainers :: Set Text
41 , ciStateTypeLanguage :: Keyword
42 , ciStateTypeLanguageValue :: Text
43 , ciStatePreferredValues :: Vector Text
44 }
45 deriving (Show, Eq)
46
47data CIParams = CIParams
48 { ciParamsActiveContext :: ActiveContext
49 , ciParamsValue :: Maybe Value
50 , ciParamsVocab :: Bool
51 , ciParamsReverse :: Bool
52 }
53 deriving (Show, Eq)
54
55ciModifyContainers :: Monad m => (Set Text -> Set Text) -> CIT e m ()
56ciModifyContainers fn = modify \s -> s{ciStateContainers = fn (ciStateContainers s)}
57
58ciModifyPreferredValues :: Monad m => (Vector Text -> Vector Text) -> CIT e m ()
59ciModifyPreferredValues fn = modify \s -> s{ciStatePreferredValues = fn (ciStatePreferredValues s)}
60
61ciPutTypeLanguage :: Monad m => Keyword -> CIT e m ()
62ciPutTypeLanguage v = modify \s -> s{ciStateTypeLanguage = v}
63
64ciPutTypeLanguageValue :: Monad m => Text -> CIT e m ()
65ciPutTypeLanguageValue v = modify \s -> s{ciStateTypeLanguageValue = v}
66
67compactIri4 :: Monad m => InverseContext -> Text -> CIT e m (Maybe Text)
68compactIri4 inverseContext var = do
69 CIEnv{..} <- ask
70 let ActiveContext{..} = ciEnvActiveContext
71
72 -- 4.1.
73 let defaultLanguage = case (activeContextDefaultLanguage, activeContextDefaultBaseDirection) of
74 (Just (Language language), Just dir) -> language <> show dir
75 (Nothing, Just dir) -> "_" <> show dir
76 _ -> show KeywordNone
77
78 -- 4.2.
79 value = case ciEnvValue of
80 Just v@(Object o) -> case KM.lookup (show KeywordPreserve) o of
81 Just Null -> Just v
82 Just preserve -> valueToArray preserve !? 0
83 _ -> Just v
84 _ -> Nothing
85
86 -- 4.5.
87 case value of
88 Just (Object o)
89 | KM.member (show KeywordIndex) o && isNotGraphObject' o ->
90 ciModifyContainers
91 <| S.insert (show KeywordIndex)
92 .> S.insert (show KeywordIndex <> show KeywordSet)
93 _ -> pure ()
94
95 case value of
96 -- 4.6.
97 _ | ciEnvReverse -> do
98 ciPutTypeLanguage KeywordType
99 ciPutTypeLanguageValue <| show KeywordReverse
100 --
101 Just (Object o)
102 -- 4.7.
103 | isListObject' o
104 , Just (Array list) <- KM.lookup (show KeywordList) o -> do
105 -- 4.7.1.
106 unless (KM.member (show KeywordIndex) o) <| ciModifyContainers (S.insert (show KeywordList))
107
108 -- 4.7.4.
109 let go (commonType, commonLanguage) item
110 -- 4.7.4.8.
111 | commonLanguage == Just (show KeywordNone)
112 , commonType == Just (show KeywordNone) =
113 (commonType, commonLanguage)
114 --
115 | otherwise = (Just commonType', Just commonLanguage')
116 where
117 (itemLanguage, itemType) = case item of
118 Object objectItem
119 | KM.member (show KeywordValue) objectItem ->
120 if
121 -- 4.7.4.2.1.
122 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem
123 , Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
124 (toLower lang <> "_" <> toLower dir, show KeywordId)
125 | Just (String dir) <- KM.lookup (show KeywordDirection) objectItem ->
126 ("_" <> toLower dir, show KeywordId)
127 -- 4.7.4.2.2.
128 | Just (String lang) <- KM.lookup (show KeywordLanguage) objectItem ->
129 (toLower lang, show KeywordId)
130 -- 4.7.4.2.3.
131 | Just (String type') <- KM.lookup (show KeywordType) objectItem ->
132 (show KeywordNone, type')
133 -- 4.7.4.2.4.
134 | otherwise ->
135 (show KeywordNone, show KeywordId)
136 -- 4.7.4.2.4.
137 _ -> (show KeywordNone, show KeywordId)
138
139 commonLanguage' = case commonLanguage of
140 -- 4.7.4.4.
141 Nothing -> itemLanguage
142 -- 4.7.4.5.
143 Just lang
144 | itemLanguage /= lang
145 , Object itemObject <- item
146 , KM.member (show KeywordValue) itemObject ->
147 show KeywordNone
148 | otherwise -> lang
149
150 commonType' = case commonType of
151 Nothing -> itemType
152 Just it
153 | itemType /= it -> show KeywordNone
154 | otherwise -> it
155
156 -- 4.7.3. 4.7.5. 4.7.6.
157 (commonType'', commonLanguage'') =
158 list
159 |> foldl' go (Nothing, if null list then Just defaultLanguage else Nothing)
160 .> bimap (fromMaybe (show KeywordNone)) (fromMaybe (show KeywordNone))
161
162 -- 4.7.7.
163 if commonType'' /= show KeywordNone
164 then do
165 ciPutTypeLanguage KeywordType
166 ciPutTypeLanguageValue (show commonType'')
167 else -- 4.7.8.
168 ciPutTypeLanguageValue (show commonLanguage'')
169 -- 4.8.
170 | isGraphObject' o -> do
171 -- 4.8.1.
172 when (KM.member (show KeywordIndex) o) do
173 ciModifyContainers
174 <| S.insert (show KeywordGraph <> show KeywordIndex)
175 .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet)
176 -- 4.8.2.
177 when (KM.member (show KeywordId) o) do
178 ciModifyContainers
179 <| S.insert (show KeywordGraph <> show KeywordId)
180 .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet)
181 -- 4.8.3.
182 ciModifyContainers
183 <| S.insert (show KeywordGraph)
184 .> S.insert (show KeywordGraph <> show KeywordSet)
185 .> S.insert (show KeywordSet)
186 -- 4.8.4.
187 unless (KM.member (show KeywordIndex) o) do
188 ciModifyContainers
189 <| S.insert (show KeywordGraph <> show KeywordIndex)
190 .> S.insert (show KeywordGraph <> show KeywordIndex <> show KeywordSet)
191 -- 4.8.5.
192 unless (KM.member (show KeywordId) o) do
193 ciModifyContainers
194 <| S.insert (show KeywordGraph <> show KeywordId)
195 .> S.insert (show KeywordGraph <> show KeywordId <> show KeywordSet)
196 -- 4.8.6.
197 ciModifyContainers
198 <| S.insert (show KeywordIndex)
199 .> S.insert (show KeywordIndex <> show KeywordSet)
200 -- 4.8.7.
201 ciPutTypeLanguage KeywordType
202 ciPutTypeLanguageValue (show KeywordId)
203 -- 4.9. 4.9.1.
204 | isValueObject' o -> do
205 if
206 -- 4.9.1.1.
207 | Just (String dir) <- KM.lookup (show KeywordDirection) o
208 , Just (String lang) <- KM.lookup (show KeywordLanguage) o
209 , not (KM.member (show KeywordIndex) o) -> do
210 ciPutTypeLanguageValue (toLower lang <> "_" <> toLower dir)
211 ciModifyContainers
212 <| S.insert (show KeywordLanguage)
213 .> S.insert (show KeywordLanguage <> show KeywordSet)
214 | Just (String dir) <- KM.lookup (show KeywordDirection) o
215 , not (KM.member (show KeywordIndex) o) -> do
216 ciPutTypeLanguageValue ("_" <> toLower dir)
217 ciModifyContainers
218 <| S.insert (show KeywordLanguage)
219 .> S.insert (show KeywordLanguage <> show KeywordSet)
220 -- 4.9.1.2.
221 | Just (String lang) <- KM.lookup (show KeywordLanguage) o
222 , not (KM.member (show KeywordIndex) o) -> do
223 ciPutTypeLanguageValue (toLower lang)
224 ciModifyContainers
225 <| S.insert (show KeywordLanguage)
226 .> S.insert (show KeywordLanguage <> show KeywordSet)
227 -- 4.9.1.3.
228 | Just (String type') <- KM.lookup (show KeywordType) o -> do
229 ciPutTypeLanguage KeywordType
230 ciPutTypeLanguageValue type'
231 --
232 | otherwise -> pure ()
233 -- 4.9.3.
234 ciModifyContainers <| S.insert (show KeywordSet)
235 -- 4.9.2.
236 _ -> do
237 ciPutTypeLanguage KeywordType
238 ciPutTypeLanguageValue (show KeywordId)
239 -- 4.9.3.
240 ciModifyContainers
241 <| S.insert (show KeywordId)
242 .> S.insert (show KeywordId <> show KeywordSet)
243 .> S.insert (show KeywordType)
244 .> S.insert (show KeywordSet <> show KeywordType)
245 .> S.insert (show KeywordSet)
246
247 -- 4.10.
248 ciModifyContainers <| S.insert (show KeywordNone)
249
250 -- 4.11.
251 case value of
252 Just (Object o)
253 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
254 , not (KM.member (show KeywordIndex) o) ->
255 ciModifyContainers
256 <| S.insert (show KeywordIndex)
257 .> S.insert (show KeywordIndex <> show KeywordSet)
258 _
259 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0 ->
260 ciModifyContainers
261 <| S.insert (show KeywordIndex)
262 .> S.insert (show KeywordIndex <> show KeywordSet)
263 --
264 | otherwise -> pure ()
265
266 -- 4.12.
267 case value of
268 Just (Object o)
269 | jldCompactionEnvProcessingMode ciEnvGlobal /= JLD1_0
270 , KM.member (show KeywordIndex) o
271 , KM.size o == 1 ->
272 ciModifyContainers
273 <| S.insert (show KeywordLanguage)
274 .> S.insert (show KeywordLanguage <> show KeywordSet)
275 --
276 _ -> pure ()
277
278 -- 4.15.
279 typeLanguageValue <- gets ciStateTypeLanguageValue
280 when (typeLanguageValue == show KeywordReverse) <| ciModifyPreferredValues (V.cons (show KeywordReverse))
281
282 -- 4.16.
283 case value of
284 Just (Object o)
285 | typeLanguageValue == show KeywordReverse || typeLanguageValue == show KeywordId
286 , Just idValue <- KM.lookup (show KeywordId) o -> case idValue of
287 String idValue' -> pure ()
288 _ -> throwError <| InvalidKeywordValue KeywordId idValue
289 --
290 _ -> pure ()
291
292 --
293 pure Nothing
294
295compactIri' :: Monad m => Text -> CIT e m (Text, InverseContext)
296compactIri' var = do
297 CIEnv{..} <- ask
298
299 -- 2. 3.
300 let inverseContext = case activeContextInverseContext ciEnvActiveContext of
301 Nothing -> buildInverseContext ciEnvActiveContext
302 Just ic -> ic
303
304 compactIri4 inverseContext var >>= \case
305 Just var' -> pure (var', inverseContext)
306 Nothing -> pure (var, inverseContext)
307
308compactIri :: Monad m => ActiveContext -> Text -> (CIParams -> CIParams) -> JLDCompactionT e m (Text, InverseContext)
309compactIri activeContext var paramsFn = do
310 envGlobal <- ask
311 result <-
312 compactIri' var
313 |> evalREST (env envGlobal) st
314 case result of
315 Left err -> throwError err
316 Right res -> pure res
317 where
318 CIParams{..} =
319 paramsFn
320 CIParams
321 { ciParamsActiveContext = activeContext
322 , ciParamsValue = Nothing
323 , ciParamsVocab = False
324 , ciParamsReverse = False
325 }
326
327 env global =
328 CIEnv
329 { ciEnvGlobal = global
330 , ciEnvActiveContext = ciParamsActiveContext
331 , ciEnvValue = ciParamsValue
332 , ciEnvVocab = ciParamsVocab
333 , ciEnvReverse = ciParamsReverse
334 }
335
336 st =
337 CIState
338 { ciStateContainers = mempty
339 , ciStateTypeLanguage = KeywordLanguage
340 , ciStateTypeLanguageValue = show KeywordNull
341 , ciStatePreferredValues = mempty
342 }
diff --git a/src/Data/JLD/Compaction/InverseContext.hs b/src/Data/JLD/Compaction/InverseContext.hs
new file mode 100644
index 0000000..b351e34
--- /dev/null
+++ b/src/Data/JLD/Compaction/InverseContext.hs
@@ -0,0 +1,54 @@
1module Data.JLD.Compaction.InverseContext (buildInverseContext) where
2
3import Data.JLD.Prelude
4
5import Data.JLD.Model.ActiveContext (ActiveContext (..))
6import Data.JLD.Model.Direction (Direction (..))
7import Data.JLD.Model.InverseContext (InverseContext)
8import Data.JLD.Model.Keyword (Keyword (..))
9import Data.JLD.Model.Language (Language (Language))
10import Data.JLD.Model.TermDefinition (TermDefinition (..))
11
12import Data.Map qualified as M
13
14processTerm :: Text -> InverseContext -> Text -> TermDefinition -> InverseContext
15processTerm defaultLangDir out termName TermDefinition{..}
16 | Just variableName <- termDefinitionIriMapping =
17 out
18 |> M.insert (variableName, container, show KeywordAny, show KeywordNone) termName
19 .> if
20 | termDefinitionReversePropertyFlag ->
21 M.insert (variableName, container, show KeywordType, show KeywordReverse) termName
22 | termDefinitionTypeMapping == Just (show KeywordNone) ->
23 M.insert (variableName, container, show KeywordLanguage, show KeywordAny) termName
24 .> M.insert (variableName, container, show KeywordType, show KeywordAny) termName
25 | Just typeMapping <- termDefinitionTypeMapping ->
26 M.insert (variableName, container, show KeywordType, typeMapping) termName
27 | Just langDir <- maybeLangDir ->
28 M.insert (variableName, container, show KeywordLanguage, langDir) termName
29 | otherwise ->
30 M.insert (variableName, container, show KeywordLanguage, defaultLangDir) termName
31 .> M.insert (variableName, container, show KeywordLanguage, show KeywordNone) termName
32 .> M.insert (variableName, container, show KeywordType, show KeywordNone) termName
33 | otherwise = out
34 where
35 container = if null termDefinitionContainerMapping then show KeywordNone else fold termDefinitionContainerMapping
36 maybeLangDir = case (termDefinitionLanguageMapping, termDefinitionDirectionMapping) of
37 (Just (Language language), Just LTR) -> Just <| language <> "_ltr"
38 (Just (Language language), Just RTL) -> Just <| language <> "_rtl"
39 (Just (Language language), _) -> Just <| language
40 (Just _, Just LTR) -> Just "_ltr"
41 (Just _, Just RTL) -> Just "_rtl"
42 (Just _, _) -> Just <| show KeywordNull
43 (Nothing, Just LTR) -> Just "_ltr"
44 (Nothing, Just RTL) -> Just "_rtl"
45 (Nothing, Just NoDirection) -> Just <| show KeywordNone
46 (Nothing, Nothing) -> Nothing
47
48buildInverseContext :: ActiveContext -> InverseContext
49buildInverseContext ActiveContext{..} = M.foldlWithKey (processTerm defaultLangDir) mempty activeContextTerms
50 where
51 defaultLangDir = case (activeContextDefaultBaseDirection, activeContextDefaultLanguage) of
52 (Just bd, Just (Language dl)) -> dl <> "_" <> show bd
53 (Just bd, _) -> "_" <> show bd
54 (_, _) -> show KeywordNone
diff --git a/src/Data/JLD/Expansion.hs b/src/Data/JLD/Expansion.hs
index beb10a3..983c126 100644
--- a/src/Data/JLD/Expansion.hs
+++ b/src/Data/JLD/Expansion.hs
@@ -39,7 +39,7 @@ import Data.Foldable.WithIndex (ifoldlM, iforM_)
39import Data.RDF (parseIRI) 39import Data.RDF (parseIRI)
40import Data.Set qualified as S (insert, member) 40import Data.Set qualified as S (insert, member)
41import Data.Text qualified as T (elem, toLower) 41import Data.Text qualified as T (elem, toLower)
42import Data.Vector qualified as V (catMaybes, concat, cons, filter, fromList, mapMaybeM, maximum, modify, null, singleton, snoc, toList) 42import Data.Vector qualified as V (catMaybes, concat, cons, filter, fromList, mapMaybeM, maximum, modify, null, snoc, toList)
43import Data.Vector.Algorithms.Merge qualified as V 43import Data.Vector.Algorithms.Merge qualified as V
44import Text.URI (URI) 44import Text.URI (URI)
45 45
@@ -190,16 +190,16 @@ eo1314ExpandKeywordItem inputType key keyword value = do
190 } 190 }
191 case maybeExpandedStringValue of 191 case maybeExpandedStringValue of
192 Just expandedStringValue 192 Just expandedStringValue
193 | jldeEnvFrameExpansion -> pure <. Just <. Array <. V.singleton <| String expandedStringValue 193 | jldeEnvFrameExpansion -> pure <. Just <. Array <. pure <| String expandedStringValue
194 | otherwise -> pure <. Just <| String expandedStringValue 194 | otherwise -> pure <. Just <| String expandedStringValue
195 Nothing -> pure <| Just Null 195 Nothing -> pure <| Just Null
196 -- 196 --
197 Object (KM.null -> True) | jldeEnvFrameExpansion -> do 197 Object (KM.null -> True) | jldeEnvFrameExpansion -> do
198 pure <. Just <. Array <. V.singleton <| Object mempty 198 pure <. Just <. Array <. pure <| Object mempty
199 -- 199 --
200 Array (allStrings -> Just arrayValue) | jldeEnvFrameExpansion && not (V.null arrayValue) -> do 200 Array (allStrings -> Just arrayValue) | jldeEnvFrameExpansion && not (V.null arrayValue) -> do
201 Just <. Array <. V.concat <. V.toList <$> forM arrayValue \item -> do 201 Just <. Array <. V.concat <. V.toList <$> forM arrayValue \item -> do
202 V.singleton <. maybe Null String <$> eo1314ExpandIriAC item \params -> 202 pure <. maybe Null String <$> eo1314ExpandIriAC item \params ->
203 params 203 params
204 { eiParamsDocumentRelative = True 204 { eiParamsDocumentRelative = True
205 , eiParamsVocab = False 205 , eiParamsVocab = False
@@ -233,7 +233,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
233 -- 13.4.4.4. 233 -- 13.4.4.4.
234 Array (allStrings -> Just arrayValue) -> 234 Array (allStrings -> Just arrayValue) ->
235 Array <. V.concat <. V.toList <$> forM arrayValue \item -> do 235 Array <. V.concat <. V.toList <$> forM arrayValue \item -> do
236 V.singleton <. maybe Null String <$> eo1314ExpandIriTC item \params -> 236 pure <. maybe Null String <$> eo1314ExpandIriTC item \params ->
237 params 237 params
238 { eiParamsDocumentRelative = True 238 { eiParamsDocumentRelative = True
239 , eiParamsVocab = True 239 , eiParamsVocab = True
@@ -264,7 +264,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
264 -- 13.4.6.4. 264 -- 13.4.6.4.
265 gets <| eo1314StateResult .> KM.lookup (show KeywordIncluded) .> \case 265 gets <| eo1314StateResult .> KM.lookup (show KeywordIncluded) .> \case
266 Just (Array includedValue) -> Just <. Array <| includedValue <> expandedValue 266 Just (Array includedValue) -> Just <. Array <| includedValue <> expandedValue
267 Just includedValue -> Just <. Array <| V.singleton includedValue <> expandedValue 267 Just includedValue -> Just <. Array <| pure includedValue <> expandedValue
268 Nothing -> Just <| Array expandedValue 268 Nothing -> Just <| Array expandedValue
269 -- 13.4.7. 269 -- 13.4.7.
270 KeywordValue -> do 270 KeywordValue -> do
@@ -277,9 +277,9 @@ eo1314ExpandKeywordItem inputType key keyword value = do
277 -- 13.4.7.2. 277 -- 13.4.7.2.
278 _ | value == Null || valueIsScalar value -> do 278 _ | value == Null || valueIsScalar value -> do
279 if jldeEnvFrameExpansion 279 if jldeEnvFrameExpansion
280 then pure <. Array <| V.singleton value 280 then pure <. Array <| pure value
281 else pure value 281 else pure value
282 Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <. Array <| V.singleton value 282 Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <. Array <| pure value
283 Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure value 283 Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure value
284 -- 284 --
285 _ -> throwError InvalidValueObjectValue 285 _ -> throwError InvalidValueObjectValue
@@ -291,7 +291,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
291 -- 13.4.8. 291 -- 13.4.8.
292 KeywordLanguage -> case value of 292 KeywordLanguage -> case value of
293 String stringValue 293 String stringValue
294 | jldeEnvFrameExpansion -> pure <. Just <. Array <. V.singleton <. String <| T.toLower stringValue 294 | jldeEnvFrameExpansion -> pure <. Just <. Array <. pure <. String <| T.toLower stringValue
295 | otherwise -> pure <. Just <. String <| T.toLower stringValue 295 | otherwise -> pure <. Just <. String <| T.toLower stringValue
296 Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value 296 Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value
297 Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value 297 Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value
@@ -301,7 +301,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
301 | JLD1_0 <- jldExpansionEnvProcessingMode -> pure Nothing 301 | JLD1_0 <- jldExpansionEnvProcessingMode -> pure Nothing
302 | otherwise -> case value of 302 | otherwise -> case value of
303 String ((`elem` ["ltr", "rtl"]) -> True) 303 String ((`elem` ["ltr", "rtl"]) -> True)
304 | jldeEnvFrameExpansion -> pure <. Just <. Array <| V.singleton value 304 | jldeEnvFrameExpansion -> pure <. Just <. Array <| pure value
305 | otherwise -> pure <| Just value 305 | otherwise -> pure <| Just value
306 Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value 306 Object (KM.null -> True) | jldeEnvFrameExpansion -> pure <| Just value
307 Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value 307 Array (all valueIsString -> True) | jldeEnvFrameExpansion -> pure <| Just value
@@ -319,7 +319,7 @@ eo1314ExpandKeywordItem inputType key keyword value = do
319 expandedValue <- eo1314ExpandAC jldeEnvActiveProperty value id 319 expandedValue <- eo1314ExpandAC jldeEnvActiveProperty value id
320 case expandedValue of 320 case expandedValue of
321 Array _ -> pure <| Just expandedValue 321 Array _ -> pure <| Just expandedValue
322 _ -> pure <. Just <. Array <| V.singleton expandedValue 322 _ -> pure <. Just <. Array <| pure expandedValue
323 -- 13.4.12. 323 -- 13.4.12.
324 KeywordSet -> Just <$> eo1314ExpandAC jldeEnvActiveProperty value id 324 KeywordSet -> Just <$> eo1314ExpandAC jldeEnvActiveProperty value id
325 -- 13.4.13. 325 -- 13.4.13.
@@ -491,7 +491,7 @@ eo1314ExpandNonKeywordItem key expandedProperty value = do
491 let maybeExistingValues = expandedIndexKey >>= (`KM.lookup` item) 491 let maybeExistingValues = expandedIndexKey >>= (`KM.lookup` item)
492 492
493 indexPropertyValues = 493 indexPropertyValues =
494 V.singleton (Object reExpandedIndex) 494 pure (Object reExpandedIndex)
495 |> case maybeExistingValues of 495 |> case maybeExistingValues of
496 Just (Array existingValues) -> (<> existingValues) 496 Just (Array existingValues) -> (<> existingValues)
497 Just existingValue -> (`V.snoc` existingValue) 497 Just existingValue -> (`V.snoc` existingValue)
@@ -526,7 +526,7 @@ eo1314ExpandNonKeywordItem key expandedProperty value = do
526 , expandedIndex /= show KeywordNone -> do 526 , expandedIndex /= show KeywordNone -> do
527 let types = case KM.lookup (show KeywordType) item of 527 let types = case KM.lookup (show KeywordType) item of
528 Just existingType -> V.cons expandedIndex <| valueToArray existingType 528 Just existingType -> V.cons expandedIndex <| valueToArray existingType
529 Nothing -> V.singleton expandedIndex 529 Nothing -> pure expandedIndex
530 pure <. KM.insert (show KeywordType) (Array types) <| item 530 pure <. KM.insert (show KeywordType) (Array types) <| item
531 -- 13.8.3.7.6. 531 -- 13.8.3.7.6.
532 | otherwise -> pure item 532 | otherwise -> pure item
@@ -755,7 +755,7 @@ expandObject maybePropertyContext value = do
755 | Just resultType <- KM.lookup (show KeywordType) result -> 755 | Just resultType <- KM.lookup (show KeywordType) result ->
756 eoNormalizeObject 756 eoNormalizeObject
757 <| if valueIsNotArray resultType && resultType /= Null 757 <| if valueIsNotArray resultType && resultType /= Null
758 then KM.insert (show KeywordType) (Array <| V.singleton resultType) result 758 then KM.insert (show KeywordType) (Array <| pure resultType) result
759 else result 759 else result
760 -- 17. 760 -- 17.
761 | KM.member (show KeywordList) result || KM.member (show KeywordSet) result -> do 761 | KM.member (show KeywordList) result || KM.member (show KeywordSet) result -> do
@@ -793,7 +793,7 @@ expandArrayItem item = do
793 -- 5.2.3. 793 -- 5.2.3.
794 Array a -> pure <| V.filter (/= Null) a 794 Array a -> pure <| V.filter (/= Null) a
795 Null -> pure mempty 795 Null -> pure mempty
796 _ -> pure <| V.singleton item'' 796 _ -> pure <| pure item''
797 797
798-- 798--
799 799
diff --git a/src/Data/JLD/Expansion/Context.hs b/src/Data/JLD/Expansion/Context.hs
index 99daba0..21350c8 100644
--- a/src/Data/JLD/Expansion/Context.hs
+++ b/src/Data/JLD/Expansion/Context.hs
@@ -96,8 +96,8 @@ bacBuildActiveContext context uri = do
96 activeContext' <- 96 activeContext' <-
97 buildActiveContext activeContext context (Just uri) params 97 buildActiveContext activeContext context (Just uri) params
98 |> withEnvRES (const bacEnvGlobal) 98 |> withEnvRES (const bacEnvGlobal)
99 |> withErrorRES Left 99 .> withErrorRES Left
100 |> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global}) 100 .> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
101 bacModifyActiveContext <| const activeContext' 101 bacModifyActiveContext <| const activeContext'
102 102
103bacProcessItem :: Monad m => Maybe URI -> Value -> BACT e m () 103bacProcessItem :: Monad m => Maybe URI -> Value -> BACT e m ()
@@ -200,8 +200,8 @@ bacProcessItem baseUrl item = do
200 (maybeVocabMapping, activeContext', _) <- 200 (maybeVocabMapping, activeContext', _) <-
201 expandIri activeContext value params 201 expandIri activeContext value params
202 |> withEnvRES (const bacEnvGlobal) 202 |> withEnvRES (const bacEnvGlobal)
203 |> withErrorRES Left 203 .> withErrorRES Left
204 |> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global}) 204 .> withStateRES bacStateGlobal (\bac global -> bac{bacStateGlobal = global})
205 bacModifyActiveContext <| const activeContext' 205 bacModifyActiveContext <| const activeContext'
206 206
207 case maybeVocabMapping of 207 case maybeVocabMapping of
@@ -218,7 +218,7 @@ bacProcessItem baseUrl item = do
218 -- 5.9.2. 218 -- 5.9.2.
219 Just Null -> bacModifyActiveContext \ac -> ac{activeContextDefaultLanguage = Just NoLanguage} 219 Just Null -> bacModifyActiveContext \ac -> ac{activeContextDefaultLanguage = Just NoLanguage}
220 -- 5.9.3. 220 -- 5.9.3.
221 Just (String language) -> bacModifyActiveContext \ac -> ac{activeContextDefaultLanguage = Just <| Language language} 221 Just (String language) -> bacModifyActiveContext \ac -> ac{activeContextDefaultLanguage = Just <. Language <| T.toLower language}
222 Just _ -> throwError <| Left InvalidDefaultLanguage 222 Just _ -> throwError <| Left InvalidDefaultLanguage
223 -- 223 --
224 Nothing -> pure () 224 Nothing -> pure ()
@@ -345,8 +345,8 @@ buildActiveContext activeContext localContext baseUrl paramsFn = do
345 BACState{..} <- 345 BACState{..} <-
346 (buildActiveContext' localContext baseUrl >> get) 346 (buildActiveContext' localContext baseUrl >> get)
347 |> withEnvRES env 347 |> withEnvRES env
348 |> withErrorRES' (either throwError (const get)) 348 .> withErrorRES' (either throwError (const get))
349 |> withStateRES st (const bacStateGlobal) 349 .> withStateRES st (const bacStateGlobal)
350 pure bacStateActiveContext 350 pure bacStateActiveContext
351 where 351 where
352 BACParams{..} = 352 BACParams{..} =
@@ -504,7 +504,7 @@ expandIri activeContext value paramsFn = do
504 (value', EIState{..}) <- 504 (value', EIState{..}) <-
505 (expandIri' value >>= \v -> gets (v,)) 505 (expandIri' value >>= \v -> gets (v,))
506 |> withEnvRES env 506 |> withEnvRES env
507 |> withStateRES st (const eiStateGlobal) 507 .> withStateRES st (const eiStateGlobal)
508 pure (value', eiStateActiveContext, eiStateDefined) 508 pure (value', eiStateActiveContext, eiStateDefined)
509 where 509 where
510 EIParams{..} = 510 EIParams{..} =
@@ -616,8 +616,8 @@ btdExpandIri value = do
616 (expanded, activeContext', defined') <- 616 (expanded, activeContext', defined') <-
617 expandIri activeContext value params 617 expandIri activeContext value params
618 |> withEnvRES (const btdEnvGlobal) 618 |> withEnvRES (const btdEnvGlobal)
619 |> withErrorRES Left 619 .> withErrorRES Left
620 |> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global}) 620 .> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
621 modify \s -> 621 modify \s ->
622 s 622 s
623 { btdStateActiveContext = activeContext' 623 { btdStateActiveContext = activeContext'
@@ -634,8 +634,8 @@ btdBuildTermDefinition term = do
634 (activeContext', defined') <- 634 (activeContext', defined') <-
635 buildTermDefinition activeContext btdEnvLocalContext term params 635 buildTermDefinition activeContext btdEnvLocalContext term params
636 |> withEnvRES (const btdEnvGlobal) 636 |> withEnvRES (const btdEnvGlobal)
637 |> withErrorRES Left 637 .> withErrorRES Left
638 |> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global}) 638 .> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
639 modify \env -> 639 modify \env ->
640 env 640 env
641 { btdStateActiveContext = activeContext' 641 { btdStateActiveContext = activeContext'
@@ -891,9 +891,9 @@ buildTermDefinition' term = do
891 } 891 }
892 buildActiveContext activeContext context btdEnvBaseUrl params 892 buildActiveContext activeContext context btdEnvBaseUrl params
893 |> withEnvRES (const btdEnvGlobal) 893 |> withEnvRES (const btdEnvGlobal)
894 |> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global}) 894 .> withStateRES btdStateGlobal (\btd global -> btd{btdStateGlobal = global})
895 |> withErrorRES (const <| Left InvalidScopedContext) 895 .> withErrorRES (const <| Left InvalidScopedContext)
896 |> void 896 .> void
897 897
898 -- 21.4. 898 -- 21.4.
899 btdModifyTermDefinition \d -> 899 btdModifyTermDefinition \d ->
@@ -909,7 +909,7 @@ buildTermDefinition' term = do
909 -- 22. 909 -- 22.
910 case KM.lookup (show KeywordLanguage) valueObject of 910 case KM.lookup (show KeywordLanguage) valueObject of
911 Just Null -> btdModifyTermDefinition \d -> d{termDefinitionLanguageMapping = Just NoLanguage} 911 Just Null -> btdModifyTermDefinition \d -> d{termDefinitionLanguageMapping = Just NoLanguage}
912 Just (String language) -> btdModifyTermDefinition \d -> d{termDefinitionLanguageMapping = Just <| Language language} 912 Just (String language) -> btdModifyTermDefinition \d -> d{termDefinitionLanguageMapping = Just <. Language <| T.toLower language}
913 Just _ -> throwError <| Left InvalidLanguageMapping 913 Just _ -> throwError <| Left InvalidLanguageMapping
914 Nothing -> pure () 914 Nothing -> pure ()
915 915
@@ -985,8 +985,8 @@ buildTermDefinition activeContext localContext term paramsFn = do
985 BTDState{..} <- 985 BTDState{..} <-
986 (buildTermDefinition' term >> get) 986 (buildTermDefinition' term >> get)
987 |> withEnvRES env 987 |> withEnvRES env
988 |> withErrorRES' (either throwError (const get)) 988 .> withErrorRES' (either throwError (const get))
989 |> withStateRES st (const btdStateGlobal) 989 .> withStateRES st (const btdStateGlobal)
990 pure (btdStateActiveContext, btdStateDefined) 990 pure (btdStateActiveContext, btdStateDefined)
991 where 991 where
992 BTDParams{..} = 992 BTDParams{..} =
diff --git a/src/Data/JLD/Flattening/NodeMap.hs b/src/Data/JLD/Flattening/NodeMap.hs
index 06af2d4..ef09757 100644
--- a/src/Data/JLD/Flattening/NodeMap.hs
+++ b/src/Data/JLD/Flattening/NodeMap.hs
@@ -18,7 +18,7 @@ import Data.Aeson.Key qualified as K (toText)
18import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member, singleton) 18import Data.Aeson.KeyMap qualified as KM (filterWithKey, insert, lookup, member, singleton)
19import Data.Foldable.WithIndex (FoldableWithIndex (..), iforM_) 19import Data.Foldable.WithIndex (FoldableWithIndex (..), iforM_)
20import Data.Map.Strict qualified as M (insert, lookup) 20import Data.Map.Strict qualified as M (insert, lookup)
21import Data.Vector qualified as V (singleton, snoc, uniq) 21import Data.Vector qualified as V (snoc, uniq)
22 22
23type BNMT e m = REST BNMEnv (Either (JLDError e) ()) BNMState m 23type BNMT e m = REST BNMEnv (Either (JLDError e) ()) BNMState m
24 24
@@ -133,7 +133,7 @@ buildNodeMap' element = case element of
133 N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Array <| V.snoc activePropertyValue element) nodeMap 133 N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Array <| V.snoc activePropertyValue element) nodeMap
134 | otherwise -> nodeMap 134 | otherwise -> nodeMap
135 -- 4.2.2 135 -- 4.2.2
136 _ -> N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Array <| V.singleton element) nodeMap 136 _ -> N.insert bnmEnvActiveGraph bnmEnvActiveSubject bnmEnvActiveProperty (Array <| pure element) nodeMap
137 -- 4.2. 137 -- 4.2.
138 Just list -> bnmModifyList <. const <. Just <| V.snoc list element 138 Just list -> bnmModifyList <. const <. Just <| V.snoc list element
139 -- 5. 139 -- 5.
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)
diff --git a/src/Data/JLD/Util.hs b/src/Data/JLD/Util.hs
index 26b2755..8d84778 100644
--- a/src/Data/JLD/Util.hs
+++ b/src/Data/JLD/Util.hs
@@ -25,7 +25,7 @@ import Data.Aeson.KeyMap qualified as KM (insert, lookup, member)
25import Data.Foldable qualified as F (Foldable (..), elem) 25import Data.Foldable qualified as F (Foldable (..), elem)
26import Data.Foldable.WithIndex (FoldableWithIndex (..), ifoldlM) 26import Data.Foldable.WithIndex (FoldableWithIndex (..), ifoldlM)
27import Data.Vector (Vector) 27import Data.Vector (Vector)
28import Data.Vector qualified as V (filter, fromList, null, singleton, snoc, uncons) 28import Data.Vector qualified as V (filter, fromList, null, snoc, uncons)
29 29
30valueContains :: Text -> Value -> Bool 30valueContains :: Text -> Value -> Bool
31valueContains text = \case 31valueContains text = \case
@@ -78,13 +78,13 @@ flattenSingletonArray = \case
78valueToArray :: Value -> Array 78valueToArray :: Value -> Array
79valueToArray = \case 79valueToArray = \case
80 Array a -> a 80 Array a -> a
81 value -> V.singleton value 81 value -> pure value
82 82
83valueToNonNullArray :: Value -> Array 83valueToNonNullArray :: Value -> Array
84valueToNonNullArray = \case 84valueToNonNullArray = \case
85 Null -> mempty 85 Null -> mempty
86 Array a -> V.filter (/= Null) a 86 Array a -> V.filter (/= Null) a
87 value -> V.singleton value 87 value -> pure value
88 88
89allStrings :: Array -> Maybe (Vector Text) 89allStrings :: Array -> Maybe (Vector Text)
90allStrings = foldl' go (Just mempty) 90allStrings = foldl' go (Just mempty)
@@ -106,7 +106,7 @@ mapAddValue key value True object = mapAddValue key value False <| KM.insert key
106 where 106 where
107 array = case KM.lookup key object of 107 array = case KM.lookup key object of
108 Just (Array a) -> a 108 Just (Array a) -> a
109 Just original -> V.singleton original 109 Just original -> pure original
110 Nothing -> mempty 110 Nothing -> mempty
111mapAddValue key (Array value) False object = foldl' (\o v -> mapAddValue key v False o) object value 111mapAddValue key (Array value) False object = foldl' (\o v -> mapAddValue key v False o) object value
112mapAddValue key value False object = case KM.lookup key object of 112mapAddValue key value False object = case KM.lookup key object of
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-21 12:40:10 +0000