Skip to content

Commit

Permalink
Merge pull request #93 from purescript/compiler/0.12
Browse files Browse the repository at this point in the history
Updates for 0.12
  • Loading branch information
garyb authored May 24, 2018
2 parents 2c840b8 + a5d47b5 commit af9203c
Show file tree
Hide file tree
Showing 9 changed files with 113 additions and 238 deletions.
38 changes: 22 additions & 16 deletions LICENSE
Original file line number Diff line number Diff line change
@@ -1,20 +1,26 @@
The MIT License (MIT)
Copyright 2018 PureScript

Copyright (c) 2014 PureScript
Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:

Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
the Software, and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
3. Neither the name of the copyright holder nor the names of its contributors
may be used to endorse or promote products derived from this software without
specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
47 changes: 30 additions & 17 deletions bower.json
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
{
"name": "purescript-quickcheck",
"homepage": "https://github.com/purescript/purescript-quickcheck",
"license": "MIT",
"license": "BSD-3-Clause",
"authors": [
"John A. De Goes <[email protected]> (http://degoes.net)",
"Phil Freeman <[email protected]>"
Expand All @@ -20,23 +20,36 @@
"package.json"
],
"dependencies": {
"purescript-arrays": "^4.3.0",
"purescript-console": "^3.0.0",
"purescript-either": "^3.0.0",
"purescript-enums": "^3.0.0",
"purescript-exceptions": "^3.0.0",
"purescript-gen": "^1.0.0",
"purescript-lists": "^4.0.0",
"purescript-nonempty": "^4.0.0",
"purescript-partial": "^1.2.0",
"purescript-random": "^3.0.0",
"purescript-strings": "^3.5.0",
"purescript-transformers": "^3.0.0",
"purescript-generics-rep": "^5.0.0",
"purescript-typelevel-prelude": "^2.4.0",
"purescript-record": "^0.2.0"
"purescript-arrays": "^5.0.0",
"purescript-console": "^4.0.0",
"purescript-control": "^4.0.0",
"purescript-effect": "^2.0.0",
"purescript-either": "^4.0.0",
"purescript-enums": "^4.0.0",
"purescript-exceptions": "^4.0.0",
"purescript-foldable-traversable": "^4.0.0",
"purescript-gen": "^2.0.0",
"purescript-generics-rep": "^6.0.0",
"purescript-identity": "^4.0.0",
"purescript-integers": "^4.0.0",
"purescript-lazy": "^4.0.0",
"purescript-lcg": "^2.0.0",
"purescript-lists": "^5.0.0",
"purescript-math": "^2.1.1",
"purescript-maybe": "^4.0.0",
"purescript-newtype": "^3.0.0",
"purescript-nonempty": "^5.0.0",
"purescript-partial": "^2.0.0",
"purescript-prelude": "^4.0.0",
"purescript-record": "^1.0.0",
"purescript-st": "^4.0.0",
"purescript-strings": "^4.0.0",
"purescript-tailrec": "^4.0.0",
"purescript-transformers": "^4.0.0",
"purescript-tuples": "^5.0.0",
"purescript-unfoldable": "^4.0.0"
},
"devDependencies": {
"purescript-assert": "^3.0.0"
"purescript-assert": "^4.0.0"
}
}
8 changes: 4 additions & 4 deletions package.json
Original file line number Diff line number Diff line change
Expand Up @@ -6,9 +6,9 @@
"test": "pulp test"
},
"devDependencies": {
"eslint": "^3.17.1",
"pulp": "^11.0.0",
"purescript-psa": "^0.5.1",
"rimraf": "^2.6.1"
"eslint": "^4.19.1",
"pulp": "^12.2.0",
"purescript-psa": "^0.6.0",
"rimraf": "^2.6.2"
}
}
32 changes: 13 additions & 19 deletions src/Test/QuickCheck.purs
Original file line number Diff line number Diff line change
Expand Up @@ -16,8 +16,7 @@
-- | main = quickCheck \n -> n + 1 > n
-- | ```
module Test.QuickCheck
( QC
, quickCheck
( quickCheck
, quickCheckGen
, quickCheck'
, quickCheckGen'
Expand All @@ -44,36 +43,31 @@ module Test.QuickCheck
, (>?)
, assertGreaterThanEq
, (>=?)
, module Test.QuickCheck.LCG
, module Random.LCG
, module Test.QuickCheck.Arbitrary
) where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Exception (EXCEPTION, throwException, error)
import Control.Monad.Eff.Random (RANDOM)
import Control.Monad.Rec.Class (Step(..), tailRec)
import Data.Foldable (for_)
import Data.List (List)
import Data.Maybe (Maybe(..))
import Data.Maybe.First (First(..))
import Data.Monoid (mempty)
import Data.Tuple (Tuple(..))
import Data.Unfoldable (replicateA)
import Effect (Effect)
import Effect.Console (log)
import Effect.Exception (throwException, error)
import Random.LCG (Seed, mkSeed, unSeed, randomSeed)
import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary, class Coarbitrary, coarbitrary)
import Test.QuickCheck.Gen (Gen, evalGen, runGen)
import Test.QuickCheck.LCG (Seed, runSeed, randomSeed)

-- | A type synonym which represents the effects used by the `quickCheck` function.
type QC eff a = Eff (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) a

-- | Test a property.
-- |
-- | This function generates a new random seed, runs 100 tests and
-- | prints the test results to the console.
quickCheck :: forall eff prop. Testable prop => prop -> QC eff Unit
quickCheck :: forall prop. Testable prop => prop -> Effect Unit
quickCheck prop = quickCheck' 100 prop

-- | A version of `quickCheck` with the property specialized to `Gen`.
Expand All @@ -84,31 +78,31 @@ quickCheck prop = quickCheck' 100 prop
-- | `MonadGen`-constrained properties as they will not infer correctly when
-- | used with the `quickCheck` functions unless an explicit type annotation is
-- | used.
quickCheckGen :: forall eff prop. Testable prop => Gen prop -> QC eff Unit
quickCheckGen :: forall prop. Testable prop => Gen prop -> Effect Unit
quickCheckGen = quickCheck

-- | A variant of the `quickCheck` function which accepts an extra parameter
-- | representing the number of tests which should be run.
quickCheck' :: forall eff prop. Testable prop => Int -> prop -> QC eff Unit
quickCheck' :: forall prop. Testable prop => Int -> prop -> Effect Unit
quickCheck' n prop = do
seed <- randomSeed
quickCheckWithSeed seed n prop

-- | A version of `quickCheck'` with the property specialized to `Gen`.
quickCheckGen' :: forall eff prop. Testable prop => Int -> Gen prop -> QC eff Unit
quickCheckGen' :: forall prop. Testable prop => Int -> Gen prop -> Effect Unit
quickCheckGen' = quickCheck'

