Wo types (#17)

* coalgebras for arbitrary and parser

* removed tagged literals

Author: cryogenian

src/Data/Json/Extended.purs

@@ -6,11 +6,6 @@ module Data.Json.Extended
   , integer
   , decimal
   , string
-  , timestamp
-  , date
-  , time
-  , interval
-  , objectId
   , map
   , map'
   , array
@@ -21,7 +16,6 @@ module Data.Json.Extended
   , encodeEJson
 
   , arbitraryEJsonOfSize
-  , arbitraryJsonEncodableEJsonOfSize
 
   , getType
 
@@ -30,27 +24,20 @@ module Data.Json.Extended
   , _Boolean
   , _Integer
   , _Decimal
-  , _Timestamp
-  , _Date
-  , _Time
-  , _Interval
-  , _ObjectId
   , _Array
   , _Map
   , _Map'
   ) where
 
 import Prelude hiding (map)
 
-import Data.Functor as F
-
 import Control.Lazy as Lazy
 
 import Data.Argonaut as JS
 import Data.Array as A
 import Data.Bitraversable (bitraverse)
-import Data.DateTime as DT
 import Data.Either as E
+import Data.Functor as F
 import Data.Functor.Mu as Mu
 import Data.HugeNum as HN
 import Data.Json.Extended.Signature as Sig
@@ -61,56 +48,30 @@ import Data.Maybe as M
 import Data.StrMap as SM
 import Data.Traversable (for)
 import Data.Tuple as T
+import Data.Json.Extended.Signature hiding (getType) as Exports
 
 import Matryoshka (class Corecursive, class Recursive, anaM, cata, embed, project)
 
-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
-
 type EJson = Mu.Mu Sig.EJsonF
 
-decodeEJson :: forall t. Corecursive t Sig.EJsonF ⇒ JS.Json → E.Either String t
+decodeEJson ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ JS.Json → E.Either String t
 decodeEJson = anaM Sig.decodeJsonEJsonF
 
-encodeEJson :: forall t. Recursive t Sig.EJsonF ⇒ t -> JS.Json
+encodeEJson ∷ ∀ t. Recursive t Sig.EJsonF ⇒ t → JS.Json
 encodeEJson = cata Sig.encodeJsonEJsonF
 
-arbitraryEJsonOfSize
-  ∷ Gen.Size
-  → Gen.Gen EJson
-arbitraryEJsonOfSize size =
-  embed <$>
-    case size of
-      0 → Sig.arbitraryBaseEJsonF
-      n → Sig.arbitraryEJsonF $ arbitraryEJsonOfSize (n - 1)
-
--- | Generate only JSON-encodable objects
-arbitraryJsonEncodableEJsonOfSize
-  ∷ Gen.Size
-  → Gen.Gen EJson
-arbitraryJsonEncodableEJsonOfSize size =
-  embed <$>
-    case size of
-      0 → Sig.arbitraryBaseEJsonF
-      n → Sig.arbitraryEJsonFWithKeyGen keyGen $ arbitraryJsonEncodableEJsonOfSize (n - 1)
-  where
-    keyGen =
-      embed <<< Sig.String <$>
-        SC.arbitrary
+arbitraryEJsonOfSize ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ Gen.Size → Gen.Gen t
+arbitraryEJsonOfSize = anaM Sig.arbitraryEJsonF
 
-renderEJson ∷ EJson → String
-renderEJson =
-  cata Sig.renderEJsonF
+renderEJson ∷ ∀ t. Recursive t Sig.EJsonF ⇒ t → String
+renderEJson = cata Sig.renderEJsonF
 
--- | A closed parser of SQL^2 constant expressions
 parseEJson ∷ ∀ m. Monad m ⇒ P.ParserT String m EJson
 parseEJson =
-  Lazy.fix \f →
-    embed <$>
-      Sig.parseEJsonF f
+  Lazy.fix \f → embed <$> Sig.parseEJsonF f
 
 null ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ t
 null = embed Sig.Null
@@ -127,21 +88,6 @@ decimal = embed <<< Sig.Decimal
 string ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ String → t
 string = embed <<< Sig.String
 
-timestamp ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ DT.DateTime → t
-timestamp = embed <<< Sig.Timestamp
-
-date ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ DT.Date → t
-date = embed <<< Sig.Date
-
-time ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ DT.Time → t
-time = embed <<< Sig.Time
-
-interval ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ String → t
-interval = embed <<< Sig.Interval
-
-objectId ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ String → t
-objectId = embed <<< Sig.ObjectId
-
 array ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ Array t → t
 array = embed <<< Sig.Array
 
