more matryoshka (#13)

* more matryoshka

* removed EJson newtype wrapper

* warnings

bower.json

@@ -15,16 +15,14 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-argonaut-codecs": "^2.0.0",
-    "purescript-argonaut-core": "^2.0.1",
     "purescript-bifunctors": "^2.0.0",
-    "purescript-fixed-points": "^3.0.0",
     "purescript-maps": "^2.0.0",
     "purescript-matryoshka": "^0.2.0",
     "purescript-newtype": "^1.2.0",
     "purescript-parsing": "^3.0.0",
     "purescript-precise": "^1.0.0",
     "purescript-profunctor-lenses": "^2.4.0",
-    "purescript-strongcheck": "^2.0.0"
+    "purescript-strongcheck": "^2.0.0",
+    "purescript-argonaut": "^2.0.0"
   }
 }

package.json

@@ -6,9 +6,9 @@
     "test": "pulp test"
   },
   "devDependencies": {
-    "pulp": "^9.0.1",
-    "purescript": "^0.10.1",
-    "purescript-psa": "^0.3.9",
-    "rimraf": "^2.5.4"
+    "pulp": "^10.0.1",
+    "purescript": "^0.10.7",
+    "purescript-psa": "^0.4.0",
+    "rimraf": "^2.6.1"
   }
 }

src/Data/Json/Extended.purs

