Replace QuotJs with Argo Serde

smucclaw · Sep 12, 2024 · acc0836 · acc0836
1 parent ffcabf8
commit acc0836
Show file tree

Hide file tree

Showing 4 changed files with 91 additions and 90 deletions.
diff --git a/src/AnyAll.purs b/src/AnyAll.purs
@@ -19,6 +19,10 @@ import Foreign.Generic  (Foreign, decode)
 import Control.Monad.Except (runExcept)
 import Foreign.Object(Object, keys)
 
+import Data.Argonaut.Core
+import Data.Argonaut.Encode
+
+
 emptyMarking :: Marking
 emptyMarking = markup Map.empty
 
@@ -32,9 +36,9 @@ decodeMarking marking =
       (\m -> m)
       eitherm
 
-paint :: Foreign -> NLDict -> Item String -> QoutJS
+paint :: Foreign -> NLDict -> Item String -> Json
 paint fm _ item =
-  qoutjs $ relevant (decodeMarking fm) Unknown item
+  encodeJson $ relevant (decodeMarking fm) Unknown item
 
 heads ::  forall t2. Object t2 -> Array String
 heads x = keys(x)
diff --git a/src/AnyAll/Item.purs b/src/AnyAll/Item.purs
@@ -16,6 +16,8 @@ import Partial.Unsafe (unsafeCrashWith)
 
 import Data.Generic.Rep (class Generic)
 import Data.Show.Generic (genericShow)
+import Data.Argonaut.Encode
+
 
 --
 -- the "native" data type represents an And/Or structure as a simple tree of Items
@@ -76,6 +78,10 @@ instance encodeLabel :: (Encode a) => Encode (Label a) where
 instance decodeLabel :: (Decode a) => Decode (Label a) where
   decode eta = genericDecode defaultOptions eta
 
+instance encodeJsonLabel :: (EncodeJson a) => EncodeJson (Label a) where
+  encodeJson (Pre x) = encodeJson $ {  pre : x }
+  encodeJson (PrePost x y) = encodeJson $ {  pre : x, post: y }
+
 label2pre ∷ Label String → String
 label2pre (Pre x) = x
 label2pre (PrePost x _) = x

diff --git a/src/AnyAll/Types.purs b/src/AnyAll/Types.purs
@@ -4,42 +4,43 @@ module AnyAll.Types(
   module AnyAll.Marking,
   module AnyAll.Ternary,
   Q(..),
-  QoutJS(..),
   PrePostRecord(..),
   ShouldView(..),
   AndOr(..),
-  mkQ,
-  qoutjs
+  mkQ
 ) where
 
-import AnyAll.BasicTypes
-import AnyAll.Item
-import AnyAll.Marking
-import AnyAll.Ternary
-import Control.Monad.Except
-import Data.Argonaut.Core
-import Data.Argonaut.Encode
+import Prelude
+
+
+import Data.Traversable (sequence)
+import Data.Tuple
 import Data.Either
-import Data.List
 import Data.Maybe
 import Data.String
+import Data.String as DString
 import Data.Symbol
-import Data.Tuple
-import Foreign
-import Foreign.Generic
-import Partial.Unsafe
-import Prelude
-
-import Data.Generic.Rep (class Generic)
 import Data.Map as Map
-import Data.Show.Generic (genericShow)
-import Data.String as DString
-import Data.Traversable (sequence)
+import Option as Option
+import Simple.JSON as JSON
+
+import Partial.Unsafe
+import Data.List
+import Control.Monad.Except
+import Foreign
 import Foreign.Index ((!), readProp)
 import Foreign.Keys as FK
 import Foreign.Object as FO
-import Option as Option
-import Simple.JSON as JSON
+import Foreign.Generic
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
+import Data.Argonaut.Encode
+import Data.Argonaut.Core
+
+import AnyAll.Item
+import AnyAll.BasicTypes
+import AnyAll.Ternary
+import AnyAll.Marking
 
 -- together, an Item and a Marking get computed into a tree of Q, which has more structure,
 -- and represents the result of and/or shortcutting.
@@ -76,43 +77,6 @@ mkQ sv ao pp m c =
     , children: c
     }
 
-newtype QoutJS = QoutJS
-  ( Option.Option
-      ( shouldView :: String
-      , andOr ::
-          Option.Option
-            ( tag :: String
-            , nl :: FO.Object String
-            , contents :: String
-            , children :: Array QoutJS
-            )
-      , prePost :: PrePostRecord
-      , post :: String
-      , mark :: DefaultRecord
-      )
-  )
-
-derive instance eqQoutJS :: Eq QoutJS
-derive instance genericQoutJS :: Generic QoutJS _
-instance showQoutJS :: Show QoutJS where
-  show eta = genericShow eta
-
-qoutjs :: Q -> QoutJS
-qoutjs (Q { shouldView, andOr, prePost, mark, children }) =
-  QoutJS $ Option.fromRecord
-    { shouldView: show shouldView
-    , andOr: case andOr of
-        And -> Option.fromRecord { tag: "All", children: qoutjs <$> children, nl: FO.empty :: FO.Object String }
-        Or -> Option.fromRecord { tag: "Any", children: qoutjs <$> children, nl: FO.empty :: FO.Object String }
-        (Simply x) -> Option.fromRecord
-          { tag: "Leaf"
-          , contents: Just x
-          , nl: FO.empty :: FO.Object String
-          }
-    , prePost: dumpPrePost prePost
-    , mark: dumpDefault mark
-    }
-
 newtype PrePostRecord = PPR (Option.Option (pre :: String, post :: String))
 
 derive instance eqPrePostRecord :: Eq PrePostRecord