-- | A variant of the `quickCheck'` function that accepts a specific seed as
-- | well as the number tests that should be run.
quickCheckWithSeed
:: forall eff prop. Testable prop => Seed -> Int -> prop -> QC eff Unit
:: forall prop. Testable prop => Seed -> Int -> prop -> Effect Unit
quickCheckWithSeed initialSeed n prop = do
let result = tailRec loop { seed: initialSeed, index: 0, successes: 0, firstFailure: mempty }
log $ show result.successes <> "/" <> show n <> " test(s) passed."
for_ result.firstFailure \{ index, message, seed: failureSeed } ->
throwException $ error
$ "Test " <> show (index + 1)
<> " (seed " <> show (runSeed failureSeed) <> ") failed: \n"
<> " (seed " <> show (unSeed failureSeed) <> ") failed: \n"
<> message
where
loop :: LoopState -> Step LoopState LoopState
Expand All @@ -133,7 +127,7 @@ quickCheckWithSeed initialSeed n prop = do
}

-- | A version of `quickCheckWithSeed` with the property specialized to `Gen`.
quickCheckGenWithSeed :: forall eff prop. Testable prop => Seed -> Int -> Gen prop -> QC eff Unit
quickCheckGenWithSeed :: forall prop. Testable prop => Seed -> Int -> Gen prop -> Effect Unit
quickCheckGenWithSeed = quickCheckWithSeed

type LoopState =
Expand Down
72 changes: 30 additions & 42 deletions src/Test/QuickCheck/Arbitrary.purs
Original file line number Diff line number Diff line change
Expand Up @@ -15,14 +15,14 @@ import Prelude

