From b19440a4a30828f12f8eafaa7292152ecf733334 Mon Sep 17 00:00:00 2001
From: Volpeon <github@volpeon.ink>
Date: Sat, 24 Jun 2023 08:58:22 +0200
Subject: WIP: Compaction

---
 src/Data/JLD/Model/ActiveContext.hs |  6 +++---
 src/Data/JLD/Model/GraphObject.hs   | 19 ++++++++++++-------
 src/Data/JLD/Model/ListObject.hs    | 16 +++++++++-------
 3 files changed, 24 insertions(+), 17 deletions(-)

(limited to 'src/Data/JLD/Model')

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 @@
-module Data.JLD.Model.ActiveContext ( ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm,) where
+module Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext, lookupTerm, containsProtectedTerm) where
 
 import Data.JLD.Prelude
 
@@ -15,7 +15,7 @@ data ActiveContext = ActiveContext
     { activeContextTerms :: Map Text TermDefinition
     , activeContextBaseIri :: Maybe IRIRef
     , activeContextBaseUrl :: Maybe URI
-    , activeContextInverseContext :: InverseContext
+    , activeContextInverseContext :: Maybe InverseContext
     , activeContextPreviousContext :: Maybe ActiveContext
     , activeContextVocabularyMapping :: Maybe Text
     , activeContextDefaultLanguage :: Maybe Language
@@ -30,7 +30,7 @@ newActiveContext fn =
             { activeContextTerms = mempty
             , activeContextBaseIri = Nothing
             , activeContextBaseUrl = Nothing
-            , activeContextInverseContext = mempty
+            , activeContextInverseContext = Nothing
             , activeContextPreviousContext = Nothing
             , activeContextVocabularyMapping = Nothing
             , 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 @@
-module Data.JLD.Model.GraphObject (isGraphObject, isNotGraphObject, toGraphObject) where
+module Data.JLD.Model.GraphObject (isGraphObject, isGraphObject', isNotGraphObject, isNotGraphObject', toGraphObject) where
 
 import Data.JLD.Prelude
 
@@ -6,17 +6,22 @@ import Data.JLD.Model.Keyword (Keyword (..), isKeyword)
 
 import Data.Aeson (Object, Value (..))
 import Data.Aeson.Key qualified as K (toText)
-import Data.Aeson.KeyMap qualified as KM (keys, singleton, member)
-import Data.Vector qualified as V (singleton)
+import Data.Aeson.KeyMap qualified as KM (keys, member, singleton)
 
 isGraphObject :: Value -> Bool
-isGraphObject (Object o)
-    | KM.member (show KeywordGraph) o =
-        all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o)
+isGraphObject (Object o) = isGraphObject' o
 isGraphObject _ = False
 
+isGraphObject' :: Object -> Bool
+isGraphObject' o =
+    KM.member (show KeywordGraph) o
+        && all (`isKeyword` [KeywordGraph, KeywordId, KeywordIndex, KeywordContext]) (K.toText <$> KM.keys o)
+
 isNotGraphObject :: Value -> Bool
 isNotGraphObject = isGraphObject .> not
 
+isNotGraphObject' :: Object -> Bool
+isNotGraphObject' = isGraphObject' .> not
+
 toGraphObject :: Value -> Object
-toGraphObject = V.singleton .> Array .> KM.singleton (show KeywordGraph)
+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 @@
-module Data.JLD.Model.ListObject (isListObject, isNotListObject, toListObject) where
+module Data.JLD.Model.ListObject (isListObject, isListObject', isNotListObject, toListObject) where
 
 import Data.JLD.Prelude
 
 import Data.JLD.Model.Keyword (Keyword (..))
 
-import Data.Aeson (Value (..))
-import Data.Aeson.KeyMap qualified as KM
-import Data.Vector qualified as V
+import Data.Aeson (Object, Value (..))
+import Data.Aeson.KeyMap qualified as KM (member, singleton, size)
 
 isListObject :: Value -> Bool
-isListObject (Object o) =
+isListObject (Object o) = isListObject' o
+isListObject _ = False
+
+isListObject' :: Object -> Bool
+isListObject' o =
     KM.member (show KeywordList) o
         && ( KM.size o == 1
                 || (KM.size o == 2 && KM.member (show KeywordIndex) o)
            )
-isListObject _ = False
 
 isNotListObject :: Value -> Bool
 isNotListObject = isListObject .> not
 
 toListObject :: Value -> Value
 toListObject value@(Array _) = Object <| KM.singleton (show KeywordList) value
-toListObject value = Object <| KM.singleton (show KeywordList) (Array <| V.singleton value)
+toListObject value = Object <| KM.singleton (show KeywordList) (Array <| pure value)
-- 
cgit v1.2.3-70-g09d2