Skip to content
This repository has been archived by the owner on Jun 15, 2023. It is now read-only.

Commit

Permalink
Wo types (#17)
Browse files Browse the repository at this point in the history
* coalgebras for arbitrary and parser

* removed tagged literals
  • Loading branch information
cryogenian authored Apr 19, 2017
1 parent a7e98a7 commit 10be5a8
Show file tree
Hide file tree
Showing 8 changed files with 74 additions and 436 deletions.
97 changes: 9 additions & 88 deletions src/Data/Json/Extended.purs
Original file line number Diff line number Diff line change
Expand Up @@ -6,11 +6,6 @@ module Data.Json.Extended
, integer
, decimal
, string
, timestamp
, date
, time
, interval
, objectId
, map
, map'
, array
Expand All @@ -21,7 +16,6 @@ module Data.Json.Extended
, encodeEJson

, arbitraryEJsonOfSize
, arbitraryJsonEncodableEJsonOfSize

, getType

Expand All @@ -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
Expand All @@ -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
0Sig.arbitraryBaseEJsonF
n → Sig.arbitraryEJsonF $ arbitraryEJsonOfSize (n - 1)

-- | Generate only JSON-encodable objects
arbitraryJsonEncodableEJsonOfSize
Gen.Size
Gen.Gen EJson
arbitraryJsonEncodableEJsonOfSize size =
embed <$>
case size of
0Sig.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
Expand All @@ -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

Expand Down Expand Up @@ -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
Expand Down
25 changes: 2 additions & 23 deletions src/Data/Json/Extended/Signature/Core.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)

Expand Down Expand Up @@ -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 showEJsonFShow (EJsonF TacitString) where
Expand All @@ -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 <> ")"

Expand All @@ -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

Expand Down
100 changes: 14 additions & 86 deletions src/Data/Json/Extended/Signature/Gen.purs
Original file line number Diff line number Diff line change
@@ -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
Loading

0 comments on commit 10be5a8

Please sign in to comment.