From bba3a68140f87b40866f89ce39c45b8d997f41d8 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Thu, 15 Oct 2026 00:50:00 +0000 Subject: [PATCH 1/6] Migrate repository workflow to Spago --- .eslintrc.json | 26 ------------------- .github/workflows/ci.yml | 30 +++++++++++----------- .gitignore | 6 +++-- .oxfmtrc.json | 3 +++ .tidyrc.json | 10 ++++++++ CHANGELOG.md | 10 +++----- GUIDE.md | 8 +++--- bower.json | 54 ---------------------------------------- package.json | 17 +++++++------ spago.yaml | 46 ++++++++++++++++++++++++++++++++++ 10 files changed, 95 insertions(+), 115 deletions(-) delete mode 100644 .eslintrc.json create mode 100644 .oxfmtrc.json create mode 100644 .tidyrc.json delete mode 100644 bower.json create mode 100644 spago.yaml 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..03809b3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,16 +2,12 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [Unreleased] - -Breaking changes: - -New features: - -Bugfixes: +## [v8.0.2](https://github.com/purescript/purescript-quickcheck/releases/tag/v8.0.2) Other improvements: +- Migrate from Bower/Pulp to Spago and update CI, linting, and formatting. + ## [v8.0.1](https://github.com/purescript/purescript-quickcheck/releases/tag/v8.0.1) - 2022-04-27 Bugfixes: 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: {} From d734d3b98a3b9591efb2f2ab72bf2fc813685db0 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Thu, 15 Oct 2026 00:50:18 +0000 Subject: [PATCH 2/6] Apply source style fixes and remove ESLint directive --- src/Test/QuickCheck/Gen.js | 1 - src/Test/QuickCheck/Gen.purs | 7 +++---- 2 files changed, 3 insertions(+), 5 deletions(-) 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..1cbccd4 100644 --- a/src/Test/QuickCheck/Gen.purs +++ b/src/Test/QuickCheck/Gen.purs @@ -161,7 +161,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,9 +170,8 @@ 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) From 67c3f96bfd43dfae9a1b1d02ed791a653e64ffa1 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Thu, 15 Oct 2026 00:50:44 +0000 Subject: [PATCH 3/6] Format repository with purs-tidy and Oxfmt --- CHANGELOG.md | 19 +++++++++--- src/Test/QuickCheck.purs | 48 ++++++++++++++-------------- src/Test/QuickCheck/Arbitrary.purs | 32 ++++++++++--------- src/Test/QuickCheck/Gen.purs | 50 ++++++++++++++++-------------- test/Main.purs | 36 +++++++++++---------- 5 files changed, 104 insertions(+), 81 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 03809b3..984cf7a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,11 +11,13 @@ Other improvements: ## [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) @@ -25,34 +27,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) @@ -114,7 +124,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 @@ -198,6 +208,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/src/Test/QuickCheck.purs b/src/Test/QuickCheck.purs index 4333eb5..8575abe 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 diff --git a/src/Test/QuickCheck/Arbitrary.purs b/src/Test/QuickCheck/Arbitrary.purs index da00627..b70d618 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) @@ -118,7 +118,7 @@ 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 @@ -133,12 +133,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 @@ -192,7 +192,7 @@ 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 (Left a) = coarbitrary a coarbitrary (Right b) = coarbitrary b instance arbitraryList :: Arbitrary a => Arbitrary (List a) where @@ -241,7 +241,7 @@ 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) @@ -291,14 +291,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.purs b/src/Test/QuickCheck/Gen.purs index 1cbccd4..e5c57e2 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. @@ -176,16 +177,18 @@ frequency xxs = do -- | 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: @@ -255,7 +258,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..cd77693 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -8,25 +8,29 @@ 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 @@ -64,7 +68,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,22 +79,22 @@ 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.") From d49eb4e493f4e02862f48ccdc9a97809d15ba92e Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Thu, 15 Oct 2026 00:52:34 +0000 Subject: [PATCH 4/6] Credit migration pull request in changelog --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 984cf7a..b9d519f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,7 +6,7 @@ Notable changes to this project are documented in this file. The format is based Other improvements: -- Migrate from Bower/Pulp to Spago and update CI, linting, and formatting. +- 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 From d1e56bf7a95105251a70c9c8910a473c557333c9 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Thu, 15 Oct 2026 21:26:17 +0000 Subject: [PATCH 5/6] Prepare changelog release date and unreleased section --- CHANGELOG.md | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b9d519f..38fd5c5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,17 @@ Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [v8.0.2](https://github.com/purescript/purescript-quickcheck/releases/tag/v8.0.2) +## [Unreleased] + +Breaking changes: + +New features: + +Bugfixes: + +Other improvements: + +## [v8.0.2](https://github.com/purescript/purescript-quickcheck/releases/tag/v8.0.2) - 2026-10-17 Other improvements: From 6b5bdf9adda48bc3001ce7e41c4de16abc0dbe90 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Sat, 17 Oct 2026 13:03:45 +0000 Subject: [PATCH 6/6] Apply approved source style refinements --- src/Test/QuickCheck.purs | 15 +++++++++------ src/Test/QuickCheck/Arbitrary.purs | 27 ++++++++++++++++----------- src/Test/QuickCheck/Gen.purs | 5 +++-- test/Main.purs | 21 ++++++++++----------- 4 files changed, 38 insertions(+), 30 deletions(-) diff --git a/src/Test/QuickCheck.purs b/src/Test/QuickCheck.purs index 8575abe..cc891f8 100644 --- a/src/Test/QuickCheck.purs +++ b/src/Test/QuickCheck.purs @@ -224,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 @@ -237,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. -- | @@ -248,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 b70d618..12f3293 100644 --- a/src/Test/QuickCheck/Arbitrary.purs +++ b/src/Test/QuickCheck/Arbitrary.purs @@ -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 @@ -121,9 +122,10 @@ instance arbOrdering :: Arbitrary Ordering where 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 @@ -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 @@ -247,8 +251,9 @@ instance arbitrarySum :: (Arbitrary l, ArbitraryGenericSum r) => Arbitrary (Sum 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 diff --git a/src/Test/QuickCheck/Gen.purs b/src/Test/QuickCheck/Gen.purs index e5c57e2..c8a768b 100644 --- a/src/Test/QuickCheck/Gen.purs +++ b/src/Test/QuickCheck/Gen.purs @@ -204,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) diff --git a/test/Main.purs b/test/Main.purs index cd77693..d232d4f 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -36,16 +36,14 @@ 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 @@ -99,7 +97,8 @@ main = do log ("Completed " <> 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))