import Control.Monad.Gen.Class (chooseBool)
import Control.Monad.Gen.Common as MGC
import Control.Monad.ST (pureST)
import Control.Monad.ST as ST
import Data.Array.NonEmpty (NonEmptyArray)
import Data.Array.NonEmpty as NEA
import Data.Array.ST (pushSTArray, unsafeFreeze, unsafeThaw)
import Data.Char (toCharCode, fromCharCode)
import Data.Array.ST as STA
import Data.Either (Either(..))
import Data.Enum (fromEnum, toEnumWithDefaults)
import Data.Foldable (foldl)
import Data.Generic.Rep (class Generic, to, from, NoArguments(..), Sum(..), Product(..), Constructor(..), Argument(..), Rec(..), Field(..))
import Data.Generic.Rep (class Generic, to, from, NoArguments(..), Sum(..), Product(..), Constructor(..), Argument(..))
import Data.Identity (Identity(..))
import Data.Int (toNumber)
import Data.Lazy (Lazy, defer, force)
Expand All @@ -31,16 +31,19 @@ import Data.List.NonEmpty (NonEmptyList(..))
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (wrap)
import Data.NonEmpty (NonEmpty(..), (:|))
import Data.Record (insert)
import Data.String (charCodeAt, fromCharArray, split)
import Data.String (split)
import Data.String.CodeUnits (charAt, fromCharArray)
import Data.String.NonEmpty (NonEmptyString)
import Data.String.NonEmpty as NES
import Data.String.NonEmpty.CodeUnits as NESCU
import Data.Symbol (class IsSymbol, SProxy(..))
import Data.Tuple (Tuple(..))
import Partial.Unsafe (unsafePartial)
import Prim.Row as Row
import Prim.RowList as RL
import Record as Record
import Test.QuickCheck.Gen (Gen, arrayOf, chooseInt, elements, listOf, oneOf, perturbGen, repeatable, sized, uniform)
import Type.Prelude (class RowToList)
import Type.Row (kind RowList, class RowLacks, Nil, Cons, RLProxy(..))
import Type.Data.RowList (RLProxy(..))

-- | The `Arbitrary` class represents those types whose values can be
-- | _randomly-generated_.
Expand Down Expand Up @@ -85,19 +88,19 @@ instance arbString :: Arbitrary String where
arbitrary = fromCharArray <$> arbitrary

instance coarbString :: Coarbitrary String where
coarbitrary s = coarbitrary $ (charCodeAt zero <$> split (wrap "") s)
coarbitrary s = coarbitrary $ (charAt zero <$> split (wrap "") s)

instance arbNonEmptyString :: Arbitrary NonEmptyString where
arbitrary = NES.cons <$> arbitrary <*> arbitrary
arbitrary = NESCU.cons <$> arbitrary <*> arbitrary

instance coarbNonEmptyString :: Coarbitrary NonEmptyString where
coarbitrary = coarbitrary <<< NES.toString

instance arbChar :: Arbitrary Char where
arbitrary = fromCharCode <$> chooseInt 0 65536
arbitrary = toEnumWithDefaults bottom top <$> chooseInt 0 65536

instance coarbChar :: Coarbitrary Char where
coarbitrary c = coarbitrary $ toCharCode c
coarbitrary c = coarbitrary $ fromEnum c

instance arbUnit :: Arbitrary Unit where
arbitrary = pure unit
Expand All @@ -117,16 +120,16 @@ instance arbArray :: Arbitrary a => Arbitrary (Array a) where
arbitrary = arrayOf arbitrary

instance coarbArray :: Coarbitrary a => Coarbitrary (Array a) where
coarbitrary = foldl (\f x -> f <<< coarbitrary x) id
coarbitrary = foldl (\f x -> f <<< coarbitrary x) identity

instance arbNonEmptyArray :: Arbitrary a => Arbitrary (NonEmptyArray a) where
arbitrary = do
x <- arbitrary
xs <- arbitrary
pure $ unsafePartial fromJust $ NEA.fromArray $ pureST do
mxs <- unsafeThaw xs
_ <- pushSTArray mxs x
unsafeFreeze mxs
pure $ unsafePartial fromJust $ NEA.fromArray $ ST.run do
mxs <- STA.unsafeThaw xs
_ <- STA.push x mxs
STA.unsafeFreeze mxs

