diff --git a/.eslintrc.json b/.eslintrc.json deleted file mode 100644 index 1c6afb9..0000000 --- a/.eslintrc.json +++ /dev/null @@ -1,26 +0,0 @@ -{ - "parserOptions": { - "ecmaVersion": 6, - "sourceType": "module" - }, - "extends": "eslint:recommended", - "rules": { - "strict": [2, "global"], - "block-scoped-var": 2, - "consistent-return": 2, - "eqeqeq": [2, "smart"], - "guard-for-in": 2, - "no-caller": 2, - "no-extend-native": 2, - "no-loop-func": 2, - "no-new": 2, - "no-param-reassign": 2, - "no-return-assign": 2, - "no-unused-expressions": 2, - "no-use-before-define": 2, - "radix": [2, "always"], - "indent": [2, 2], - "quotes": [2, "double"], - "semi": [2, "always"] - } -} diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index c69237a..1a2a70b 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -6,30 +6,30 @@ on: pull_request: branches: [master] +permissions: + contents: read + jobs: build: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 - - - uses: purescript-contrib/setup-purescript@main - with: - purescript: "unstable" + - uses: actions/checkout@v6 - - uses: actions/setup-node@v2 + - uses: actions/setup-node@v6 with: - node-version: "14.x" + node-version: "24" - name: Install dependencies - run: | - npm install -g bower - npm install - bower install --production + run: npm install - name: Build source - run: npm run-script build + run: npm run build - name: Run tests - run: | - bower install - npm run-script test --if-present + run: npm test + + - name: Lint + run: npm run lint + + - name: Check formatting + run: npm run format:check diff --git a/.gitignore b/.gitignore index b846b63..7ddb3b1 100644 --- a/.gitignore +++ b/.gitignore @@ -1,8 +1,10 @@ /.* !/.gitignore -!/.eslintrc.json +!/.tidyrc.json +!/.oxfmtrc.json !/.github/ /bower_components/ /node_modules/ /output/ -package-lock.json +/package-lock.json +/spago.lock diff --git a/.oxfmtrc.json b/.oxfmtrc.json new file mode 100644 index 0000000..757fd64 --- /dev/null +++ b/.oxfmtrc.json @@ -0,0 +1,3 @@ +{ + "trailingComma": "es5" +} diff --git a/.tidyrc.json b/.tidyrc.json new file mode 100644 index 0000000..9e39cf1 --- /dev/null +++ b/.tidyrc.json @@ -0,0 +1,10 @@ +{ + "importSort": "ide", + "importWrap": "source", + "indent": 2, + "operatorsFile": null, + "ribbon": 1, + "typeArrowPlacement": "first", + "unicode": "never", + "width": null +} diff --git a/CHANGELOG.md b/CHANGELOG.md index 81b277d..38fd5c5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,14 +12,22 @@ Bugfixes: Other improvements: +## [v8.0.2](https://github.com/purescript/purescript-quickcheck/releases/tag/v8.0.2) - 2026-10-17 + +Other improvements: + +- Migrate from Bower/Pulp to Spago and update CI, linting, and formatting (#138 by @thomashoneyman). + ## [v8.0.1](https://github.com/purescript/purescript-quickcheck/releases/tag/v8.0.1) - 2022-04-27 Bugfixes: + - Remove duplicate `numbers` import from the bower.json file to support publishing to Pursuit (#128 by @thomashoneyman) ## [v8.0.0](https://github.com/purescript/purescript-quickcheck/releases/tag/v8.0.0) - 2022-04-27 Breaking changes: + - Migrate FFI to ES modules (#130 by @kl0tl and @JordanMartinez) - Replaced polymorphic proxies with monomorphic `Proxy` (#132 by @JordanMartinez) - Make `frequency` use `NonEmptyArray` (#131 by @JordanMartinez) @@ -29,34 +37,42 @@ Breaking changes: New features: Bugfixes: + - `quickCheckPure` and `quickCheckPure'` stack safety (#127) Other improvements: + - Drop `math` dependency; update imports (#133 by @JordanMartinez) ## [v7.1.0](https://github.com/purescript/purescript-quickcheck/releases/tag/v7.1.0) - 2021-04-27 New features: + - Export `enum` and `randomSampleOne` (#125 by @JordanMartinez) Other improvements: + - Fix warning revealed by v0.14.1 PS release (#125 by @JordanMartinez) ## [v7.0.0](https://github.com/purescript/purescript-quickcheck/releases/tag/v7.0.0) - 2021-02-26 Breaking changes: + - Added support for PureScript 0.14 and dropped support for all previous versions (#115) - Fixed `genericCoarbitrary` so it no longer explicitly relates to the generated data (#99) - Replaced `NonEmpty Array` and `NonEmpty List` with `NonEmptyArray` and `NonEmptyList` (#118) -- Replaced `globals` dependency with `numbers` (#120) +- Replaced `globals` dependency with `numbers` (#120) New features: -- Added `randomSampleOne` (#114) + +- Added `randomSampleOne` (#114) Bugfixes: -- Allowed full `Number` range for chooseFloat (#97) + +- Allowed full `Number` range for chooseFloat (#97) Other improvements: + - Dropped `generics-rep` dependency as its now included in `prelude` (#121) - Replaced monomorphic proxies with `Type.Proxy.Proxy` and polymorphic variables (#116) - Migrated CI to GitHub Actions and updated installation instructions to use Spago (#117) @@ -118,7 +134,7 @@ Other improvements: - Updated for PureScript 0.11 - Use `NonEmpty` for `Gen`s where called for (@matthewleon) - Improved behaviour of `chooseInt` (@matthewleon) -- Added `Arbitrary` and `Coarbitrary` instances for `NonEmpty` and `NonEmptyList` (@matthewleon) +- Added `Arbitrary` and `Coarbitrary` instances for `NonEmpty` and `NonEmptyList` (@matthewleon) - Added `enum` `Gen` for `BoundedEnum` values (@matthewleon) ## [v3.1.1](https://github.com/purescript/purescript-quickcheck/releases/tag/v3.1.1) - 2016-11-22 @@ -202,6 +218,7 @@ This release works with versions 0.7.\* of the PureScript compiler. It will not ## [v0.5.0](https://github.com/purescript/purescript-quickcheck/releases/tag/v0.5.0) - 2015-02-21 **This release requires PureScript v0.6.8 or later** + - Updated dependencies ## [v0.4.0](https://github.com/purescript/purescript-quickcheck/releases/tag/v0.4.0) - 2015-01-10 diff --git a/GUIDE.md b/GUIDE.md index 60ae892..0115379 100644 --- a/GUIDE.md +++ b/GUIDE.md @@ -16,12 +16,12 @@ QuickCheck works by generating random data with which to test your properties. T QuickCheck defines the `quickCheck` function, which will print test results to the console, or fail with an exception in the event of a test failure. -Create a new project using Pulp, install `purescript-quickcheck`, and open PSCi: +Create a new project using Spago, install `quickcheck`, and open PSCi: ```text -pulp init -bower install purescript-quickcheck -pulp repl +spago init +spago install quickcheck +spago repl ``` Start by importing the QuickCheck library: diff --git a/bower.json b/bower.json deleted file mode 100644 index 271a43c..0000000 --- a/bower.json +++ /dev/null @@ -1,54 +0,0 @@ -{ - "name": "purescript-quickcheck", - "homepage": "https://github.com/purescript/purescript-quickcheck", - "license": "BSD-3-Clause", - "authors": [ - "John A. De Goes (http://degoes.net)", - "Phil Freeman " - ], - "repository": { - "type": "git", - "url": "https://github.com/purescript/purescript-quickcheck.git" - }, - "ignore": [ - "**/.*", - "bower_components", - "node_modules", - "output", - "test", - "bower.json", - "package.json" - ], - "dependencies": { - "purescript-arrays": "^7.0.0", - "purescript-console": "^6.0.0", - "purescript-control": "^6.0.0", - "purescript-effect": "^4.0.0", - "purescript-either": "^6.0.0", - "purescript-enums": "^6.0.0", - "purescript-exceptions": "^6.0.0", - "purescript-foldable-traversable": "^6.0.0", - "purescript-gen": "^4.0.0", - "purescript-identity": "^6.0.0", - "purescript-integers": "^6.0.0", - "purescript-lazy": "^6.0.0", - "purescript-lcg": "^4.0.0", - "purescript-lists": "^7.0.0", - "purescript-maybe": "^6.0.0", - "purescript-newtype": "^5.0.0", - "purescript-nonempty": "^7.0.0", - "purescript-numbers": "^9.0.0", - "purescript-partial": "^4.0.0", - "purescript-prelude": "^6.0.0", - "purescript-record": "^4.0.0", - "purescript-st": "^6.0.0", - "purescript-strings": "^6.0.0", - "purescript-tailrec": "^6.0.0", - "purescript-transformers": "^6.0.0", - "purescript-tuples": "^7.0.0", - "purescript-unfoldable": "^6.0.0" - }, - "devDependencies": { - "purescript-assert": "^6.0.0" - } -} diff --git a/package.json b/package.json index a1d6811..c0a8ad2 100644 --- a/package.json +++ b/package.json @@ -1,14 +1,17 @@ { "private": true, "scripts": { - "clean": "rimraf output && rimraf .pulp-cache", - "build": "eslint src && pulp build -- --censor-lib --strict", - "test": "pulp test" + "build": "spago build", + "test": "spago test", + "lint": "oxlint --deny-warnings src test", + "format": "purs-tidy format-in-place src test && oxfmt --write .", + "format:check": "purs-tidy check src test && oxfmt --check ." }, "devDependencies": { - "eslint": "^7.15.0", - "pulp": "16.0.0-0", - "purescript-psa": "^0.8.2", - "rimraf": "^3.0.2" + "oxfmt": "^0.73.0", + "oxlint": "^1.88.0", + "purescript": "^0.15.16", + "purs-tidy": "^0.11.1", + "spago": "^1.0.5" } } diff --git a/spago.yaml b/spago.yaml new file mode 100644 index 0000000..3e05d7b --- /dev/null +++ b/spago.yaml @@ -0,0 +1,46 @@ +package: + name: quickcheck + description: An implementation of QuickCheck in PureScript. + build: + strict: true + pedanticPackages: true + publish: + version: 8.0.2 + license: BSD-3-Clause + location: + githubOwner: purescript + githubRepo: purescript-quickcheck + dependencies: + - arrays: ">=7.0.0 <8.0.0" + - console: ">=6.0.0 <7.0.0" + - control: ">=6.0.0 <7.0.0" + - effect: ">=4.0.0 <5.0.0" + - either: ">=6.0.0 <7.0.0" + - enums: ">=6.0.0 <7.0.0" + - exceptions: ">=6.0.0 <7.0.0" + - foldable-traversable: ">=6.0.0 <7.0.0" + - gen: ">=4.0.0 <5.0.0" + - identity: ">=6.0.0 <7.0.0" + - integers: ">=6.0.0 <7.0.0" + - lazy: ">=6.0.0 <7.0.0" + - lcg: ">=4.0.0 <5.0.0" + - lists: ">=7.0.0 <8.0.0" + - maybe: ">=6.0.0 <7.0.0" + - newtype: ">=5.0.0 <6.0.0" + - nonempty: ">=7.0.0 <8.0.0" + - numbers: ">=9.0.0 <10.0.0" + - partial: ">=4.0.0 <5.0.0" + - prelude: ">=6.0.0 <7.0.0" + - record: ">=4.0.0 <5.0.0" + - st: ">=6.0.0 <7.0.0" + - strings: ">=6.0.0 <7.0.0" + - tailrec: ">=6.0.0 <7.0.0" + - transformers: ">=6.0.0 <7.0.0" + - tuples: ">=7.0.0 <8.0.0" + test: + main: Test.Main + strict: true + pedanticPackages: true + dependencies: + - assert: ">=6.0.0 <7.0.0" +workspace: {} diff --git a/src/Test/QuickCheck.purs b/src/Test/QuickCheck.purs index 4333eb5..cc891f8 100644 --- a/src/Test/QuickCheck.purs +++ b/src/Test/QuickCheck.purs @@ -64,9 +64,9 @@ import Data.Maybe.First (First(..)) import Data.Tuple (Tuple(..), snd) 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 Effect.Exception (error, throwException) +import Random.LCG (Seed, mkSeed, randomSeed, unSeed) +import Test.QuickCheck.Arbitrary (class Arbitrary, class Coarbitrary, arbitrary, coarbitrary) import Test.QuickCheck.Gen (Gen, runGen) -- | Test a property. @@ -108,8 +108,10 @@ quickCheckWithSeed initialSeed n prop = do for_ result.firstFailure \{ index, message, seed: failureSeed } -> throwException $ error $ "Test " <> show (index + 1) - <> " (seed " <> show (unSeed failureSeed) <> ") failed: \n" - <> message + <> " (seed " + <> show (unSeed failureSeed) + <> ") failed: \n" + <> message where loop :: LoopState -> Step LoopState LoopState loop state@{ seed, index, successes, firstFailure } @@ -158,17 +160,17 @@ quickCheckPure s n prop = map snd (quickCheckPure' s n prop) quickCheckPure' :: forall prop. Testable prop => Seed -> Int -> prop -> List (Tuple Seed Result) quickCheckPure' s n prop = tailRec loop { seed: s, index: 0, results: mempty } where - loop :: PureLoopState -> Step PureLoopState (List (Tuple Seed Result)) - loop { seed, index, results } - | index == n = Done (List.reverse (results)) - | otherwise = - case runGen (test prop) { newSeed: seed, size: 10 } of - Tuple r {newSeed} -> - Loop - { seed: newSeed - , index: index + 1 - , results: (Tuple seed r) : results - } + loop :: PureLoopState -> Step PureLoopState (List (Tuple Seed Result)) + loop { seed, index, results } + | index == n = Done (List.reverse (results)) + | otherwise = + case runGen (test prop) { newSeed: seed, size: 10 } of + Tuple r { newSeed } -> + Loop + { seed: newSeed + , index: index + 1 + , results: (Tuple seed r) : results + } type PureLoopState = { seed :: Seed @@ -195,13 +197,13 @@ type ResultSummary = checkResults :: List (Tuple Seed Result) -> ResultSummary checkResults = foldlWithIndex go { total: 0, successes: 0, failures: List.Nil } where - go :: Int -> ResultSummary -> Tuple Seed Result -> ResultSummary - go index st (Tuple seed result) = - case result of - Success -> - st { total = st.total + 1, successes = st.successes + 1 } - Failed message -> - st { total = st.total + 1, failures = List.Cons { index, seed, message } st.failures } + go :: Int -> ResultSummary -> Tuple Seed Result -> ResultSummary + go index st (Tuple seed result) = + case result of + Success -> + st { total = st.total + 1, successes = st.successes + 1 } + Failed message -> + st { total = st.total + 1, failures = List.Cons { index, seed, message } st.failures } -- | Print a one-line summary in the form "x/y test(s) passed." printSummary :: ResultSummary -> String @@ -222,8 +224,9 @@ instance testableResult :: Testable Result where test = pure instance testableBoolean :: Testable Boolean where - test true = pure Success - test false = pure $ Failed "Test returned false" + test = case _ of + true -> pure Success + false -> pure $ Failed "Test returned false" instance testableFunction :: (Arbitrary t, Testable prop) => Testable (t -> prop) where test f = arbitrary >>= test <<< f @@ -235,8 +238,9 @@ instance testableGen :: Testable prop => Testable (Gen prop) where data Result = Success | Failed String instance showResult :: Show Result where - show Success = "Success" - show (Failed msg) = "Failed: " <> msg + show = case _ of + Success -> "Success" + Failed msg -> "Failed: " <> msg -- | This operator attaches an error message to a failed test. -- | @@ -246,8 +250,9 @@ instance showResult :: Show Result where -- | test x = myProperty x ("myProperty did not hold for " <> show x) -- | ``` withHelp :: Boolean -> String -> Result -withHelp true _ = Success -withHelp false msg = Failed msg +withHelp condition msg = case condition of + true -> Success + false -> Failed msg infix 2 withHelp as diff --git a/src/Test/QuickCheck/Arbitrary.purs b/src/Test/QuickCheck/Arbitrary.purs index da00627..12f3293 100644 --- a/src/Test/QuickCheck/Arbitrary.purs +++ b/src/Test/QuickCheck/Arbitrary.purs @@ -23,7 +23,7 @@ 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(..)) +import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to) import Data.Identity (Identity(..)) import Data.Int (toNumber) import Data.Lazy (Lazy, defer, force) @@ -78,8 +78,9 @@ instance arbBoolean :: Arbitrary Boolean where arbitrary = chooseBool instance coarbBoolean :: Coarbitrary Boolean where - coarbitrary true = perturbGen 1.0 - coarbitrary false = perturbGen 2.0 + coarbitrary = case _ of + true -> perturbGen 1.0 + false -> perturbGen 2.0 instance arbNumber :: Arbitrary Number where arbitrary = uniform @@ -118,12 +119,13 @@ instance coarbUnit :: Coarbitrary Unit where coarbitrary _ = perturbGen 1.0 instance arbOrdering :: Arbitrary Ordering where - arbitrary = elements $ unsafePartial fromJust $ NEA.fromArray [LT, EQ, GT] + arbitrary = elements $ unsafePartial fromJust $ NEA.fromArray [ LT, EQ, GT ] instance coarbOrdering :: Coarbitrary Ordering where - coarbitrary LT = perturbGen 1.0 - coarbitrary EQ = perturbGen 2.0 - coarbitrary GT = perturbGen 3.0 + coarbitrary = case _ of + LT -> perturbGen 1.0 + EQ -> perturbGen 2.0 + GT -> perturbGen 3.0 instance arbArray :: Arbitrary a => Arbitrary (Array a) where arbitrary = arrayOf arbitrary @@ -133,12 +135,12 @@ instance coarbArray :: Coarbitrary a => Coarbitrary (Array a) where instance arbNonEmptyArray :: Arbitrary a => Arbitrary (NonEmptyArray a) where arbitrary = do - x <- arbitrary - xs <- arbitrary - pure $ unsafePartial fromJust $ NEA.fromArray $ ST.run do - mxs <- STA.unsafeThaw xs - _ <- STA.push x mxs - STA.unsafeFreeze mxs + x <- arbitrary + xs <- arbitrary + 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 @@ -185,15 +187,17 @@ instance arbMaybe :: Arbitrary a => Arbitrary (Maybe a) where arbitrary = MGC.genMaybe arbitrary instance coarbMaybe :: Coarbitrary a => Coarbitrary (Maybe a) where - coarbitrary Nothing = perturbGen 1.0 - coarbitrary (Just a) = coarbitrary a + coarbitrary = case _ of + Nothing -> perturbGen 1.0 + Just a -> coarbitrary a instance arbEither :: (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where arbitrary = MGC.genEither arbitrary arbitrary instance coarbEither :: (Coarbitrary a, Coarbitrary b) => Coarbitrary (Either a b) where - coarbitrary (Left a) = coarbitrary a - coarbitrary (Right b) = coarbitrary b + coarbitrary = case _ of + Left a -> coarbitrary a + Right b -> coarbitrary b instance arbitraryList :: Arbitrary a => Arbitrary (List a) where arbitrary = sized \n -> chooseInt zero n >>= flip listOf arbitrary @@ -241,14 +245,15 @@ instance arbGenSumSum :: (Arbitrary l, ArbitraryGenericSum r) => ArbitraryGeneri arbitraryGenericSum = (Inl <$> arbitrary) : (map Inr <$> arbitraryGenericSum) instance arbGenSumConstructor :: Arbitrary a => ArbitraryGenericSum (Constructor s a) where - arbitraryGenericSum = [arbitrary] + arbitraryGenericSum = [ arbitrary ] instance arbitrarySum :: (Arbitrary l, ArbitraryGenericSum r) => Arbitrary (Sum l r) where arbitrary = oneOf $ unsafePartial fromJust $ NEA.fromArray $ (Inl <$> arbitrary) : (map Inr <$> arbitraryGenericSum) instance coarbitrarySum :: (Coarbitrary l, Coarbitrary r) => Coarbitrary (Sum l r) where - coarbitrary (Inl l) = coarbitrary l - coarbitrary (Inr r) = coarbitrary r + coarbitrary = case _ of + Inl l -> coarbitrary l + Inr r -> coarbitrary r instance arbitraryProduct :: (Arbitrary l, Arbitrary r) => Arbitrary (Product l r) where arbitrary = Product <$> arbitrary <*> arbitrary @@ -291,14 +296,16 @@ instance arbitraryRowListCons :: , Row.Cons key a rowRest rowFull , RL.RowToList rowFull (RL.Cons key a listRest) , IsSymbol key - ) => ArbitraryRowList (RL.Cons key a listRest) rowFull where + ) => + ArbitraryRowList (RL.Cons key a listRest) rowFull where arbitraryRecord _ = do - value <- arbitrary - previous <- arbitraryRecord (Proxy :: Proxy listRest) - pure $ Record.insert (Proxy :: Proxy key) value previous + value <- arbitrary + previous <- arbitraryRecord (Proxy :: Proxy listRest) + pure $ Record.insert (Proxy :: Proxy key) value previous instance arbitraryRecordInstance :: ( RL.RowToList row list , ArbitraryRowList list row - ) => Arbitrary (Record row) where + ) => + Arbitrary (Record row) where arbitrary = arbitraryRecord (Proxy :: Proxy list) diff --git a/src/Test/QuickCheck/Gen.js b/src/Test/QuickCheck/Gen.js index 55d7a56..d724a20 100644 --- a/src/Test/QuickCheck/Gen.js +++ b/src/Test/QuickCheck/Gen.js @@ -1,4 +1,3 @@ -/* global ArrayBuffer, Float32Array, Int32Array */ // module Test.QuickCheck.Gen export function float32ToInt32(n) { diff --git a/src/Test/QuickCheck/Gen.purs b/src/Test/QuickCheck/Gen.purs index 6c73d19..c8a768b 100644 --- a/src/Test/QuickCheck/Gen.purs +++ b/src/Test/QuickCheck/Gen.purs @@ -38,23 +38,23 @@ import Control.Alt (class Alt) import Control.Lazy (class Lazy) import Control.Monad.Gen.Class (class MonadGen) import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) -import Control.Monad.State (State, runState, evalState) +import Control.Monad.State (State, evalState, runState) import Control.Monad.State.Class (modify, state) -import Data.Array ((:), length, zip, sortBy) +import Data.Array (length, sortBy, zip, (:)) import Data.Array.NonEmpty (NonEmptyArray) import Data.Array.NonEmpty as NEA import Data.Enum (class BoundedEnum, fromEnum, toEnum) -import Data.Semigroup.Foldable (foldMap1) -import Data.Int (toNumber, floor) +import Data.Int (floor, toNumber) import Data.List (List(..), toUnfoldable) import Data.Maybe (Maybe(..), fromJust) import Data.Monoid.Additive (Additive(..)) import Data.Newtype (unwrap) import Data.Number ((%)) +import Data.Semigroup.Foldable (foldMap1) import Data.Tuple (Tuple(..), fst, snd) import Effect (Effect) import Partial.Unsafe (unsafePartial) -import Random.LCG (Seed, lcgPerturb, lcgM, lcgNext, unSeed, randomSeed) +import Random.LCG (Seed, lcgM, lcgNext, lcgPerturb, randomSeed, unSeed) -- | Tests are parameterized by the `Size` of the randomly-generated data, -- | the meaning of which depends on the particular generator used. @@ -117,12 +117,13 @@ sized f = stateful (\s -> f s.size) -- | Modify a random generator by setting a new size parameter. resize :: forall a. Size -> Gen a -> Gen a resize sz g = Gen $ state \{ newSeed, size } -> - (_ {size = size} ) <$> runGen g { newSeed, size: sz} + (_ { size = size }) <$> runGen g { newSeed, size: sz } -- | Create a random generator which samples a range of `Number`s i -- | with uniform probability. choose :: Number -> Number -> Gen Number -choose a b = (*) (max' - min') >>> (+) min' >>> unscale <$> uniform where +choose a b = (*) (max' - min') >>> (+) min' >>> unscale <$> uniform + where unscale = (_ * 2.0) scale = (_ * 0.5) min' = scale $ min a b @@ -138,18 +139,18 @@ chooseInt a b = if a <= b then chooseInt' a b else chooseInt' b a chooseInt' :: Int -> Int -> Gen Int chooseInt' a b = floor <<< clamp <$> choose32BitPosNumber where - choose32BitPosNumber :: Gen Number - choose32BitPosNumber = - (+) <$> choose31BitPosNumber <*> (((*) 2.0) <$> choose31BitPosNumber) + choose32BitPosNumber :: Gen Number + choose32BitPosNumber = + (+) <$> choose31BitPosNumber <*> (((*) 2.0) <$> choose31BitPosNumber) - choose31BitPosNumber :: Gen Number - choose31BitPosNumber = toNumber <$> lcgStep + choose31BitPosNumber :: Gen Number + choose31BitPosNumber = toNumber <$> lcgStep - clamp :: Number -> Number - clamp x = numA + (x % (numB - numA + one)) + clamp :: Number -> Number + clamp x = numA + (x % (numB - numA + one)) - numA = toNumber a - numB = toNumber b + numA = toNumber a + numB = toNumber b -- | Create a random generator which selects and executes a random generator from -- | a non-empty array of random generators with uniform probability. @@ -161,7 +162,7 @@ oneOf xs = do -- | Create a random generator which selects and executes a random generator from -- | a non-empty, weighted list of random generators. frequency :: forall a. NonEmptyArray (Tuple Number (Gen a)) -> Gen a -frequency xxs = +frequency xxs = do let default = snd $ NEA.head xxs total = unwrap $ foldMap1 (Additive <<< fst) xxs @@ -170,23 +171,24 @@ frequency xxs = Just (Tuple k x') | n <= k -> x' | otherwise -> pick (i + 1) (n - k) - in do - n <- choose zero total - pick 0 n + n <- choose zero total + pick 0 n -- | Create a random generator which generates an array of random values. arrayOf :: forall a. Gen a -> Gen (Array a) arrayOf g = sized $ \n -> - do k <- chooseInt zero n - vectorOf k g + do + k <- chooseInt zero n + vectorOf k g -- | Create a random generator which generates a non-empty array of random values. arrayOf1 :: forall a. Gen a -> Gen (NonEmptyArray a) arrayOf1 g = sized $ \n -> - do k <- chooseInt zero n - x <- g - xs <- vectorOf (k - one) g - pure $ unsafePartial fromJust $ NEA.fromArray $ x : xs + do + k <- chooseInt zero n + x <- g + xs <- vectorOf (k - one) g + pure $ unsafePartial fromJust $ NEA.fromArray $ x : xs -- | Create a random generator for a finite enumeration. -- | `toEnum i` must be well-behaved: @@ -202,8 +204,9 @@ replicateMRec k _ | k <= 0 = pure Nil replicateMRec k gen = tailRecM go (Tuple Nil k) where go :: (Tuple (List a) Int) -> m (Step (Tuple (List a) Int) (List a)) - go (Tuple acc 0) = pure $ Done acc - go (Tuple acc n) = gen <#> \x -> Loop (Tuple (Cons x acc) (n - 1)) + go = case _ of + Tuple acc 0 -> pure $ Done acc + Tuple acc n -> gen <#> \x -> Loop (Tuple (Cons x acc) (n - 1)) -- | Create a random generator which generates a list of random values of the specified size. listOf :: forall a. Int -> Gen a -> Gen (List a) @@ -256,7 +259,8 @@ randomSample = randomSample' 10 -- | A random generator which simply outputs the current seed lcgStep :: Gen Int -lcgStep = Gen $ state f where +lcgStep = Gen $ state f + where f s = Tuple (unSeed s.newSeed) (s { newSeed = lcgNext s.newSeed }) -- | A random generator which approximates a uniform random variable on `[0, 1]` diff --git a/test/Main.purs b/test/Main.purs index 269ce02..d232d4f 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -8,40 +8,42 @@ import Data.Array.Partial (head) import Data.Either (isLeft) import Data.Foldable (sum) import Data.Generic.Rep (class Generic) +import Data.List as List +import Data.Maybe (Maybe(..)) +import Data.Number (isFinite) import Data.Show.Generic (genericShow) import Data.Tuple (fst) import Effect (Effect) import Effect.Console (log, logShow) import Effect.Exception (try) -import Data.Number (isFinite) import Partial.Unsafe (unsafePartial) import Random.LCG (mkSeed) import Test.Assert (assert) import Test.QuickCheck (class Testable, quickCheck, quickCheckPure', (/=?), (<=?), (=?), (>?)) -import Test.QuickCheck.Arbitrary (arbitrary, genericArbitrary, class Arbitrary) +import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary, genericArbitrary) import Test.QuickCheck.Gen (Gen, Size, randomSample, randomSample', resize, runGen, sized, vectorOf) -import Data.Maybe (Maybe(..)) -import Data.List as List data Foo a = F0 a | F1 a a | F2 { foo :: a, bar :: Array a } + derive instance genericFoo :: Generic (Foo a) _ -instance showFoo :: Show a => Show (Foo a) where show = genericShow -instance arbitraryFoo :: Arbitrary a => Arbitrary (Foo a) where arbitrary = genericArbitrary +instance showFoo :: Show a => Show (Foo a) where + show = genericShow + +instance arbitraryFoo :: Arbitrary a => Arbitrary (Foo a) where + arbitrary = genericArbitrary quickCheckFail :: forall t. Testable t => t -> Effect Unit quickCheckFail = assert <=< map isLeft <<< try <<< quickCheck testResize :: (forall a. Size -> Gen a -> Gen a) -> Boolean -testResize resize' = - let - initialSize = 2 - gen = do - s1 <- sized pure - s2 <- resize' 1 (sized pure) - s3 <- sized pure - pure $ [ s1, s2, s3 ] == [ initialSize, 1, initialSize ] - in - fst $ runGen gen { newSeed: mkSeed 0, size: initialSize } +testResize resize' = fst $ runGen gen { newSeed: mkSeed 0, size: initialSize } + where + initialSize = 2 + gen = do + s1 <- sized pure + s2 <- resize' 1 (sized pure) + s3 <- sized pure + pure $ [ s1, s2, s3 ] == [ initialSize, 1, initialSize ] main :: Effect Unit main = do @@ -64,7 +66,7 @@ main = do logShow =<< randomSample' 10 (arbitrary :: Gen (Foo Int)) log "Arbitrary instance for records" - listOfRecords ← randomSample' 10 (arbitrary :: Gen { foo :: Int, nested :: { bar :: Boolean } }) + listOfRecords <- randomSample' 10 (arbitrary :: Gen { foo :: Int, nested :: { bar :: Boolean } }) let toString rec = "{ foo: " <> show rec.foo <> "; nested.bar: " <> show rec.nested.bar <> " }" logShow (toString <$> listOfRecords) @@ -75,27 +77,28 @@ main = do quickCheck \(x :: Int) -> x + x ==? x * 2 quickCheck \(x :: Int) -> x + x /=? x * 3 - quickCheck $ 1 ==? 1 + quickCheck $ 1 ==? 1 quickCheckFail $ 1 /=? 1 - quickCheck $ 1 =? 2 - quickCheck $ 3 <=? 3 - quickCheckFail $ 3 >? 3 - quickCheck $ 3 >=? 3 - quickCheckFail $ 3 ? 3 + quickCheck $ 3 >=? 3 + quickCheckFail $ 3 ? 3 + quickCheck $ 4 >? 3 quickCheckFail $ 4 <=? 3 log "Testing stack safety of quickCheckPure'" let n = 100_000 - let pairs = quickCheckPure' (mkSeed 1234) n \(x :: Int) -> x x show n <> " runs.") log "Checking that chooseFloat over the whole Number range always yields a finite value" - randomSample (MGen.chooseFloat ((-1.7976931348623157e+308)) (1.7976931348623157e+308)) >>= assert <<< all isFinite + samples <- randomSample (MGen.chooseFloat (-1.7976931348623157e+308) 1.7976931348623157e+308) + assert $ all isFinite samples where go n = map (sum <<< unsafeHead) $ randomSample' 1 (vectorOf n (arbitrary :: Gen Int))