@@ -1,12 +1,6 @@
 module Data.Json.Extended
   ( module Exports
-
-  , EJson(..)
-  , getEJson
-  , roll
-  , unroll
-  , head
-
+  , EJson
   , null
   , boolean
   , integer
@@ -23,6 +17,8 @@ module Data.Json.Extended
 
   , renderEJson
   , parseEJson
+  , decodeEJson
+  , encodeEJson
 
   , arbitraryEJsonOfSize
   , arbitraryJsonEncodableEJsonOfSize
@@ -50,110 +46,43 @@ import Data.Functor as F
 
 import Control.Lazy as Lazy
 
-import Data.Argonaut.Decode (class DecodeJson, decodeJson)
-import Data.Argonaut.Encode (class EncodeJson, encodeJson)
+import Data.Argonaut as JS
 import Data.Array as A
 import Data.Bitraversable (bitraverse)
-import Data.Eq (eq1)
+import Data.Either as E
 import Data.Functor.Mu as Mu
 import Data.HugeNum as HN
 import Data.Json.Extended.Signature as Sig
 import Data.Json.Extended.Type (EJsonType)
 import Data.Lens (Prism', preview, prism')
 import Data.Map as Map
 import Data.Maybe as M
-import Data.Newtype as N
-import Data.Ord (compare1)
 import Data.StrMap as SM
 import Data.Traversable (for)
 import Data.Tuple as T
 
-import Matryoshka (class Corecursive, class Recursive, embed, project)
+import Matryoshka (embed, project, cata, anaM)
 
 import Test.StrongCheck.Arbitrary as SC
 import Test.StrongCheck.Gen as Gen
 import Text.Parsing.Parser as P
 
 import Data.Json.Extended.Signature hiding (getType) as Exports
 
-newtype EJson = EJson (Mu.Mu Sig.EJsonF)
-
-derive instance newtypeEJson :: N.Newtype EJson _
-
-instance recursiveEJson ∷ Recursive EJson Sig.EJsonF where
-  project = N.traverse EJson project
-
-instance corecursiveEJson ∷ Corecursive EJson Sig.EJsonF where
-  embed = N.collect EJson embed
-
-getEJson
-  ∷ EJson
-  → Mu.Mu Sig.EJsonF
-getEJson (EJson x) =
-  x
-
-roll
-  ∷ Sig.EJsonF EJson
-  → EJson
-roll =
-  EJson
-    <<< Mu.roll
-    <<< F.map getEJson
-
-unroll
-  ∷ EJson
-  → Sig.EJsonF EJson
-unroll =
-  getEJson
-    >>> Mu.unroll
-    >>> F.map EJson
-
-head ∷ EJson → Sig.EJsonF (Mu.Mu Sig.EJsonF)
-head = Mu.unroll <<< getEJson
-
-instance eqEJson ∷ Eq EJson where
-  eq (EJson a) (EJson b) =
-    eq1 (Mu.unroll a) (Mu.unroll b)
-
-instance ordEJson ∷ Ord EJson where
-  compare (EJson a) (EJson b) =
-    compare1 (Mu.unroll a) (Mu.unroll b)
-
-instance showEJson ∷ Show EJson where
-  show = renderEJson
-
-instance decodeJsonEJson ∷ DecodeJson EJson where
-  decodeJson json =
-    roll <$>
-      Sig.decodeJsonEJsonF
-        decodeJson
-        (Sig.String >>> roll)
-        json
-
--- | This is a _lossy_ encoding of EJSON to JSON; JSON only supports objects with strings
--- as keys.
-instance encodeJsonEJson ∷ EncodeJson EJson where
-  encodeJson (EJson x) =
-    Sig.encodeJsonEJsonF
-      encodeJson
-      asKey
-      (EJson <$> Mu.unroll x)
-
-    where
-      asKey
-        ∷ EJson
-        → M.Maybe String
-      asKey (EJson y) =
-        case Mu.unroll y of
-          Sig.String k → pure k
-          _ → M.Nothing
+type EJson = Mu.Mu Sig.EJsonF
+
 
+decodeEJson ∷ JS.Json → E.Either String EJson
+decodeEJson = anaM Sig.decodeJsonEJsonF
+
+encodeEJson ∷ EJson → JS.Json
+encodeEJson = cata Sig.encodeJsonEJsonF
 
 arbitraryEJsonOfSize
   ∷ Gen.Size
   → Gen.Gen EJson
 arbitraryEJsonOfSize size =
-  roll <$>
+  embed <$>
     case size of
       0 → Sig.arbitraryBaseEJsonF
       n → Sig.arbitraryEJsonF $ arbitraryEJsonOfSize (n - 1)
@@ -163,139 +92,133 @@ arbitraryJsonEncodableEJsonOfSize
   ∷ Gen.Size
   → Gen.Gen EJson
 arbitraryJsonEncodableEJsonOfSize size =
-  roll <$>
+  embed <$>
     case size of
       0 → Sig.arbitraryBaseEJsonF
       n → Sig.arbitraryEJsonFWithKeyGen keyGen $ arbitraryJsonEncodableEJsonOfSize (n - 1)
   where
     keyGen =
-      roll <<< Sig.String <$>
+      embed <<< Sig.String <$>
         SC.arbitrary
 
-renderEJson
-  ∷ EJson
-  → String
-renderEJson (EJson x) =
-  Sig.renderEJsonF
-    renderEJson
-    (EJson <$> Mu.unroll x)
+renderEJson ∷ EJson → String
+renderEJson =
+  cata Sig.renderEJsonF
+
 
 -- | A closed parser of SQL^2 constant expressions
-parseEJson
-  ∷ forall m
-  . (Monad m)
-  ⇒ P.ParserT String m EJson
+parseEJson ∷ ∀ m. (Monad m) ⇒ P.ParserT String m EJson
 parseEJson =
   Lazy.fix \f →
-    roll <$>
+    embed <$>
       Sig.parseEJsonF f
 
 
 null ∷ EJson
-null = roll Sig.Null
+null = embed Sig.Null
 
 boolean ∷ Boolean → EJson
-boolean = roll <<< Sig.Boolean
+boolean = embed <<< Sig.Boolean
 
 integer ∷ Int → EJson
-integer = roll <<< Sig.Integer
+integer = embed <<< Sig.Integer
 
 decimal ∷ HN.HugeNum → EJson
-decimal = roll <<< Sig.Decimal
+decimal = embed <<< Sig.Decimal
 
 string ∷ String → EJson
-string = roll <<< Sig.String
+string = embed <<< Sig.String
 
 timestamp ∷ String → EJson
-timestamp = roll <<< Sig.Timestamp
+timestamp = embed <<< Sig.Timestamp
 
 date ∷ String → EJson
-date = roll <<< Sig.Date
+date = embed <<< Sig.Date
 
 time ∷ String → EJson
-time = roll <<< Sig.Time
+time = embed <<< Sig.Time
 
 interval ∷ String → EJson
-interval = roll <<< Sig.Interval
+interval = embed <<< Sig.Interval
 
 objectId ∷ String → EJson
-objectId = roll <<< Sig.ObjectId
+objectId = embed <<< Sig.ObjectId
 
 array ∷ Array EJson → EJson
-array = roll <<< Sig.Array
+array = embed <<< Sig.Array
 
 map ∷ Map.Map EJson EJson → EJson
-map = roll <<< Sig.Map <<< A.fromFoldable <<< Map.toList
+map = embed <<< Sig.Map <<< A.fromFoldable <<< Map.toList
 
 map' ∷ SM.StrMap EJson → EJson
-map' = roll <<< Sig.Map <<< F.map go <<< A.fromFoldable <<< SM.toList
+map' = embed <<< Sig.Map <<< F.map go <<< A.fromFoldable <<< SM.toList
   where
     go (T.Tuple a b) = T.Tuple (string a) b
 
 getType ∷ EJson → EJsonType
-getType = Sig.getType <<< head
+getType = Sig.getType <<< project
 
 _Null ∷ Prism' EJson Unit
-_Null = prism' (const null) $ head >>> case _ of
+_Null = prism' (const null) $ project >>> case _ of
   Sig.Null → M.Just unit
   _ → M.Nothing
 
 _String ∷ Prism' EJson String
-_String = prism' string $ head >>> case _ of
+_String = prism' string $ project >>> case _ of
   Sig.String s → M.Just s
   _ → M.Nothing
 
 _Boolean ∷ Prism' EJson Boolean
-_Boolean = prism' boolean $ head >>> case _ of
+_Boolean = prism' boolean $ project >>> case _ of
   Sig.Boolean b → M.Just b
   _ → M.Nothing
 
 _Integer ∷ Prism' EJson Int
-_Integer = prism' integer $ head >>> case _ of
+_Integer = prism' integer $ project >>> case _ of
   Sig.Integer i → M.Just i
   _ → M.Nothing
 
 _Decimal ∷ Prism' EJson HN.HugeNum
-_Decimal = prism' decimal $ head >>> case _ of
+_Decimal = prism' decimal $ project >>> case _ of
   Sig.Decimal d → M.Just d
   _ → M.Nothing
 
 _Timestamp ∷ Prism' EJson String
-_Timestamp = prism' timestamp $ head >>> case _ of
+_Timestamp = prism' timestamp $ project >>> case _ of
   Sig.Timestamp t → M.Just t
   _ → M.Nothing
 
 _Date ∷ Prism' EJson String
-_Date = prism' date $ head >>> case _ of
+_Date = prism' date $ project >>> case _ of
   Sig.Date d → M.Just d
   _ → M.Nothing
 
 _Time ∷ Prism' EJson String
-_Time = prism' time $ head >>> case _ of
+_Time = prism' time $ project >>> case _ of
   Sig.Time t → M.Just t
   _ → M.Nothing
 
 _Interval ∷ Prism' EJson String
-_Interval = prism' interval $ head >>> case _ of
+_Interval = prism' interval $ project >>> case _ of
   Sig.Interval i → M.Just i
   _ → M.Nothing
 
 _ObjectId ∷ Prism' EJson String
-_ObjectId = prism' objectId $ head >>> case _ of
+_ObjectId = prism' objectId $ project >>> case _ of
   Sig.ObjectId id → M.Just id
   _ → M.Nothing
 
 _Array ∷ Prism' EJson (Array EJson)
-_Array = prism' array $ unroll >>> case _ of
+_Array = prism' array $ project >>> case _ of
   Sig.Array xs → M.Just xs
   _ → M.Nothing
 
 _Map ∷ Prism' EJson (Map.Map EJson EJson)
-_Map = prism' map $ unroll >>> case _ of
+_Map = prism' map $ project >>> case _ of
   Sig.Map kvs → M.Just $ Map.fromFoldable kvs
   _ → M.Nothing
 
 _Map' ∷ Prism' EJson (SM.StrMap EJson)
-_Map' = prism' map' $ unroll >>> case _ of
+_Map' = prism' map' $ project >>> case _ of
   Sig.Map kvs → SM.fromFoldable <$> for kvs (bitraverse (preview _String) pure)
   _ → M.Nothing