instance coarbNonEmptyArray :: Coarbitrary a => Coarbitrary (NonEmptyArray a) where
coarbitrary = coarbitrary <<< NEA.toArray
Expand Down Expand Up @@ -163,7 +166,7 @@ instance arbitraryList :: Arbitrary a => Arbitrary (List a) where
arbitrary = sized \n -> chooseInt zero n >>= flip listOf arbitrary

instance coarbList :: Coarbitrary a => Coarbitrary (List a) where
coarbitrary = foldl (\f x -> f <<< coarbitrary x) id
coarbitrary = foldl (\f x -> f <<< coarbitrary x) identity

instance arbitraryIdentity :: Arbitrary a => Arbitrary (Identity a) where
arbitrary = Identity <$> arbitrary
Expand Down Expand Up @@ -193,7 +196,7 @@ instance arbitraryNoArguments :: Arbitrary NoArguments where
arbitrary = pure NoArguments

instance coarbitraryNoArguments :: Coarbitrary NoArguments where
coarbitrary NoArguments = id
coarbitrary NoArguments = identity

-- | To be able to evenly distribute over chains of Sum types we build up
-- | a collection of generators and choose between. Each right component
Expand Down Expand Up @@ -232,18 +235,6 @@ instance arbitraryArgument :: Arbitrary a => Arbitrary (Argument a) where
instance coarbitraryArgument :: Coarbitrary a => Coarbitrary (Argument a) where
coarbitrary (Argument a) = coarbitrary a

instance arbitraryRec :: Arbitrary a => Arbitrary (Rec a) where
arbitrary = Rec <$> arbitrary

instance coarbitraryRec :: Coarbitrary a => Coarbitrary (Rec a) where
coarbitrary (Rec a) = coarbitrary a

instance arbitraryField :: Arbitrary a => Arbitrary (Field s a) where
arbitrary = Field <$> arbitrary

instance coarbitraryField :: Coarbitrary a => Coarbitrary (Field s a) where
coarbitrary (Field a) = coarbitrary a

-- | A `Generic` implementation of the `arbitrary` member from the `Arbitrary` type class.
genericArbitrary :: forall a rep. Generic a rep => Arbitrary rep => Gen a
genericArbitrary = to <$> (arbitrary :: Gen rep)
Expand All @@ -253,30 +244,27 @@ genericCoarbitrary :: forall a rep. Generic a rep => Coarbitrary rep => a -> Gen
genericCoarbitrary x g = to <$> coarbitrary (from x) (from <$> g)

-- | A helper typeclass to implement `Arbitrary` for records.
class ArbitraryRowList
(list :: RowList)
(row :: # Type)
| list -> row where
class ArbitraryRowList list row | list -> row where
arbitraryRecord :: RLProxy list -> Gen (Record row)

instance arbitraryRowListNil :: ArbitraryRowList Nil () where
instance arbitraryRowListNil :: ArbitraryRowList RL.Nil () where
arbitraryRecord _ = pure {}

instance arbitraryRowListCons ::
( Arbitrary a
, ArbitraryRowList listRest rowRest
, RowLacks key rowRest
, RowCons key a rowRest rowFull
, RowToList rowFull (Cons key a listRest)
, Row.Lacks key rowRest
, Row.Cons key a rowRest rowFull
, RL.RowToList rowFull (RL.Cons key a listRest)
, IsSymbol key
) => ArbitraryRowList (Cons key a listRest) rowFull where
) => ArbitraryRowList (RL.Cons key a listRest) rowFull where
arbitraryRecord _ = do
value <- arbitrary
previous <- arbitraryRecord (RLProxy :: RLProxy listRest)
pure $ insert (SProxy :: SProxy key) value previous
pure $ Record.insert (SProxy :: SProxy key) value previous

instance arbitraryRecordInstance ::
( RowToList row list
( RL.RowToList row list
, ArbitraryRowList list row
) => Arbitrary (Record row) where
arbitrary = arbitraryRecord (RLProxy :: RLProxy list)
Loading

0 comments on commit af9203c

Please sign in to comment.