Merge pull request #37 from garyb/monadgen-2

Missed some bits of MonadGen conversion

Author: garyb

src/SqlSquared.purs

@@ -11,9 +11,9 @@ module SqlSquared
   , decodeJson
   , decodeJsonQuery
   , decodeJsonModule
-  , arbitrarySqlOfSize
-  , arbitrarySqlQueryOfSize
-  , arbitrarySqlModuleOfSize
+  , genSql
+  , genSqlQuery
+  , genSqlModule
   , module Sig
   , module Lenses
   , module Constructors
@@ -22,20 +22,18 @@ module SqlSquared
 
 import Prelude
 
+import Control.Monad.Gen as Gen
+import Control.Monad.Rec.Class (class MonadRec)
 import Data.Argonaut as J
 import Data.Either (Either)
 import Data.Functor.Mu (Mu)
 import Data.Json.Extended as EJ
 import Data.Traversable (traverse)
-
 import Matryoshka (cata, anaM)
-
-import SqlSquared.Signature as Sig
-import SqlSquared.Lenses as Lenses
 import SqlSquared.Constructors as Constructors
+import SqlSquared.Lenses as Lenses
 import SqlSquared.Parser as Parser
-
-import Test.QuickCheck.Gen as Gen
+import SqlSquared.Signature as Sig
 
 type Sql = Mu (Sig.SqlF EJ.EJsonF)
 
@@ -70,11 +68,13 @@ decodeJsonQuery = traverse decodeJson <=< Sig.decodeJsonSqlQueryF
 decodeJsonModule ∷ J.Json → Either String SqlModule
 decodeJsonModule = traverse decodeJson <=< Sig.decodeJsonSqlModuleF
 
-arbitrarySqlOfSize ∷ Int → Gen.Gen Sql
-arbitrarySqlOfSize = anaM $ Sig.arbitrarySqlF EJ.arbitraryEJsonF
+genSql ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ m Sql
+genSql = Gen.sized $ anaM (Sig.genSqlF EJ.arbitraryEJsonF)
 
-arbitrarySqlQueryOfSize ∷ Int → Gen.Gen SqlQuery
-arbitrarySqlQueryOfSize = traverse arbitrarySqlOfSize <=< Sig.arbitrarySqlQueryF
+genSqlQuery ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ m SqlQuery
+genSqlQuery =
+  Gen.sized $ traverse (flip Gen.resize genSql <<< const) <=< Sig.genSqlQueryF
 
-arbitrarySqlModuleOfSize ∷ Int → Gen.Gen SqlModule
-arbitrarySqlModuleOfSize = traverse arbitrarySqlOfSize <=< Sig.arbitrarySqlModuleF
+genSqlModule ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ m SqlModule
+genSqlModule =
+  Gen.sized $ traverse (flip Gen.resize genSql <<< const) <=< Sig.genSqlModuleF

src/SqlSquared/Signature.purs

@@ -23,11 +23,10 @@ module SqlSquared.Signature
   , decodeJsonSqlDeclF
   , decodeJsonSqlQueryF
   , decodeJsonSqlModuleF
-  , arbitrarySqlF
-  , arbitrarySqlDeclF
-  , arbitrarySqlQueryF
-  , arbitrarySqlModuleF
-  , genSql
+  , genSqlF
+  , genSqlDeclF
+  , genSqlQueryF
+  , genSqlModuleF
   , module SqlSquared.Utils
   , module OT
   , module JT
@@ -734,13 +733,13 @@ decodeJsonSqlModuleF = J.decodeJson >=> \obj → do
       pure $ Module decls
     _ → E.Left $ "Invalid top-level SQL^2 production: " <> tag
 
-arbitrarySqlF
+genSqlF
   ∷ ∀ m l
   . Gen.MonadGen m
   ⇒ MonadRec m
   ⇒ CoalgebraM m l Int
   → CoalgebraM m (SqlF l) Int
-arbitrarySqlF genLiteral n
+genSqlF genLiteral n
   | n < 2 =
   Gen.oneOf $ (Literal <$> genLiteral n) :|
     [ map Ident genIdent
@@ -762,17 +761,17 @@ arbitrarySqlF genLiteral n
     , genSelect n
     ]
 
-arbitrarySqlDeclF ∷ ∀ m. Gen.MonadGen m ⇒ CoalgebraM m SqlDeclF Int
-arbitrarySqlDeclF n =
+genSqlDeclF ∷ ∀ m. Gen.MonadGen m ⇒ CoalgebraM m SqlDeclF Int
+genSqlDeclF n =
   Gen.oneOf $ genImport :|
     [ genFunctionDecl n
     ]
 
-arbitrarySqlQueryF ∷ ∀ m. Gen.MonadGen m ⇒ CoalgebraM m SqlQueryF Int
-arbitrarySqlQueryF n = Query <$> genDecls n <*> pure n
+genSqlQueryF ∷ ∀ m. Gen.MonadGen m ⇒ CoalgebraM m SqlQueryF Int
+genSqlQueryF n = Query <$> genDecls n <*> pure n
 
-arbitrarySqlModuleF ∷ ∀ m. Gen.MonadGen m ⇒ CoalgebraM m SqlModuleF Int
-arbitrarySqlModuleF n = Module <$> genDecls n
+genSqlModuleF ∷ ∀ m. Gen.MonadGen m ⇒ CoalgebraM m SqlModuleF Int
+genSqlModuleF n = Module <$> genDecls n
 
 genSetLiteral ∷ ∀ m l. Gen.MonadGen m ⇒ CoalgebraM m (SqlF l) Int
 genSetLiteral n = do
@@ -892,7 +891,7 @@ genDecls ∷ ∀ m. Gen.MonadGen m ⇒ Int → m (L.List (SqlDeclF Int))
 genDecls n = do
   let
     foldFn acc _ = do
-      cs ← arbitrarySqlDeclF $ n - 1
+      cs ← genSqlDeclF $ n - 1
       pure $ cs L.: acc
   len ← Gen.chooseInt 0 $ n - 1
   L.foldM foldFn L.Nil $ L.range 0 len

test/src/Gen.purs

@@ -6,8 +6,9 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE)
 import Control.Monad.Eff.Exception (EXCEPTION)
 import Control.Monad.Eff.Random (RANDOM)
+import Control.Monad.Gen as Gen
 import Data.Either as E
-import SqlSquared (SqlQuery, arbitrarySqlQueryOfSize, decodeJsonQuery, encodeJsonQuery, printQuery, tokenize)
+import SqlSquared (SqlQuery, genSqlQuery, decodeJsonQuery, encodeJsonQuery, printQuery, tokenize)
 import Test.QuickCheck ((<?>))
 import Test.QuickCheck as QC
 import Test.QuickCheck.Arbitrary as A
@@ -16,7 +17,7 @@ import Test.Unit.Console as Console
 newtype ArbSql = ArbSql SqlQuery
 
 instance arbitraryArbSql ∷ A.Arbitrary ArbSql where
-  arbitrary = map ArbSql $ arbitrarySqlQueryOfSize 3
+  arbitrary = map ArbSql $ Gen.resize (const 3) genSqlQuery
 
 newtype ParseableSql = ParseableSql SqlQuery