@@ -181,31 +127,6 @@ _Decimal = prism' decimal $ project >>> case _ of
   Sig.Decimal d → M.Just d
   _ → M.Nothing
 
-_Timestamp ∷ ∀ t. (Corecursive t Sig.EJsonF, Recursive t Sig.EJsonF) ⇒ Prism' t DT.DateTime
-_Timestamp = prism' timestamp $ project >>> case _ of
-  Sig.Timestamp t → M.Just t
-  _ → M.Nothing
-
-_Date ∷ ∀ t. (Corecursive t Sig.EJsonF, Recursive t Sig.EJsonF) ⇒ Prism' t DT.Date
-_Date = prism' date $ project >>> case _ of
-  Sig.Date d → M.Just d
-  _ → M.Nothing
-
-_Time ∷ ∀ t. (Corecursive t Sig.EJsonF, Recursive t Sig.EJsonF) ⇒ Prism' t DT.Time
-_Time = prism' time $ project >>> case _ of
-  Sig.Time t → M.Just t
-  _ → M.Nothing
-
-_Interval ∷ ∀ t. (Corecursive t Sig.EJsonF, Recursive t Sig.EJsonF) ⇒ Prism' t String
-_Interval = prism' interval $ project >>> case _ of
-  Sig.Interval i → M.Just i
-  _ → M.Nothing
-
-_ObjectId ∷ ∀ t. (Corecursive t Sig.EJsonF, Recursive t Sig.EJsonF) ⇒ Prism' t String
-_ObjectId = prism' objectId $ project >>> case _ of
-  Sig.ObjectId id → M.Just id
-  _ → M.Nothing
-
 _Array ∷ ∀ t. (Corecursive t Sig.EJsonF, Recursive t Sig.EJsonF) ⇒ Prism' t (Array t)
 _Array = prism' array $ project >>> case _ of
   Sig.Array xs → M.Just xs

src/Data/Json/Extended/Signature/Core.purs

@@ -7,7 +7,6 @@ module Data.Json.Extended.Signature.Core
 import Prelude
 
 import Data.Bifunctor as BF
-import Data.DateTime as DT
 import Data.Eq (class Eq1)
 import Data.Foldable as F
 import Data.HugeNum as HN
@@ -28,11 +27,6 @@ data EJsonF a
   | Boolean Boolean
   | Integer Int
   | Decimal HN.HugeNum
-  | Timestamp DT.DateTime
-  | Date DT.Date
-  | Time DT.Time
-  | Interval String
-  | ObjectId String
   | Array (Array a)
   | Map (EJsonMap a)
 
@@ -66,12 +60,7 @@ instance traversableEJsonF ∷ T.Traversable EJsonF where
     String str → pure $ String str
     Boolean b → pure $ Boolean b
     Integer i → pure $ Integer i
-    Decimal a → pure $ Decimal a
-    Timestamp ts → pure $ Timestamp ts
-    Date d → pure $ Date d
-    Time t → pure $ Time t
-    Interval i → pure $ Interval i
-    ObjectId oid → pure $ ObjectId oid
+    Decimal d → pure $ Decimal d
   sequence = T.sequenceDefault
 
 instance showEJsonF ∷ Show (EJsonF TacitString) where
@@ -80,12 +69,7 @@ instance showEJsonF ∷ Show (EJsonF TacitString) where
     String s → "(String " <> show s <> ")"
     Boolean b → "(Boolean " <> show b <> ")"
     Integer i → "(Integer " <> show i <> ")"
-    Decimal n → "(Decimal " <> show n <> ")"
-    Timestamp r → "(Timestamp " <> show r <> ")"
-    Date d → "(Date " <> show d <> ")"
-    Time t → "(Time " <> show t <> ")"
-    Interval i → "(Interval " <> show i <> ")"
-    ObjectId i → "(ObjectId " <> show i <> ")"
+    Decimal d → "(Decimal " <> show d <> ")"
     Array xs → "(Array " <> show xs <> ")"
     Map kvs → "(Map " <> show kvs <> ")"
 
@@ -96,11 +80,6 @@ getType = case _ of
   Boolean _ → JT.Boolean
   Integer _ → JT.Integer
   Decimal _ → JT.Decimal
-  Timestamp _ → JT.Timestamp
-  Date _ → JT.Date
-  Time _ → JT.Time
-  Interval _ → JT.Interval
-  ObjectId _ → JT.ObjectId
   Array _ → JT.Array
   Map _ → JT.Map
 

src/Data/Json/Extended/Signature/Gen.purs

@@ -1,102 +1,30 @@
 module Data.Json.Extended.Signature.Gen