@@ -151,8 +115,9 @@ shouldViewToString = case _ of
 instance encodeJsonQ :: EncodeJson Q where
   encodeJson (Q { shouldView, andOr, prePost, mark, children }) =
     "shouldView" := shouldView
-      ~> "prePost" := jsonEmptyObject
+      ~> "prePost" := encodePrePostArgo prePost
       ~> "mark" := mark
+      ~> "andOr" := encodeAndOrArgo andOr children
       ~> jsonEmptyObject
 
 data AndOr a
@@ -168,7 +133,14 @@ instance showAndOr :: (Show a) => Show (AndOr a) where
 instance encodeAndOr :: (Encode a) => Encode (AndOr a) where
   encode eta = genericEncode defaultOptions eta
 
-instance encodeJsonAndOr :: (EncodeJson a) => EncodeJson (AndOr a) where
-  encodeJson (Simply a) = encodeJson $ {  tag : "Leaf" }
-  encodeJson And = encodeJson $ {  tag : "Leaf" }
-  encodeJson Or = encodeJson $ {  tag : "Leaf" }
+encodeAndOrArgo :: forall a. EncodeJson a => AndOr a -> Array Q -> Json
+encodeAndOrArgo (Simply a) _ = encodeJson $ {  tag : "Leaf" , contents: a, nl: jsonEmptyObject}
+encodeAndOrArgo And children = encodeJson $ {  tag : "All", children: encodeJson <$> children, nl: jsonEmptyObject }
+encodeAndOrArgo Or children = encodeJson $ {  tag : "Any", children: encodeJson <$> children, nl: jsonEmptyObject }
+
+encodePrePostArgo :: forall a. EncodeJson a => Maybe (Label a) -> Json
+encodePrePostArgo (Just x) = encodeJson x
+encodePrePostArgo Nothing = jsonEmptyObject
+
+encodeJsonArgoQ :: Q -> Json
+encodeJsonArgoQ q = encodeJson q
diff --git a/tests/unit/QuotJs.spec.ts b/tests/unit/QuotJs.spec.ts
@@ -30,12 +30,17 @@ function mkAskRequest(q: string) {
 }
 
 function mkOrRequest(children: any) {
-  const tagNl = emptyMap
   const andOr = AA.Or.value
   const prePost = new Just(new AA.Pre("any of:"));
   return AA.mkQ(AA.View.value)(andOr)(prePost)(AA.Unknown.value)(children)
 }
 
+function mkAndRequest(children: any) {
+  const andOr = AA.And.value
+  const prePost = new Just(new AA.Pre("all of:"));
+  return AA.mkQ(AA.View.value)(andOr)(prePost)(AA.Unknown.value)(children)
+}
+
 function mkOrResponse(children: any) {
   return {
     "shouldView": "View",
@@ -54,26 +59,44 @@ function mkOrResponse(children: any) {
   }
 }
 
+function mkAndResponse(children: any) {
+  return {
+    "shouldView": "View",
+    "prePost": {
+      "pre": "all of:"
+    },
+    "mark": {
+      "source": "user",
+      "value": "undefined"
+    },
+    "andOr": {
+      "tag": "All",
+      "nl": {},
+      "children": children
+    }
+  }
+}
+
 describe('qoutjs', () => {
   it('Asks does the person drink?', () => {
     expect(
-      AA.qoutjs(mkAskRequest("does the person drink?"))
+      AA.encodeJsonQ.encodeJson(mkAskRequest("does the person drink?"))
     ).toEqual(
       mkAskResponse("does the person drink?")
     );
   });
 
   it('Asks does the person eat?', () => {
     expect(
-      AA.qoutjs(mkAskRequest("does the person eat?"))
+      AA.encodeJsonQ.encodeJson(mkAskRequest("does the person eat?"))
     ).toEqual(
       mkAskResponse("does the person eat?")
     );
   });
 
   it('Asks does the person eat?', () => {
     expect(
-      AA.qoutjs(mkOrRequest([
+      AA.encodeJsonQ.encodeJson(mkOrRequest([
         mkAskRequest("does the person eat?"),
         mkAskRequest("does the person drink?")
       ]))
@@ -84,6 +107,20 @@ describe('qoutjs', () => {
       ])
     );
   });
+
+  it('Asks does the person eat?', () => {
+    expect(
+      AA.encodeJsonQ.encodeJson(mkAndRequest([
+        mkAskRequest("does the person eat?"),
+        mkAskRequest("does the person drink?")
+      ]))
+    ).toEqual(
+      mkAndResponse([
+        mkAskResponse("does the person eat?"),
+        mkAskResponse("does the person drink?")
+      ])
+    );
+  });
 });
 
 function marked(mark: string) {
@@ -153,22 +190,4 @@ describe('decodeMarking', () => {
       }
     );
   })
-})
-
-describe('Argo', () => {
-  it('Asks does the person drink?', () => {
-    expect(
-      AA.encodeJsonQ.encodeJson(mkAskRequest("does the person drink?"))
-    ).toEqual(
-      {
-        "shouldView": "Ask",
-        "prePost": {},
-        "mark": {
-          "source": "user",
-          "value": "undefined"
-        }
-      }
-    );
-  });
-
-});
+})