-  ( arbitraryBaseEJsonF
-  , arbitraryEJsonF
-  , arbitraryEJsonFWithKeyGen
+  ( arbitraryEJsonF
   ) where
 
 import Prelude
 
 import Data.Array as A
-import Data.DateTime as DT
-import Data.Enum (toEnum)
 import Data.HugeNum as HN
 import Data.Json.Extended.Signature.Core (EJsonF(..), EJsonMap(..))
-import Data.Maybe (fromMaybe)
 import Data.Tuple as T
 
+import Matryoshka (CoalgebraM)
+
 import Test.StrongCheck.Arbitrary as SC
 import Test.StrongCheck.Gen as Gen
 
-arbitraryBaseEJsonF ∷ ∀ a. Gen.Gen (EJsonF a)
-arbitraryBaseEJsonF =
+arbitraryEJsonF ∷ CoalgebraM Gen.Gen EJsonF Int
+arbitraryEJsonF 0 =
   Gen.oneOf (pure Null)
-    [ Boolean <$> SC.arbitrary
-    , Integer <$> SC.arbitrary
-    , Decimal <$> arbitraryDecimal
-    , String <$> SC.arbitrary
-    , Timestamp <$> arbitraryDateTime
-    , Date <$> arbitraryDate
-    , Time <$> arbitraryTime
-    , Interval <$> SC.arbitrary
-    , ObjectId <$> SC.arbitrary
-    , pure Null
+    [ map Boolean SC.arbitrary
+    , map Integer SC.arbitrary
+    , map Decimal $ map HN.fromNumber SC.arbitrary
+    , map String SC.arbitrary
     ]
-
-arbitraryEJsonFWithKeyGen
-  ∷ ∀ a
-  . (Eq a)
-  ⇒ Gen.Gen a
-  → Gen.Gen a
-  → Gen.Gen (EJsonF a)
-arbitraryEJsonFWithKeyGen keyGen rec =
-  Gen.oneOf (pure Null)
-    [ arbitraryBaseEJsonF
-    , Array <$> Gen.arrayOf rec
-    , Map <<< EJsonMap <$> do
-        keys ← distinctArrayOf keyGen
-        vals ← Gen.vectorOf (A.length keys) rec
-        pure $ A.zip keys vals
+arbitraryEJsonF n = do
+  len ← Gen.chooseInt 0 $ n - 1
+  Gen.oneOf (arbitraryEJsonF 0)
+    [ pure $ Array $ A.replicate len $ n - 1
+    , pure $ Map $ EJsonMap $ A.replicate len $ T.Tuple (n - 1) (n - 1)
     ]
-
-  where
-    arbitraryTuple ∷ Gen.Gen (T.Tuple a a)
-    arbitraryTuple =
-      T.Tuple
-        <$> keyGen
-        <*> rec
-
-arbitraryEJsonF
-  ∷ ∀ a
-  . (Eq a)
-  ⇒ Gen.Gen a
-  → Gen.Gen (EJsonF a)
-arbitraryEJsonF rec =
-  arbitraryEJsonFWithKeyGen rec rec
-
-distinctArrayOf
-  ∷ ∀ a
-  . (Eq a)
-  ⇒ Gen.Gen a
-  → Gen.Gen (Array a)
-distinctArrayOf =
-  map A.nub
-    <<< Gen.arrayOf
-
-arbitraryDecimal ∷ Gen.Gen HN.HugeNum
-arbitraryDecimal =
-  HN.fromNumber
-    <$> SC.arbitrary
-
-arbitraryDateTime ∷ Gen.Gen DT.DateTime
-arbitraryDateTime = DT.DateTime <$> arbitraryDate <*> arbitraryTime
-
-arbitraryDate ∷ Gen.Gen DT.Date
-arbitraryDate = do
-  year ← Gen.chooseInt 1950 2050
-  month ← Gen.chooseInt 1 12
-  day ← Gen.chooseInt 1 31
-  pure $ DT.canonicalDate
-    (fromMaybe bottom (toEnum year))
-    (fromMaybe bottom (toEnum month))
-    (fromMaybe bottom (toEnum day))
-
-arbitraryTime ∷ Gen.Gen DT.Time
-arbitraryTime = do
-  hour ← Gen.chooseInt 0 23
-  minute ← Gen.chooseInt 0 59
-  second ← Gen.chooseInt 0 59
-  pure $ DT.Time
-    (fromMaybe bottom (toEnum hour))
-    (fromMaybe bottom (toEnum minute))
-    (fromMaybe bottom (toEnum second))
-    bottom