savage 1.0.0 → 1.0.1

raw patch · 20 files changed

+3649/−352 lines, 20 filesdep +ansi-terminaldep +asyncdep +bytestringdep −tf-randomdep ~basedep ~randombinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: ansi-terminal, async, bytestring, concurrent-output, containers, directory, exceptions, lifted-async, mmorph, monad-control, mtl, pretty-show, primitive, resourcet, semigroups, stm, template-haskell, text, th-lift, time, transformers, transformers-base, unix, wl-pprint-annotated

Dependencies removed: tf-random

Dependency ranges changed: base, random

API changes (from Hackage documentation)

Files

• LICENSE +1/−3
• README.md +1/−1
• dist/build/autogen/Paths_savage.hs +50/−0
• dist/build/autogen/cabal_macros.h +407/−0
• dist/package.conf.inplace/package.cache binary
• dist/setup-config binary
• release.nix +63/−0
• repl.sh +12/−0
• savage-1.0.1.tar.gz binary
• savage.cabal +86/−34
• src/Savage.hs +19/−6
• src/Savage/Gen.hs +0/−242
• src/Savage/Internal/Distributive.hs +54/−0
• src/Savage/Internal/Gen.hs +1622/−0
• src/Savage/Internal/Range.hs +462/−0
• src/Savage/Internal/Seed.hs +230/−0
• src/Savage/Internal/Shrink.hs +129/−0
• src/Savage/Internal/Tree.hs +390/−0
• src/Savage/Randy.hs +89/−66
• src/Savage/Range.hs +34/−0

@@ -1,8 +1,6 @@ (The following is the 3-clause BSD license.) -Copyright (c) 2000-2017, Koen Claessen-Copyright (c) 2006-2008, Björn Bringert-Copyright (c) 2009-2017, Nick Smallbone+Copyright (c) 2017 Daniel Cartwright  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -1,3 +1,3 @@ # `savage` -`savage` is a re-export of the random generators from QuickCheck.+`savage` is a re-export of the random generators from Hedgehog.

@@ -0,0 +1,50 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -fno-warn-implicit-prelude #-}+module Paths_savage (+    version,+    getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,+    getDataFileName, getSysconfDir+  ) where++import qualified Control.Exception as Exception+import Data.Version (Version(..))+import System.Environment (getEnv)+import Prelude++#if defined(VERSION_base)++#if MIN_VERSION_base(4,0,0)+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#else+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a+#endif++#else+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#endif+catchIO = Exception.catch++version :: Version+version = Version [1,0,1] []+bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath++bindir     = "/usr/local/bin"+libdir     = "/usr/local/lib/x86_64-linux-ghc-8.0.2/savage-1.0.1-7mk4JPYthPZDBUwhx5ufuF"+dynlibdir  = "/usr/local/lib/x86_64-linux-ghc-8.0.2"+datadir    = "/usr/local/share/x86_64-linux-ghc-8.0.2/savage-1.0.1"+libexecdir = "/usr/local/libexec/x86_64-linux-ghc-8.0.2/savage-1.0.1"+sysconfdir = "/usr/local/etc"++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath+getBinDir = catchIO (getEnv "savage_bindir") (\_ -> return bindir)+getLibDir = catchIO (getEnv "savage_libdir") (\_ -> return libdir)+getDynLibDir = catchIO (getEnv "savage_dynlibdir") (\_ -> return dynlibdir)+getDataDir = catchIO (getEnv "savage_datadir") (\_ -> return datadir)+getLibexecDir = catchIO (getEnv "savage_libexecdir") (\_ -> return libexecdir)+getSysconfDir = catchIO (getEnv "savage_sysconfdir") (\_ -> return sysconfdir)++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+  dir <- getDataDir+  return (dir ++ "/" ++ name)

@@ -0,0 +1,407 @@+/* DO NOT EDIT: This file is automatically generated by Cabal */++/* package savage-1.0.1 */+#ifndef VERSION_savage+#define VERSION_savage "1.0.1"+#endif /* VERSION_savage */+#ifndef MIN_VERSION_savage+#define MIN_VERSION_savage(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  0 || \+  (major1) == 1 && (major2) == 0 && (minor) <= 1)+#endif /* MIN_VERSION_savage */++/* package base-4.9.1.0 */+#ifndef VERSION_base+#define VERSION_base "4.9.1.0"+#endif /* VERSION_base */+#ifndef MIN_VERSION_base+#define MIN_VERSION_base(major1,major2,minor) (\+  (major1) <  4 || \+  (major1) == 4 && (major2) <  9 || \+  (major1) == 4 && (major2) == 9 && (minor) <= 1)+#endif /* MIN_VERSION_base */++/* package ansi-terminal-0.6.3.1 */+#ifndef VERSION_ansi_terminal+#define VERSION_ansi_terminal "0.6.3.1"+#endif /* VERSION_ansi_terminal */+#ifndef MIN_VERSION_ansi_terminal+#define MIN_VERSION_ansi_terminal(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  6 || \+  (major1) == 0 && (major2) == 6 && (minor) <= 3)+#endif /* MIN_VERSION_ansi_terminal */++/* package async-2.1.1.1 */+#ifndef VERSION_async+#define VERSION_async "2.1.1.1"+#endif /* VERSION_async */+#ifndef MIN_VERSION_async+#define MIN_VERSION_async(major1,major2,minor) (\+  (major1) <  2 || \+  (major1) == 2 && (major2) <  1 || \+  (major1) == 2 && (major2) == 1 && (minor) <= 1)+#endif /* MIN_VERSION_async */++/* package bytestring-0.10.8.1 */+#ifndef VERSION_bytestring+#define VERSION_bytestring "0.10.8.1"+#endif /* VERSION_bytestring */+#ifndef MIN_VERSION_bytestring+#define MIN_VERSION_bytestring(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  10 || \+  (major1) == 0 && (major2) == 10 && (minor) <= 8)+#endif /* MIN_VERSION_bytestring */++/* package concurrent-output-1.9.2 */+#ifndef VERSION_concurrent_output+#define VERSION_concurrent_output "1.9.2"+#endif /* VERSION_concurrent_output */+#ifndef MIN_VERSION_concurrent_output+#define MIN_VERSION_concurrent_output(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  9 || \+  (major1) == 1 && (major2) == 9 && (minor) <= 2)+#endif /* MIN_VERSION_concurrent_output */++/* package containers-0.5.7.1 */+#ifndef VERSION_containers+#define VERSION_containers "0.5.7.1"+#endif /* VERSION_containers */+#ifndef MIN_VERSION_containers+#define MIN_VERSION_containers(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  5 || \+  (major1) == 0 && (major2) == 5 && (minor) <= 7)+#endif /* MIN_VERSION_containers */++/* package directory-1.3.0.0 */+#ifndef VERSION_directory+#define VERSION_directory "1.3.0.0"+#endif /* VERSION_directory */+#ifndef MIN_VERSION_directory+#define MIN_VERSION_directory(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  3 || \+  (major1) == 1 && (major2) == 3 && (minor) <= 0)+#endif /* MIN_VERSION_directory */++/* package exceptions-0.8.3 */+#ifndef VERSION_exceptions+#define VERSION_exceptions "0.8.3"+#endif /* VERSION_exceptions */+#ifndef MIN_VERSION_exceptions+#define MIN_VERSION_exceptions(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  8 || \+  (major1) == 0 && (major2) == 8 && (minor) <= 3)+#endif /* MIN_VERSION_exceptions */++/* package lifted-async-0.9.3 */+#ifndef VERSION_lifted_async+#define VERSION_lifted_async "0.9.3"+#endif /* VERSION_lifted_async */+#ifndef MIN_VERSION_lifted_async+#define MIN_VERSION_lifted_async(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  9 || \+  (major1) == 0 && (major2) == 9 && (minor) <= 3)+#endif /* MIN_VERSION_lifted_async */++/* package mmorph-1.0.9 */+#ifndef VERSION_mmorph+#define VERSION_mmorph "1.0.9"+#endif /* VERSION_mmorph */+#ifndef MIN_VERSION_mmorph+#define MIN_VERSION_mmorph(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  0 || \+  (major1) == 1 && (major2) == 0 && (minor) <= 9)+#endif /* MIN_VERSION_mmorph */++/* package monad-control-1.0.2.2 */+#ifndef VERSION_monad_control+#define VERSION_monad_control "1.0.2.2"+#endif /* VERSION_monad_control */+#ifndef MIN_VERSION_monad_control+#define MIN_VERSION_monad_control(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  0 || \+  (major1) == 1 && (major2) == 0 && (minor) <= 2)+#endif /* MIN_VERSION_monad_control */++/* package mtl-2.2.1 */+#ifndef VERSION_mtl+#define VERSION_mtl "2.2.1"+#endif /* VERSION_mtl */+#ifndef MIN_VERSION_mtl+#define MIN_VERSION_mtl(major1,major2,minor) (\+  (major1) <  2 || \+  (major1) == 2 && (major2) <  2 || \+  (major1) == 2 && (major2) == 2 && (minor) <= 1)+#endif /* MIN_VERSION_mtl */++/* package pretty-show-1.6.13 */+#ifndef VERSION_pretty_show+#define VERSION_pretty_show "1.6.13"+#endif /* VERSION_pretty_show */+#ifndef MIN_VERSION_pretty_show+#define MIN_VERSION_pretty_show(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  6 || \+  (major1) == 1 && (major2) == 6 && (minor) <= 13)+#endif /* MIN_VERSION_pretty_show */++/* package primitive-0.6.2.0 */+#ifndef VERSION_primitive+#define VERSION_primitive "0.6.2.0"+#endif /* VERSION_primitive */+#ifndef MIN_VERSION_primitive+#define MIN_VERSION_primitive(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  6 || \+  (major1) == 0 && (major2) == 6 && (minor) <= 2)+#endif /* MIN_VERSION_primitive */++/* package random-1.1 */+#ifndef VERSION_random+#define VERSION_random "1.1"+#endif /* VERSION_random */+#ifndef MIN_VERSION_random+#define MIN_VERSION_random(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  1 || \+  (major1) == 1 && (major2) == 1 && (minor) <= 0)+#endif /* MIN_VERSION_random */++/* package resourcet-1.1.9 */+#ifndef VERSION_resourcet+#define VERSION_resourcet "1.1.9"+#endif /* VERSION_resourcet */+#ifndef MIN_VERSION_resourcet+#define MIN_VERSION_resourcet(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  1 || \+  (major1) == 1 && (major2) == 1 && (minor) <= 9)+#endif /* MIN_VERSION_resourcet */++/* package stm-2.4.4.1 */+#ifndef VERSION_stm+#define VERSION_stm "2.4.4.1"+#endif /* VERSION_stm */+#ifndef MIN_VERSION_stm+#define MIN_VERSION_stm(major1,major2,minor) (\+  (major1) <  2 || \+  (major1) == 2 && (major2) <  4 || \+  (major1) == 2 && (major2) == 4 && (minor) <= 4)+#endif /* MIN_VERSION_stm */++/* package template-haskell-2.11.1.0 */+#ifndef VERSION_template_haskell+#define VERSION_template_haskell "2.11.1.0"+#endif /* VERSION_template_haskell */+#ifndef MIN_VERSION_template_haskell+#define MIN_VERSION_template_haskell(major1,major2,minor) (\+  (major1) <  2 || \+  (major1) == 2 && (major2) <  11 || \+  (major1) == 2 && (major2) == 11 && (minor) <= 1)+#endif /* MIN_VERSION_template_haskell */++/* package text-1.2.2.2 */+#ifndef VERSION_text+#define VERSION_text "1.2.2.2"+#endif /* VERSION_text */+#ifndef MIN_VERSION_text+#define MIN_VERSION_text(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  2 || \+  (major1) == 1 && (major2) == 2 && (minor) <= 2)+#endif /* MIN_VERSION_text */++/* package th-lift-0.7.7 */+#ifndef VERSION_th_lift+#define VERSION_th_lift "0.7.7"+#endif /* VERSION_th_lift */+#ifndef MIN_VERSION_th_lift+#define MIN_VERSION_th_lift(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  7 || \+  (major1) == 0 && (major2) == 7 && (minor) <= 7)+#endif /* MIN_VERSION_th_lift */++/* package time-1.6.0.1 */+#ifndef VERSION_time+#define VERSION_time "1.6.0.1"+#endif /* VERSION_time */+#ifndef MIN_VERSION_time+#define MIN_VERSION_time(major1,major2,minor) (\+  (major1) <  1 || \+  (major1) == 1 && (major2) <  6 || \+  (major1) == 1 && (major2) == 6 && (minor) <= 0)+#endif /* MIN_VERSION_time */++/* package transformers-0.5.2.0 */+#ifndef VERSION_transformers+#define VERSION_transformers "0.5.2.0"+#endif /* VERSION_transformers */+#ifndef MIN_VERSION_transformers+#define MIN_VERSION_transformers(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  5 || \+  (major1) == 0 && (major2) == 5 && (minor) <= 2)+#endif /* MIN_VERSION_transformers */++/* package transformers-base-0.4.4 */+#ifndef VERSION_transformers_base+#define VERSION_transformers_base "0.4.4"+#endif /* VERSION_transformers_base */+#ifndef MIN_VERSION_transformers_base+#define MIN_VERSION_transformers_base(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  4 || \+  (major1) == 0 && (major2) == 4 && (minor) <= 4)+#endif /* MIN_VERSION_transformers_base */++/* package wl-pprint-annotated-0.1.0.0 */+#ifndef VERSION_wl_pprint_annotated+#define VERSION_wl_pprint_annotated "0.1.0.0"+#endif /* VERSION_wl_pprint_annotated */+#ifndef MIN_VERSION_wl_pprint_annotated+#define MIN_VERSION_wl_pprint_annotated(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  1 || \+  (major1) == 0 && (major2) == 1 && (minor) <= 0)+#endif /* MIN_VERSION_wl_pprint_annotated */++/* package unix-2.7.2.1 */+#ifndef VERSION_unix+#define VERSION_unix "2.7.2.1"+#endif /* VERSION_unix */+#ifndef MIN_VERSION_unix+#define MIN_VERSION_unix(major1,major2,minor) (\+  (major1) <  2 || \+  (major1) == 2 && (major2) <  7 || \+  (major1) == 2 && (major2) == 7 && (minor) <= 2)+#endif /* MIN_VERSION_unix */++/* tool gcc-6.4.0 */+#ifndef TOOL_VERSION_gcc+#define TOOL_VERSION_gcc "6.4.0"+#endif /* TOOL_VERSION_gcc */+#ifndef MIN_TOOL_VERSION_gcc+#define MIN_TOOL_VERSION_gcc(major1,major2,minor) (\+  (major1) <  6 || \+  (major1) == 6 && (major2) <  4 || \+  (major1) == 6 && (major2) == 4 && (minor) <= 0)+#endif /* MIN_TOOL_VERSION_gcc */++/* tool ghc-8.0.2 */+#ifndef TOOL_VERSION_ghc+#define TOOL_VERSION_ghc "8.0.2"+#endif /* TOOL_VERSION_ghc */+#ifndef MIN_TOOL_VERSION_ghc+#define MIN_TOOL_VERSION_ghc(major1,major2,minor) (\+  (major1) <  8 || \+  (major1) == 8 && (major2) <  0 || \+  (major1) == 8 && (major2) == 0 && (minor) <= 2)+#endif /* MIN_TOOL_VERSION_ghc */++/* tool ghc-pkg-8.0.2 */+#ifndef TOOL_VERSION_ghc_pkg+#define TOOL_VERSION_ghc_pkg "8.0.2"+#endif /* TOOL_VERSION_ghc_pkg */+#ifndef MIN_TOOL_VERSION_ghc_pkg+#define MIN_TOOL_VERSION_ghc_pkg(major1,major2,minor) (\+  (major1) <  8 || \+  (major1) == 8 && (major2) <  0 || \+  (major1) == 8 && (major2) == 0 && (minor) <= 2)+#endif /* MIN_TOOL_VERSION_ghc_pkg */++/* tool ghcjs-0.2.0 */+#ifndef TOOL_VERSION_ghcjs+#define TOOL_VERSION_ghcjs "0.2.0"+#endif /* TOOL_VERSION_ghcjs */+#ifndef MIN_TOOL_VERSION_ghcjs+#define MIN_TOOL_VERSION_ghcjs(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  2 || \+  (major1) == 0 && (major2) == 2 && (minor) <= 0)+#endif /* MIN_TOOL_VERSION_ghcjs */++/* tool ghcjs-pkg-7.10.3 */+#ifndef TOOL_VERSION_ghcjs_pkg+#define TOOL_VERSION_ghcjs_pkg "7.10.3"+#endif /* TOOL_VERSION_ghcjs_pkg */+#ifndef MIN_TOOL_VERSION_ghcjs_pkg+#define MIN_TOOL_VERSION_ghcjs_pkg(major1,major2,minor) (\+  (major1) <  7 || \+  (major1) == 7 && (major2) <  10 || \+  (major1) == 7 && (major2) == 10 && (minor) <= 3)+#endif /* MIN_TOOL_VERSION_ghcjs_pkg */++/* tool haddock-2.17.3 */+#ifndef TOOL_VERSION_haddock+#define TOOL_VERSION_haddock "2.17.3"+#endif /* TOOL_VERSION_haddock */+#ifndef MIN_TOOL_VERSION_haddock+#define MIN_TOOL_VERSION_haddock(major1,major2,minor) (\+  (major1) <  2 || \+  (major1) == 2 && (major2) <  17 || \+  (major1) == 2 && (major2) == 17 && (minor) <= 3)+#endif /* MIN_TOOL_VERSION_haddock */++/* tool hpc-0.67 */+#ifndef TOOL_VERSION_hpc+#define TOOL_VERSION_hpc "0.67"+#endif /* TOOL_VERSION_hpc */+#ifndef MIN_TOOL_VERSION_hpc+#define MIN_TOOL_VERSION_hpc(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  67 || \+  (major1) == 0 && (major2) == 67 && (minor) <= 0)+#endif /* MIN_TOOL_VERSION_hpc */++/* tool hsc2hs-0.68.1 */+#ifndef TOOL_VERSION_hsc2hs+#define TOOL_VERSION_hsc2hs "0.68.1"+#endif /* TOOL_VERSION_hsc2hs */+#ifndef MIN_TOOL_VERSION_hsc2hs+#define MIN_TOOL_VERSION_hsc2hs(major1,major2,minor) (\+  (major1) <  0 || \+  (major1) == 0 && (major2) <  68 || \+  (major1) == 0 && (major2) == 68 && (minor) <= 1)+#endif /* MIN_TOOL_VERSION_hsc2hs */++/* tool runghc-8.0.2 */+#ifndef TOOL_VERSION_runghc+#define TOOL_VERSION_runghc "8.0.2"+#endif /* TOOL_VERSION_runghc */+#ifndef MIN_TOOL_VERSION_runghc+#define MIN_TOOL_VERSION_runghc(major1,major2,minor) (\+  (major1) <  8 || \+  (major1) == 8 && (major2) <  0 || \+  (major1) == 8 && (major2) == 0 && (minor) <= 2)+#endif /* MIN_TOOL_VERSION_runghc */++/* tool strip-2.28 */+#ifndef TOOL_VERSION_strip+#define TOOL_VERSION_strip "2.28"+#endif /* TOOL_VERSION_strip */+#ifndef MIN_TOOL_VERSION_strip+#define MIN_TOOL_VERSION_strip(major1,major2,minor) (\+  (major1) <  2 || \+  (major1) == 2 && (major2) <  28 || \+  (major1) == 2 && (major2) == 28 && (minor) <= 0)+#endif /* MIN_TOOL_VERSION_strip */++#ifndef CURRENT_PACKAGE_KEY+#define CURRENT_PACKAGE_KEY "savage-1.0.1-7mk4JPYthPZDBUwhx5ufuF"+#endif /* CURRENT_PACKAGE_KEY */+#ifndef CURRENT_COMPONENT_ID+#define CURRENT_COMPONENT_ID "savage-1.0.1-7mk4JPYthPZDBUwhx5ufuF"+#endif /* CURRENT_COMPONENT_ID */+#ifndef CURRENT_PACKAGE_VERSION+#define CURRENT_PACKAGE_VERSION "1.0.1"+#endif /* CURRENT_PACKAGE_VERSION */

binary file changed (absent → 40 bytes)

binary file changed (absent → 259395 bytes)

@@ -0,0 +1,63 @@+let+  # Disable tests for these packages+  dontCheckPackages = [+  ];++  # Jailbreak these packages+  doJailbreakPackages = [+  ];++  # Disable haddocks for these packages+  dontHaddockPackages = [+  ];++  config = {+    packageOverrides = pkgs: rec {+      haskellPackages =+        let+          generatedOverrides = haskellPackagesNew: haskellPackagesOld:+            let+              toPackage = file: _: {+                name  = builtins.replaceStrings [ ".nix" ] [ "" ] file;++                value = haskellPackagesNew.callPackage (./. + "/nix/${file}") { };+              };++            in+              pkgs.lib.mapAttrs' toPackage (builtins.readDir ./nix);++          makeOverrides =+            function: names: haskellPackagesNew: haskellPackagesOld:+              let+                toPackage = name: {+                  inherit name;++                  value = function haskellPackagesOld.${name};+                };++            in+              builtins.listToAttrs (map toPackage names);++          composeExtensionsList =+            pkgs.lib.fold pkgs.lib.composeExtensions (_: _: {});++          # More exotic overrides go here+          manualOverrides = haskellPackagesNew: haskellPackagesOld: {+          };+        in+          pkgs.haskellPackages.override {+            overrides = composeExtensionsList [+              generatedOverrides+              (makeOverrides pkgs.haskell.lib.dontCheck   dontCheckPackages  )+              (makeOverrides pkgs.haskell.lib.doJailbreak doJailbreakPackages)+              (makeOverrides pkgs.haskell.lib.dontHaddock dontHaddockPackages)+              manualOverrides+            ];+          };+    };+  };++  pkgs = import <nixpkgs> { inherit config; };++in+  { savage = pkgs.haskellPackages.callCabal2nix "savage" ./. {}; }

@@ -0,0 +1,12 @@+#!/usr/bin/env bash++# dist can cause problems with nix-build (called by nix-shell)+# so delete this in between builds+rm -rf dist++#this is a workaround while cabal-repl is broken (https://github.com/haskell/cabal/issues/4602)+nix-shell -A savage.env release.nix --run "runhaskell Setup.hs configure; runhaskell Setup.hs repl lib:savage"++# dist can cause problems with nix-build (called by nix-shell)+# so delete this in between builds+rm -rf dist

binary file changed (absent → 70464 bytes)

@@ -1,40 +1,92 @@------------------------------------------------------------------------name:                      savage-version:                   1.0.0-build-type:                Simple-cabal-version:             >= 1.10-category:                  Data-author:                    Daniel Cartwright-maintainer:                dcartwright@layer3com.com-license:                   BSD3-license-file:              LICENSE-homepage:                  https://github.com/chessai/savage-bug-reports:               https://github.com/chessai/savage/issues-synopsis:                  Re-exported random generators from QuickCheck.-description:               Re-exported random generators from QuickCheck.-extra-source-files:        README.md-tested-with:               GHC == 8.2.1+version: 1.0.1 ----------------------------------------------------------------------+name:+  savage+author:+  Daniel Cartwright+maintainer:+  Daniel Cartwright <dcartwright@layer3com.com>+homepage:+  https://github.com/chessai/savage+bug-reports:+  https://github.com/chessai/savage/issues+synopsis:+  re-export of the random generators from Hedgehog+description:+  re-export of the random generators from Hedgehog:+  <https://github.com/hedgehogqa>+category:+  Testing+license:+  BSD3+license-file:+  LICENSE+cabal-version:+  >= 1.8+build-type:+  Simple+tested-with:+    GHC == 7.10.2+  , GHC == 7.10.3+  , GHC == 8.0.1+  , GHC == 8.0.2+extra-source-files:+  README.md+  CHANGELOG.md  source-repository head-    type:                git-    branch:              master-    location:            https://github.com/chessai/savage.git-----------------------------------------------------------------------+  type: git+  location: git://github.com/chessai/savage.git  library-    hs-source-dirs:        src-    build-depends:         base       >= 4.8 && < 5.0-                         , random-                         , tf-random-    exposed-modules:       Savage-                         , Savage.Gen-                         , Savage.Randy-    default-language:      Haskell2010-    other-extensions:      CPP -                        ----------------------------------------------------------------------+  build-depends:+      base                            >= 3          && < 5+    , ansi-terminal                   >= 0.6        && < 0.8+    , async                           >= 2.0        && < 2.2+    , bytestring                      >= 0.10       && < 0.11+    , concurrent-output               >= 1.7        && < 1.11+    , containers                      >= 0.4        && < 0.6+    , directory                       >= 1.2        && < 1.4+    , exceptions                      >= 0.7        && < 0.9+    , lifted-async                    >= 0.7        && < 0.10+    , mmorph                          >= 1.0        && < 1.2+    , monad-control                   >= 1.0        && < 1.1+    , mtl                             >= 2.1        && < 2.3+    , pretty-show                     >= 1.6        && < 1.7+    , primitive                       >= 0.6        && < 0.7+    , random                          >= 1.1        && < 1.2+    , resourcet                       >= 1.1        && < 1.2+    , stm                             >= 2.4        && < 2.5+    , template-haskell                >= 2.10       && < 2.13+    , text                            >= 1.1        && < 1.3+    , th-lift                         >= 0.7        && < 0.8+    , time                            >= 1.4        && < 1.9+    , transformers                    >= 0.5        && < 0.6+    , transformers-base               >= 0.4        && < 0.5+    , wl-pprint-annotated             >= 0.0        && < 0.2 +  if impl(ghc < 8.0)+    build-depends:+      semigroups                      >= 0.16       && < 0.19++  if !os(windows)+    build-depends:+      unix                            >= 2.6        && < 2.8++  ghc-options:+    -Wall++  hs-source-dirs:+    src++  exposed-modules:+    Savage+    Savage.Randy+    Savage.Range++    Savage.Internal.Distributive+    Savage.Internal.Gen+    Savage.Internal.Range+    Savage.Internal.Seed+    Savage.Internal.Shrink+    Savage.Internal.Tree

@@ -1,8 +1,21 @@-module Savage -  ( module Savage.Gen-  , module Savage.Randy-  ) where+-- This module is designed to be used alongside "Savage.Randy" and "Savage.Range",+-- which should be imported qualified.+--+-- > import           Savage+-- > import qualified Savage.Randy as Gen+-- > import qualified Savage.Range as Range -import Savage.Gen-import Savage.Randy+module Savage (+    Gen+  , GenT+  , MonadGen(..)+  , Range+  , Size(..)+  , Seed(..)+  , Distributive(..)+  ) where +import           Savage.Internal.Distributive (Distributive(..))+import           Savage.Internal.Gen (Gen, GenT, MonadGen(..))+import           Savage.Internal.Range (Range, Size(..))+import           Savage.Internal.Seed (Seed(..))

@@ -1,242 +0,0 @@-{-# LANGUAGE CPP #-}-#ifndef NO_ST_MONAD-{-# LANGUAGE Rank2Types #-}-#endif--- | Test case generation.-module Savage.Gen where------------------------------------------------------------------------------- imports--import System.Random-  ( Random-  , random-  , randomR-  , split-  )--import Control.Monad-  ( ap-  , replicateM-  , filterM-  )--import Control.Applicative-  ( Applicative(..) )--import Savage.Randy-import Data.List-import Data.Ord-import Data.Maybe------------------------------------------------------------------------------- ** Generator type---- | A generator for values of type @a@.------ The third-party package--- <http://hackage.haskell.org/package/QuickCheck-GenT QuickCheck-GenT>--- provides a monad transformer version of @GenT@.-newtype Gen a = MkGen{-  unGen :: SVGen -> Int -> a -- ^ Run the generator on a particular seed.-                             -- If you just want to get a random value out, consider using 'generate'.-  }--instance Functor Gen where-  fmap f (MkGen h) =-    MkGen (\r n -> f (h r n))--instance Applicative Gen where-  pure  = return-  (<*>) = ap--instance Monad Gen where-  return x =-    MkGen (\_ _ -> x)--  MkGen m >>= k =-    MkGen (\r n ->-      case split r of-        (r1, r2) ->-          let MkGen m' = k (m r1 n)-          in m' r2 n-    )------------------------------------------------------------------------------- ** Primitive generator combinators---- | Modifies a generator using an integer seed.-variant :: Integral n => n -> Gen a -> Gen a-variant k (MkGen g) = MkGen (\r n -> g (variantSVGen k r) n)---- | Used to construct generators that depend on the size parameter.------ For example, 'listOf', which uses the size parameter as an upper bound on--- length of lists it generates, can be defined like this:------ > listOf :: Gen a -> Gen [a]--- > listOf gen = sized $ \n ->--- >   do k <- choose (0,n)--- >      vectorOf k gen------ You can also do this using 'getSize'.-sized :: (Int -> Gen a) -> Gen a-sized f = MkGen (\r n -> let MkGen m = f n in m r n)---- | Generates the size parameter. Used to construct generators that depend on--- the size parameter.------ For example, 'listOf', which uses the size parameter as an upper bound on--- length of lists it generates, can be defined like this:------ > listOf :: Gen a -> Gen [a]--- > listOf gen = do--- >   n <- getSize--- >   k <- choose (0,n)--- >   vectorOf k gen------ You can also do this using 'sized'.-getSize :: Gen Int-getSize = sized pure---- | Overrides the size parameter. Returns a generator which uses--- the given size instead of the runtime-size parameter.-resize :: Int -> Gen a -> Gen a-resize n _ | n < 0 = error "Test.QuickCheck.resize: negative size"-resize n (MkGen g) = MkGen (\r _ -> g r n)---- | Adjust the size parameter, by transforming it with the given--- function.-scale :: (Int -> Int) -> Gen a -> Gen a-scale f g = sized (\n -> resize (f n) g)---- | Generates a random element in the given inclusive range.-choose :: Random a => (a,a) -> Gen a-choose rng = MkGen (\r _ -> let (x,_) = randomR rng r in x)---- | Generates a random element over the natural range of `a`.-chooseAny :: Random a => Gen a-chooseAny = MkGen (\r _ -> let (x,_) = random r in x)---- | Run a generator. The size passed to the generator is always 30;--- if you want another size then you should explicitly use 'resize'.-generate :: Gen a -> IO a-generate (MkGen g) =-  do r <- newSVGen-     return (g r 30)---- | Generates some example values.-sample' :: Gen a -> IO [a]-sample' g =-  generate (sequence [ resize n g | n <- [0,2..20] ])---- | Generates some example values and prints them to 'stdout'.-sample :: Show a => Gen a -> IO ()-sample g =-  do cases <- sample' g-     mapM_ print cases------------------------------------------------------------------------------- ** Common generator combinators---- | Generates a value that satisfies a predicate.-suchThat :: Gen a -> (a -> Bool) -> Gen a-gen `suchThat` p =-  do mx <- gen `suchThatMaybe` p-     case mx of-       Just x  -> return x-       Nothing -> sized (\n -> resize (n+1) (gen `suchThat` p))---- | Generates a value for which the given function returns a 'Just', and then--- applies the function.-suchThatMap :: Gen a -> (a -> Maybe b) -> Gen b-gen `suchThatMap` f =-  fmap fromJust $ fmap f gen `suchThat` isJust---- | Tries to generate a value that satisfies a predicate.--- If it fails to do so after enough attempts, returns @Nothing@.-suchThatMaybe :: Gen a -> (a -> Bool) -> Gen (Maybe a)-gen `suchThatMaybe` p = sized (try 0 . max 1)- where-  try _ 0 = return Nothing-  try k n = do x <- resize (2*k+n) gen-               if p x then return (Just x) else try (k+1) (n-1)---- | Randomly uses one of the given generators. The input list--- must be non-empty.-oneof :: [Gen a] -> Gen a-oneof [] = error "QuickCheck.oneof used with empty list"-oneof gs = choose (0,length gs - 1) >>= (gs !!)---- | Chooses one of the given generators, with a weighted random distribution.--- The input list must be non-empty.-frequency :: [(Int, Gen a)] -> Gen a-frequency [] = error "QuickCheck.frequency used with empty list"-frequency xs0 = choose (1, tot) >>= (`pick` xs0)- where-  tot = sum (map fst xs0)--  pick n ((k,x):xs)-    | n <= k    = x-    | otherwise = pick (n-k) xs-  pick _ _  = error "QuickCheck.pick used with empty list"---- | Generates one of the given values. The input list must be non-empty.-elements :: [a] -> Gen a-elements [] = error "QuickCheck.elements used with empty list"-elements xs = (xs !!) `fmap` choose (0, length xs - 1)---- | Generates a random subsequence of the given list.-sublistOf :: [a] -> Gen [a]-sublistOf xs = filterM (\_ -> choose (False, True)) xs---- | Generates a random permutation of the given list.-shuffle :: [a] -> Gen [a]-shuffle xs = do-  ns <- vectorOf (length xs) (choose (minBound :: Int, maxBound))-  return (map snd (sortBy (comparing fst) (zip ns xs)))---- | Takes a list of elements of increasing size, and chooses--- among an initial segment of the list. The size of this initial--- segment increases with the size parameter.--- The input list must be non-empty.-growingElements :: [a] -> Gen a-growingElements [] = error "QuickCheck.growingElements used with empty list"-growingElements xs = sized $ \n -> elements (take (1 `max` size n) xs)-  where-   k        = length xs-   mx       = 100-   log'     = round . log . toDouble-   size n   = (log' n + 1) * k `div` log' mx-   toDouble = fromIntegral :: Int -> Double--{- WAS:-growingElements xs = sized $ \n -> elements (take (1 `max` (n * k `div` 100)) xs)- where-  k = length xs--}---- | Generates a list of random length. The maximum length depends on the--- size parameter.-listOf :: Gen a -> Gen [a]-listOf gen = sized $ \n ->-  do k <- choose (0,n)-     vectorOf k gen---- | Generates a non-empty list of random length. The maximum length--- depends on the size parameter.-listOf1 :: Gen a -> Gen [a]-listOf1 gen = sized $ \n ->-  do k <- choose (1,1 `max` n)-     vectorOf k gen---- | Generates a list of the given length.-vectorOf :: Int -> Gen a -> Gen [a]-vectorOf = replicateM---- | Generates an infinite list.-infiniteListOf :: Gen a -> Gen [a]-infiniteListOf gen = sequence (repeat gen)------------------------------------------------------------------------------- the end.

@@ -0,0 +1,54 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeOperators #-}+module Savage.Internal.Distributive (+    Distributive(..)+  ) where++import           Control.Monad (join)+import           Control.Monad.Morph (MFunctor(..))+import           Control.Monad.Trans.Class (MonadTrans(..))+import           Control.Monad.Trans.Except (ExceptT(..), runExceptT)+import           Control.Monad.Trans.Maybe (MaybeT(..))+import           Control.Monad.Trans.Reader (ReaderT(..))+import           Control.Monad.Trans.Writer (WriterT(..))++import           GHC.Exts (Constraint)+++class Distributive g where+  type Transformer+    (f :: (* -> *) -> * -> *)+    (g :: (* -> *) -> * -> *)+    (m :: * -> *) :: Constraint++  type Transformer f g m = (+        Monad m+      , Monad (f m)+      , Monad (g m)+      , Monad (f (g m))+      , MonadTrans f+      , MFunctor f+      )++  -- | Distribute one monad transformer over another.+  --+  distribute :: Transformer f g m => g (f m) a -> f (g m) a++instance Distributive MaybeT where+  distribute x =+    lift . MaybeT . pure =<< hoist lift (runMaybeT x)++instance Distributive (ExceptT x) where+  distribute x =+    lift . ExceptT . pure =<< hoist lift (runExceptT x)++instance Monoid w => Distributive (WriterT w) where+  distribute x =+    lift . WriterT . pure =<< hoist lift (runWriterT x)++instance Distributive (ReaderT r) where+  distribute x =+    join . lift . ReaderT $ \r ->+      pure . hoist lift $ runReaderT x r

@@ -0,0 +1,1622 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} -- MonadBase+module Savage.Internal.Gen (+  -- * Transformer+    Gen+  , GenT(..)+  , MonadGen(..)++  -- * Combinators+  , lift++  -- ** Shrinking+  , shrink+  , prune++  -- ** Size+  , small+  , scale+  , resize+  , sized++  -- ** Integral+  , integral+  , integral_++  , int+  , int8+  , int16+  , int32+  , int64++  , word+  , word8+  , word16+  , word32+  , word64++  -- ** Floating-point+  , realFloat+  , realFrac_+  , float+  , double++  -- ** Enumeration+  , enum+  , enumBounded+  , bool+  , bool_++  -- ** Characters+  , binit+  , octit+  , digit+  , hexit+  , lower+  , upper+  , alpha+  , alphaNum+  , ascii+  , latin1+  , unicode+  , unicodeAll++  -- ** Strings+  , string+  , text+  , utf8+  , bytes++  -- ** Choice+  , constant+  , element+  , choice+  , frequency+  , recursive++  -- ** Conditional+  , discard+  , ensure+  , filter+  , just++  -- ** Collections+  , maybe+  , list+  , seq+  , nonEmpty+  , set+  , map++  -- ** Subterms+  , freeze+  , subterm+  , subtermM+  , subterm2+  , subtermM2+  , subterm3+  , subtermM3++  -- ** Combinations & Permutations+  , subsequence+  , shuffle++  -- * Sampling Generators+  , sample+  , print+  , printTree+  , printWith+  , printTreeWith++  -- * Internal+  -- $internal++  -- ** Transfomer+  , runGenT+  , mapGenT+  , generate+  , liftTree+  , runDiscardEffect++  -- ** Size+  , golden++  -- ** Shrinking+  , atLeast++  -- ** Characters+  , isSurrogate++  -- ** Subterms+  , Vec(..)+  , Nat(..)+  , subtermMVec++  -- ** Sampling+  , renderNodes+  ) where++import           Control.Applicative (Alternative(..))+import           Control.Monad (MonadPlus(..), filterM, replicateM, ap, join)+import           Control.Monad.Base (MonadBase(..))+import           Control.Monad.Catch (MonadThrow(..), MonadCatch(..))+import           Control.Monad.Error.Class (MonadError(..))+import           Control.Monad.IO.Class (MonadIO(..))+import           Control.Monad.Morph (MFunctor(..), MMonad(..), generalize)+import           Control.Monad.Primitive (PrimMonad(..))+import           Control.Monad.Reader.Class (MonadReader(..))+import           Control.Monad.State.Class (MonadState(..))+import           Control.Monad.Trans.Class (MonadTrans)+import qualified Control.Monad.Trans.Class as Trans+import           Control.Monad.Trans.Except (ExceptT(..), mapExceptT)+import           Control.Monad.Trans.Identity (IdentityT(..), mapIdentityT)+import           Control.Monad.Trans.Maybe (MaybeT(..), mapMaybeT)+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+import           Control.Monad.Trans.Reader (ReaderT(..), mapReaderT)+import           Control.Monad.Trans.Resource (MonadResource(..))+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict+import           Control.Monad.Writer.Class (MonadWriter(..))++import           Data.Bifunctor (first, second)+import           Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import qualified Data.Char as Char+import           Data.Foldable (for_, toList)+import           Data.Functor.Identity (Identity(..))+import           Data.Int (Int8, Int16, Int32, Int64)+import           Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NonEmpty+import           Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.Maybe as Maybe+import           Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import           Data.Set (Set)+import           Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import           Data.Word (Word8, Word16, Word32, Word64)++import           Savage.Internal.Distributive (Distributive(..))+import           Savage.Internal.Seed (Seed)+import qualified Savage.Internal.Seed as Seed+import qualified Savage.Internal.Shrink as Shrink+import           Savage.Internal.Tree (Tree(..), Node(..))+import qualified Savage.Internal.Tree as Tree+import           Savage.Range (Size, Range)+import qualified Savage.Range as Range++import           Prelude hiding (filter, print, maybe, map, seq)+++------------------------------------------------------------------------+-- Generator transformer++-- | Generator for random values of @a@.+--+type Gen =+  GenT Identity++-- | Monad transformer which can generate random values of @a@.+--+newtype GenT m a =+  GenT {+      unGen :: Size -> Seed -> Tree (MaybeT m) a+    }++-- | Runs a generator, producing its shrink tree.+--+runGenT :: Size -> Seed -> GenT m a -> Tree (MaybeT m) a+runGenT size seed (GenT m) =+  m size seed++-- | Map over a generator's shrink tree.+--+mapGenT :: (Tree (MaybeT m) a -> Tree (MaybeT n) b) -> GenT m a -> GenT n b+mapGenT f gen =+  GenT $ \size seed ->+    f (runGenT size seed gen)++-- | Lift a predefined shrink tree in to a generator, ignoring the seed and the+--   size.+--+liftTree :: Tree (MaybeT m) a -> GenT m a+liftTree x =+  GenT (\_ _ -> x)++-- | Run the discard effects through the tree and reify them as 'Maybe' values+--   at the nodes. 'Nothing' means discarded, 'Just' means we have a value.+--+runDiscardEffect :: Monad m => Tree (MaybeT m) a -> Tree m (Maybe a)+runDiscardEffect =+  runMaybeT . distribute++------------------------------------------------------------------------+-- MonadGen++-- | Class of monads which can generate input data for tests.+--+--   /The functions on this class can, and should, be used without their @Gen@/+--   /suffix by importing "Hedgehog.Gen" qualified./+--+class Monad m => MonadGen m where+  -- | See @Gen.@'Hedgehog.Gen.lift'+  --+  liftGen :: Gen a -> m a++  -- | See @Gen.@'Hedgehog.Gen.shrink'+  --+  shrinkGen :: (a -> [a]) -> m a -> m a++  -- | See @Gen.@'Hedgehog.Gen.prune'+  --+  pruneGen :: m a -> m a++  -- | See @Gen.@'Hedgehog.Gen.scale'+  --+  scaleGen :: (Size -> Size) -> m a -> m a++  -- | See @Gen.@'Hedgehog.Gen.freeze'+  --+  freezeGen :: m a -> m (a, m a)++instance Monad m => MonadGen (GenT m) where+  liftGen gen =+    hoist generalize gen++  shrinkGen =+    mapGenT . Tree.expand++  pruneGen =+    mapGenT Tree.prune++  scaleGen f gen =+    GenT $ \size0 seed ->+      let+        size =+          f size0+      in+        if size < 0 then+          error "Hedgehog.Gen.scale: negative size"+        else+          runGenT size seed gen++  freezeGen gen =+    GenT $ \size seed -> do+      mx <- Trans.lift . Trans.lift . runMaybeT . runTree $ runGenT size seed gen+      case mx of+        Nothing ->+          mzero+        Just (Node x xs) ->+          pure (x, liftTree . Tree.fromNode $ Node x xs)++instance MonadGen m => MonadGen (IdentityT m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    mapIdentityT (shrink f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen =+    mapIdentityT $+      fmap (second Trans.lift) . freeze++shrinkMaybe :: (a -> [a]) -> Maybe a -> [Maybe a]+shrinkMaybe f = \case+  Nothing ->+    pure Nothing+  Just x ->+    fmap Just (f x)++shrinkEither :: (a -> [a]) -> Either x a -> [Either x a]+shrinkEither f = \case+  Left x ->+    pure $ Left x+  Right x ->+    fmap Right (f x)++shrink2 :: (a -> [a]) -> (a, b) -> [(a, b)]+shrink2 f (x, y) =+  fmap (, y) (f x)++shrink3 :: (a -> [a]) -> (a, b, c) -> [(a, b, c)]+shrink3 f (x, y, z) =+  fmap (, y, z) (f x)++instance MonadGen m => MonadGen (MaybeT m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    mapMaybeT $+      shrink (shrinkMaybe f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen =+    mapMaybeT $ \m0 -> do+      (mx, m) <- freeze m0+      pure $ fmap (, MaybeT m) mx++instance MonadGen m => MonadGen (ExceptT x m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    mapExceptT $+      shrink (shrinkEither f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen =+    mapExceptT $ \m0 -> do+      (mx, m) <- freeze m0+      pure $ fmap (, ExceptT m) mx++instance MonadGen m => MonadGen (ReaderT r m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    mapReaderT (shrink f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen =+    mapReaderT $+      fmap (second Trans.lift) . freeze++instance MonadGen m => MonadGen (Lazy.StateT s m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    Lazy.mapStateT $+      shrink (shrink2 f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen m0 =+    Lazy.StateT $ \s0 -> do+      ((x, s), m) <- freeze (Lazy.runStateT m0 s0)+      pure ((x, Lazy.StateT (const m)), s)++instance MonadGen m => MonadGen (Strict.StateT s m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    Strict.mapStateT $+      shrink (shrink2 f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen m0 =+    Strict.StateT $ \s0 -> do+      ((x, s), m) <- freeze (Strict.runStateT m0 s0)+      pure ((x, Strict.StateT (const m)), s)++instance (MonadGen m, Monoid w) => MonadGen (Lazy.WriterT w m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    Lazy.mapWriterT $+      shrink (shrink2 f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen m0 =+    Lazy.WriterT $ do+      ((x, w), m) <- freeze (Lazy.runWriterT m0)+      pure ((x, Lazy.WriterT m), w)++instance (MonadGen m, Monoid w) => MonadGen (Strict.WriterT w m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    Strict.mapWriterT $+      shrink (shrink2 f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen m0 =+    Strict.WriterT $ do+      ((x, w), m) <- freeze (Strict.runWriterT m0)+      pure ((x, Strict.WriterT m), w)++instance (MonadGen m, Monoid w) => MonadGen (Lazy.RWST r w s m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    Lazy.mapRWST $+      shrink (shrink3 f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen m0 =+    Lazy.RWST $ \r s0 -> do+      ((x, s, w), m) <- freeze (Lazy.runRWST m0 r s0)+      pure ((x, Lazy.RWST (\_ _ -> m)), s, w)++instance (MonadGen m, Monoid w) => MonadGen (Strict.RWST r w s m) where+  liftGen =+    Trans.lift . liftGen++  shrinkGen f =+    Strict.mapRWST $+      shrink (shrink3 f)++  pruneGen =+    hoist prune++  scaleGen f =+    hoist (scale f)++  freezeGen m0 =+    Strict.RWST $ \r s0 -> do+      ((x, s, w), m) <- freeze (Strict.runRWST m0 r s0)+      pure ((x, Strict.RWST (\_ _ -> m)), s, w)++------------------------------------------------------------------------+-- GenT instances++instance Functor m => Functor (GenT m) where+  fmap f gen =+    GenT $ \seed size ->+      fmap f (runGenT seed size gen)++instance Monad m => Applicative (GenT m) where+  pure =+    return+  (<*>) =+    ap++instance Monad m => Monad (GenT m) where+  return =+    liftTree . pure++  (>>=) m k =+    GenT $ \size seed ->+      case Seed.split seed of+        (sk, sm) ->+          runGenT size sk . k =<<+          runGenT size sm m++instance Monad m => Alternative (GenT m) where+  empty =+    mzero+  (<|>) =+    mplus++instance Monad m => MonadPlus (GenT m) where+  mzero =+    liftTree mzero++  mplus x y =+    GenT $ \size seed ->+      case Seed.split seed of+        (sx, sy) ->+          runGenT size sx x `mplus`+          runGenT size sy y++instance MonadTrans GenT where+  lift =+    liftTree . Trans.lift . Trans.lift++instance MFunctor GenT where+  hoist f =+    mapGenT (hoist (hoist f))++embedMaybe ::+     MonadTrans t+  => Monad n+  => Monad (t (MaybeT n))+  => (forall a. m a -> t (MaybeT n) a)+  -> MaybeT m b+  -> t (MaybeT n) b+embedMaybe f m =+  Trans.lift . MaybeT . pure =<< f (runMaybeT m)++embedTree :: Monad n => (forall a. m a -> Tree (MaybeT n) a) -> Tree (MaybeT m) b -> Tree (MaybeT n) b+embedTree f tree =+  embed (embedMaybe f) tree++embedGen :: Monad n => (forall a. m a -> GenT n a) -> GenT m b -> GenT n b+embedGen f gen =+  GenT $ \size seed ->+    case Seed.split seed of+      (sf, sg) ->+        (runGenT size sf . f) `embedTree`+        (runGenT size sg gen)++instance MMonad GenT where+  embed =+    embedGen++distributeGen :: Transformer t GenT m => GenT (t m) a -> t (GenT m) a+distributeGen x =+  join . Trans.lift . GenT $ \size seed ->+    pure . hoist liftTree . distribute . hoist distribute $ runGenT size seed x++instance Distributive GenT where+  type Transformer t GenT m = (+      Monad (t (GenT m))+    , Transformer t MaybeT m+    , Transformer t Tree (MaybeT m)+    )++  distribute =+    distributeGen++instance PrimMonad m => PrimMonad (GenT m) where+  type PrimState (GenT m) =+    PrimState m+  primitive =+    Trans.lift . primitive++instance MonadIO m => MonadIO (GenT m) where+  liftIO =+    Trans.lift . liftIO++instance MonadBase b m => MonadBase b (GenT m) where+  liftBase =+    Trans.lift . liftBase++instance MonadThrow m => MonadThrow (GenT m) where+  throwM =+    Trans.lift . throwM++instance MonadCatch m => MonadCatch (GenT m) where+  catch m onErr =+    GenT $ \size seed ->+      case Seed.split seed of+        (sm, se) ->+          (runGenT size sm m) `catch`+          (runGenT size se . onErr)++instance MonadReader r m => MonadReader r (GenT m) where+  ask =+    Trans.lift ask+  local f m =+    mapGenT (local f) m++instance MonadState s m => MonadState s (GenT m) where+  get =+    Trans.lift get+  put =+    Trans.lift . put+  state =+    Trans.lift . state++instance MonadWriter w m => MonadWriter w (GenT m) where+  writer =+    Trans.lift . writer+  tell =+    Trans.lift . tell+  listen =+    mapGenT listen+  pass =+    mapGenT pass++instance MonadError e m => MonadError e (GenT m) where+  throwError =+    Trans.lift . throwError+  catchError m onErr =+    GenT $ \size seed ->+      case Seed.split seed of+        (sm, se) ->+          (runGenT size sm m) `catchError`+          (runGenT size se . onErr)++instance MonadResource m => MonadResource (GenT m) where+  liftResourceT =+    Trans.lift . liftResourceT++------------------------------------------------------------------------+-- Combinators++-- | Lift a vanilla 'Gen' in to a 'MonadGen'.+--+lift :: MonadGen m => Gen a -> m a+lift =+  liftGen++-- | Generate a value with no shrinks from a 'Size' and a 'Seed'.+--+generate :: MonadGen m => (Size -> Seed -> a) -> m a+generate f =+  liftGen . GenT $ \size seed ->+    pure (f size seed)++------------------------------------------------------------------------+-- Combinators - Shrinking++-- | Apply a shrinking function to a generator.+--+--   This will give the generator additional shrinking options, while keeping+--   the existing shrinks intact.+--+shrink :: MonadGen m => (a -> [a]) -> m a -> m a+shrink =+  shrinkGen++-- | Throw away a generator's shrink tree.+--+prune :: MonadGen m => m a -> m a+prune =+  pruneGen++------------------------------------------------------------------------+-- Combinators - Size++-- | Construct a generator that depends on the size parameter.+--+sized :: MonadGen m => (Size -> m a) -> m a+sized f = do+  f =<< generate (\size _ -> size)++-- | Override the size parameter. Returns a generator which uses the given size+--   instead of the runtime-size parameter.+--+resize :: MonadGen m => Size -> m a -> m a+resize size gen =+  scale (const size) gen++-- | Adjust the size parameter by transforming it with the given function.+--+scale :: MonadGen m => (Size -> Size) -> m a -> m a+scale =+  scaleGen++-- | Make a generator smaller by scaling its size parameter.+--+small :: MonadGen m => m a -> m a+small =+  scale golden++-- | Scale a size using the golden ratio.+--+--   > golden x = x / φ+--   > golden x = x / 1.61803..+--+golden :: Size -> Size+golden x =+  round (fromIntegral x * 0.61803398875 :: Double)++------------------------------------------------------------------------+-- Combinators - Integral++-- | Generates a random integral number in the given @[inclusive,inclusive]@ range.+--+--   When the generator tries to shrink, it will shrink towards the+--   'Range.origin' of the specified 'Range'.+--+--   For example, the following generator will produce a number between @1970@+--   and @2100@, but will shrink towards @2000@:+--+-- @+-- integral (Range.'Range.constantFrom' 2000 1970 2100) :: 'Gen' 'Int'+-- @+--+--   Some sample outputs from this generator might look like:+--+--   > === Outcome ===+--   > 1973+--   > === Shrinks ===+--   > 2000+--   > 1987+--   > 1980+--   > 1976+--   > 1974+--+--   > === Outcome ===+--   > 2061+--   > === Shrinks ===+--   > 2000+--   > 2031+--   > 2046+--   > 2054+--   > 2058+--   > 2060+--+integral :: (MonadGen m, Integral a) => Range a -> m a+integral range =+  shrink (Shrink.towards $ Range.origin range) (integral_ range)++-- | Generates a random integral number in the [inclusive,inclusive] range.+--+--   /This generator does not shrink./+--+integral_ :: (MonadGen m, Integral a) => Range a -> m a+integral_ range =+  generate $ \size seed ->+    let+      (x, y) =+        Range.bounds size range+    in+      fromInteger . fst $+        Seed.nextInteger (toInteger x) (toInteger y) seed++-- | Generates a random machine integer in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+int :: MonadGen m => Range Int -> m Int+int =+  integral++-- | Generates a random 8-bit integer in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+int8 :: MonadGen m => Range Int8 -> m Int8+int8 =+  integral++-- | Generates a random 16-bit integer in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+int16 :: MonadGen m => Range Int16 -> m Int16+int16 =+  integral++-- | Generates a random 32-bit integer in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+int32 :: MonadGen m => Range Int32 -> m Int32+int32 =+  integral++-- | Generates a random 64-bit integer in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+int64 :: MonadGen m => Range Int64 -> m Int64+int64 =+  integral++-- | Generates a random machine word in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+word :: MonadGen m => Range Word -> m Word+word =+  integral++-- | Generates a random byte in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+word8 :: MonadGen m => Range Word8 -> m Word8+word8 =+  integral++-- | Generates a random 16-bit word in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+word16 :: MonadGen m => Range Word16 -> m Word16+word16 =+  integral++-- | Generates a random 32-bit word in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+word32 :: MonadGen m => Range Word32 -> m Word32+word32 =+  integral++-- | Generates a random 64-bit word in the given @[inclusive,inclusive]@ range.+--+--   /This is a specialization of 'integral', offered for convenience./+--+word64 :: MonadGen m => Range Word64 -> m Word64+word64 =+  integral++------------------------------------------------------------------------+-- Combinators - Fractional / Floating-Point++-- | Generates a random floating-point number in the @[inclusive,exclusive)@ range.+--+--   This generator works the same as 'integral', but for floating point numbers.+--+realFloat :: (MonadGen m, RealFloat a) => Range a -> m a+realFloat range =+  shrink (Shrink.towardsFloat $ Range.origin range) (realFrac_ range)++-- | Generates a random fractional number in the [inclusive,exclusive) range.+--+--   /This generator does not shrink./+--+realFrac_ :: (MonadGen m, RealFrac a) => Range a -> m a+realFrac_ range =+  generate $ \size seed ->+    let+      (x, y) =+        Range.bounds size range+    in+      realToFrac . fst $+        Seed.nextDouble (realToFrac x) (realToFrac y) seed++-- | Generates a random floating-point number in the @[inclusive,exclusive)@ range.+--+--   /This is a specialization of 'realFloat', offered for convenience./+--+float :: MonadGen m => Range Float -> m Float+float =+ realFloat++-- | Generates a random floating-point number in the @[inclusive,exclusive)@ range.+--+--   /This is a specialization of 'realFloat', offered for convenience./+--+double :: MonadGen m => Range Double -> m Double+double =+ realFloat++------------------------------------------------------------------------+-- Combinators - Enumeration++-- | Generates an element from an enumeration.+--+--   This generator shrinks towards the first argument.+--+--   For example:+--+-- @+-- enum \'a' \'z' :: 'Gen' 'Char'+-- @+--+enum :: (MonadGen m, Enum a) => a -> a -> m a+enum lo hi =+  fmap toEnum . integral $+    Range.constant (fromEnum lo) (fromEnum hi)++-- | Generates a random value from a bounded enumeration.+--+--   This generator shrinks towards 'minBound'.+--+--   For example:+--+-- @+-- enumBounded :: 'Gen' 'Bool'+-- @+--+enumBounded :: (MonadGen m, Enum a, Bounded a) => m a+enumBounded =+  enum minBound maxBound++-- | Generates a random boolean.+--+--   This generator shrinks to 'False'.+--+--   /This is a specialization of 'enumBounded', offered for convenience./+--+bool :: MonadGen m => m Bool+bool =+  enumBounded++-- | Generates a random boolean.+--+--   /This generator does not shrink./+--+bool_ :: MonadGen m => m Bool+bool_ =+  generate $ \_ seed ->+    (/= 0) . fst $ Seed.nextInteger 0 1 seed++------------------------------------------------------------------------+-- Combinators - Characters++-- | Generates an ASCII binit: @'0'..'1'@+--+binit :: MonadGen m => m Char+binit =+  enum '0' '1'++-- | Generates an ASCII octit: @'0'..'7'@+--+octit :: MonadGen m => m Char+octit =+  enum '0' '7'++-- | Generates an ASCII digit: @'0'..'9'@+--+digit :: MonadGen m => m Char+digit =+  enum '0' '9'++-- | Generates an ASCII hexit: @'0'..'9', \'a\'..\'f\', \'A\'..\'F\'@+--+hexit :: MonadGen m => m Char+hexit =+  -- FIXME optimize lookup, use a SmallArray or something.+  element "0123456789aAbBcCdDeEfF"++-- | Generates an ASCII lowercase letter: @\'a\'..\'z\'@+--+lower :: MonadGen m => m Char+lower =+  enum 'a' 'z'++-- | Generates an ASCII uppercase letter: @\'A\'..\'Z\'@+--+upper :: MonadGen m => m Char+upper =+  enum 'A' 'Z'++-- | Generates an ASCII letter: @\'a\'..\'z\', \'A\'..\'Z\'@+--+alpha :: MonadGen m => m Char+alpha =+  -- FIXME optimize lookup, use a SmallArray or something.+  element "abcdefghiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"++-- | Generates an ASCII letter or digit: @\'a\'..\'z\', \'A\'..\'Z\', \'0\'..\'9\'@+--+alphaNum :: MonadGen m => m Char+alphaNum =+  -- FIXME optimize lookup, use a SmallArray or something.+  element "abcdefghiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"++-- | Generates an ASCII character: @'\0'..'\127'@+--+ascii :: MonadGen m => m Char+ascii =+  enum '\0' '\127'++-- | Generates a Latin-1 character: @'\0'..'\255'@+--+latin1 :: MonadGen m => m Char+latin1 =+  enum '\0' '\255'++-- | Generates a Unicode character, excluding invalid standalone surrogates:+--   @'\0'..'\1114111' (excluding '\55296'..'\57343')@+--+unicode :: MonadGen m => m Char+unicode =+  filter (not . isSurrogate) unicodeAll++-- | Generates a Unicode character, including invalid standalone surrogates:+--   @'\0'..'\1114111'@+--+unicodeAll :: MonadGen m => m Char+unicodeAll =+  enumBounded++-- | Check if a character is in the surrogate category.+--+isSurrogate :: Char -> Bool+isSurrogate x =+  x >= '\55296' && x <= '\57343'++------------------------------------------------------------------------+-- Combinators - Strings++-- | Generates a string using 'Range' to determine the length.+--+--   /This is a specialization of 'list', offered for convenience./+--+string :: MonadGen m => Range Int -> m Char -> m String+string =+  list++-- | Generates a string using 'Range' to determine the length.+--+text :: MonadGen m => Range Int -> m Char -> m Text+text range =+  fmap Text.pack . string range++-- | Generates a UTF-8 encoded string, using 'Range' to determine the length.+--+utf8 :: MonadGen m => Range Int -> m Char -> m ByteString+utf8 range =+  fmap Text.encodeUtf8 . text range++-- | Generates a random 'ByteString', using 'Range' to determine the+--   length.+--+bytes :: MonadGen m => Range Int -> m ByteString+bytes range =+  fmap ByteString.pack $+  choice [+      list range . word8 $+        Range.constant+          (fromIntegral $ Char.ord 'a')+          (fromIntegral $ Char.ord 'z')++    , list range . word8 $+        Range.constant minBound maxBound+    ]++------------------------------------------------------------------------+-- Combinators - Choice++-- | Trivial generator that always produces the same element.+--+--   /This is another name for 'pure' \/ 'return'./+constant :: MonadGen m => a -> m a+constant =+  pure++-- | Randomly selects one of the elements in the list.+--+--   This generator shrinks towards the first element in the list.+--+--   /The input list must be non-empty./+--+element :: MonadGen m => [a] -> m a+element = \case+  [] ->+    error "Hedgehog.Gen.element: used with empty list"+  xs -> do+    n <- integral $ Range.constant 0 (length xs - 1)+    pure $ xs !! n++-- | Randomly selects one of the generators in the list.+--+--   This generator shrinks towards the first generator in the list.+--+--   /The input list must be non-empty./+--+choice :: MonadGen m => [m a] -> m a+choice = \case+  [] ->+    error "Hedgehog.Gen.choice: used with empty list"+  xs -> do+    n <- integral $ Range.constant 0 (length xs - 1)+    xs !! n++-- | Uses a weighted distribution to randomly select one of the generators in+--   the list.+--+--   This generator shrinks towards the first generator in the list.+--+--   /The input list must be non-empty./+--+frequency :: MonadGen m => [(Int, m a)] -> m a+frequency = \case+  [] ->+    error "Hedgehog.Gen.frequency: used with empty list"+  xs0 -> do+    let+      pick n = \case+        [] ->+          error "Hedgehog.Gen.frequency/pick: used with empty list"+        (k, x) : xs ->+          if n <= k then+            x+          else+            pick (n - k) xs++      total =+        sum (fmap fst xs0)++    n <- integral $ Range.constant 1 total+    pick n xs0++-- | Modifies combinators which choose from a list of generators, like 'choice'+--   or 'frequency', so that they can be used in recursive scenarios.+--+--   This combinator modifies its target to select one of the generators in+--   either the non-recursive or the recursive list. When a selection is made+--   from the recursive list, the 'Size' is halved. When the 'Size' gets to one+--   or less, selections are no longer made from the recursive list, this+--   ensures termination.+--+--   A good example of where this might be useful is abstract syntax trees:+--+-- @+-- data Expr =+--     Var String+--   | Lam String Expr+--   | App Expr Expr+--+-- -- Assuming we have a name generator+-- genName :: 'MonadGen' m => m String+--+-- -- We can write a generator for expressions+-- genExpr :: 'MonadGen' m => m Expr+-- genExpr =+--   Gen.'recursive' Gen.'choice' [+--       -- non-recursive generators+--       Var '<$>' genName+--     ] [+--       -- recursive generators+--       Gen.'subtermM' genExpr (\x -> Lam '<$>' genName '<*>' pure x)+--     , Gen.'subterm2' genExpr genExpr App+--     ]+-- @+--+--   If we wrote the above example using only 'choice', it is likely that it+--   would fail to terminate. This is because for every call to @genExpr@,+--   there is a 2 in 3 chance that we will recurse again.+--+recursive :: MonadGen m => ([m a] -> m a) -> [m a] -> [m a] -> m a+recursive f nonrec rec =+  sized $ \n ->+    if n <= 1 then+      f nonrec+    else+      f $ nonrec ++ fmap small rec++------------------------------------------------------------------------+-- Combinators - Conditional++-- | Discards the whole generator.+--+discard :: MonadGen m => m a+discard =+  liftGen mzero++-- | Discards the generator if the generated value does not satisfy the+--   predicate.+--+ensure :: MonadGen m => (a -> Bool) -> m a -> m a+ensure p gen = do+  x <- gen+  if p x then+    pure x+  else+    discard++-- | Generates a value that satisfies a predicate.+--+--   This is essentially:+--+-- @+-- filter p gen = 'mfilter' p gen '<|>' filter p gen+-- @+--+--   It differs from the above in that we keep some state to avoid looping+--   forever. If we trigger these limits then the whole generator is discarded.+--+filter :: MonadGen m => (a -> Bool) -> m a -> m a+filter p gen =+  let+    try k =+      if k > 100 then+        discard+      else do+        x <- scale (2 * k +) gen+        if p x then+          pure x+        else+          try (k + 1)+  in+    try 0++-- | Runs a 'Maybe' generator until it produces a 'Just'.+--+--   This is implemented using 'filter' and has the same caveats.+--+just :: MonadGen m => m (Maybe a) -> m a+just g = do+  mx <- filter Maybe.isJust g+  case mx of+    Just x ->+      pure x+    Nothing ->+      error "Hedgehog.Gen.just: internal error, unexpected Nothing"++------------------------------------------------------------------------+-- Combinators - Collections++-- | Generates a 'Nothing' some of the time.+--+maybe :: MonadGen m => m a -> m (Maybe a)+maybe gen =+  sized $ \n ->+    frequency [+        (2, pure Nothing)+      , (1 + fromIntegral n, Just <$> gen)+      ]++-- | Generates a list using a 'Range' to determine the length.+--+list :: MonadGen m => Range Int -> m a -> m [a]+list range gen =+  sized $ \size ->+    (traverse snd =<<) .+    ensure (atLeast $ Range.lowerBound size range) .+    shrink Shrink.list $ do+      k <- integral_ range+      replicateM k (freeze gen)++-- | Generates a seq using a 'Range' to determine the length.+--+seq :: MonadGen m => Range Int -> m a -> m (Seq a)+seq range gen =+  Seq.fromList <$> list range gen++-- | Generates a non-empty list using a 'Range' to determine the length.+--+nonEmpty :: MonadGen m => Range Int -> m a -> m (NonEmpty a)+nonEmpty range gen = do+  xs <- list (fmap (max 1) range) gen+  case xs of+    [] ->+      error "Hedgehog.Gen.nonEmpty: internal error, generated empty list"+    _ ->+      pure $ NonEmpty.fromList xs++-- | Generates a set using a 'Range' to determine the length.+--+--   /This may fail to generate anything if the element generator/+--   /cannot produce a large enough number of unique items to satify/+--   /the required set size./+--+set :: (MonadGen m, Ord a) => Range Int -> m a -> m (Set a)+set range gen =+  fmap Map.keysSet . map range $ fmap (, ()) gen++-- | Generates a map using a 'Range' to determine the length.+--+--   /This may fail to generate anything if the keys produced by the/+--   /generator do not account for a large enough number of unique/+--   /items to satify the required map size./+--+map :: (MonadGen m, Ord k) => Range Int -> m (k, v) -> m (Map k v)+map range gen =+  sized $ \size ->+    ensure ((>= Range.lowerBound size range) . Map.size) .+    fmap Map.fromList .+    (sequence =<<) .+    shrink Shrink.list $ do+      k <- integral_ range+      uniqueByKey k gen++-- | Generate exactly 'n' unique generators.+--+uniqueByKey :: (MonadGen m, Ord k) => Int -> m (k, v) -> m [m (k, v)]+uniqueByKey n gen =+  let+    try k xs0 =+      if k > 100 then+        discard+      else+        replicateM n (freeze gen) >>= \kvs ->+        case uniqueInsert n xs0 (fmap (first fst) kvs) of+          Left xs ->+            pure $ Map.elems xs+          Right xs ->+            try (k + 1) xs+  in+    try (0 :: Int) Map.empty++uniqueInsert :: Ord k => Int -> Map k v -> [(k, v)] -> Either (Map k v) (Map k v)+uniqueInsert n xs kvs0 =+  if Map.size xs >= n then+    Left xs+  else+    case kvs0 of+      [] ->+        Right xs+      (k, v) : kvs ->+        uniqueInsert n (Map.insertWith (\x _ -> x) k v xs) kvs++-- | Check that list contains at least a certain number of elements.+--+atLeast :: Int -> [a] -> Bool+atLeast n =+  if n == 0 then+    const True+  else+    not . null . drop (n - 1)++------------------------------------------------------------------------+-- Combinators - Subterms++data Subterms n a =+    One a+  | All (Vec n a)+    deriving (Functor, Foldable, Traversable)++data Nat =+    Z+  | S Nat++data Vec n a where+  Nil :: Vec 'Z a+  (:.) :: a -> Vec n a -> Vec ('S n) a++infixr 5 :.++deriving instance Functor (Vec n)+deriving instance Foldable (Vec n)+deriving instance Traversable (Vec n)++-- | Freeze the size and seed used by a generator, so we can inspect the value+--   which it will produce.+--+--   This is used for implementing `list` and `subtermMVec`. It allows us to+--   shrink the list itself before trying to shrink the values inside the list.+--+freeze :: MonadGen m => m a -> m (a, m a)+freeze =+  freezeGen++shrinkSubterms :: Subterms n a -> [Subterms n a]+shrinkSubterms = \case+  One _ ->+    []+  All xs ->+    fmap One $ toList xs++genSubterms :: MonadGen m => Vec n (m a) -> m (Subterms n a)+genSubterms =+  (sequence =<<) .+  shrink shrinkSubterms .+  fmap All .+  mapM (fmap snd . freeze)++fromSubterms :: Applicative m => (Vec n a -> m a) -> Subterms n a -> m a+fromSubterms f = \case+  One x ->+    pure x+  All xs ->+    f xs++-- | Constructs a generator from a number of sub-term generators.+--+--   /Shrinks to one of the sub-terms if possible./+--+subtermMVec :: MonadGen m => Vec n (m a) -> (Vec n a -> m a) -> m a+subtermMVec gs f =+  fromSubterms f =<< genSubterms gs++-- | Constructs a generator from a sub-term generator.+--+--   /Shrinks to the sub-term if possible./+--+subtermM :: MonadGen m => m a -> (a -> m a) -> m a+subtermM gx f =+  subtermMVec (gx :. Nil) $ \(x :. Nil) ->+    f x++-- | Constructs a generator from a sub-term generator.+--+--   /Shrinks to the sub-term if possible./+--+subterm :: MonadGen m => m a -> (a -> a) -> m a+subterm gx f =+  subtermM gx $ \x ->+    pure (f x)++-- | Constructs a generator from two sub-term generators.+--+--   /Shrinks to one of the sub-terms if possible./+--+subtermM2 :: MonadGen m => m a -> m a -> (a -> a -> m a) -> m a+subtermM2 gx gy f =+  subtermMVec (gx :. gy :. Nil) $ \(x :. y :. Nil) ->+    f x y++-- | Constructs a generator from two sub-term generators.+--+--   /Shrinks to one of the sub-terms if possible./+--+subterm2 :: MonadGen m => m a -> m a -> (a -> a -> a) -> m a+subterm2 gx gy f =+  subtermM2 gx gy $ \x y ->+    pure (f x y)++-- | Constructs a generator from three sub-term generators.+--+--   /Shrinks to one of the sub-terms if possible./+--+subtermM3 :: MonadGen m => m a -> m a -> m a -> (a -> a -> a -> m a) -> m a+subtermM3 gx gy gz f =+  subtermMVec (gx :. gy :. gz :. Nil) $ \(x :. y :. z :. Nil) ->+    f x y z++-- | Constructs a generator from three sub-term generators.+--+--   /Shrinks to one of the sub-terms if possible./+--+subterm3 :: MonadGen m => m a -> m a -> m a -> (a -> a -> a -> a) -> m a+subterm3 gx gy gz f =+  subtermM3 gx gy gz $ \x y z ->+    pure (f x y z)++------------------------------------------------------------------------+-- Combinators - Combinations & Permutations++-- | Generates a random subsequence of a list.+--+subsequence :: MonadGen m => [a] -> m [a]+subsequence xs =+  shrink Shrink.list $ filterM (const bool_) xs++-- | Generates a random permutation of a list.+--+--   This shrinks towards the order of the list being identical to the input+--   list.+--+shuffle :: MonadGen m => [a] -> m [a]+shuffle = \case+  [] ->+    pure []+  xs0 -> do+    n <- integral $ Range.constant 0 (length xs0 - 1)+    case splitAt n xs0 of+      (xs, y : ys) ->+        (y :) <$> shuffle (xs ++ ys)+      (_, []) ->+        error "Hedgehog.Gen.shuffle: internal error, split generated empty list"++------------------------------------------------------------------------+-- Sampling++-- | Generate a sample from a generator.+--+sample :: MonadIO m => Gen a -> m a+sample gen =+  liftIO $+    let+      loop n =+        if n <= 0 then+          error "Hedgehog.Gen.sample: too many discards, could not generate a sample"+        else do+          seed <- Seed.random+          case runIdentity . runMaybeT . runTree $ runGenT 30 seed gen of+            Nothing ->+              loop (n - 1)+            Just x ->+              pure $ nodeValue x+    in+      loop (100 :: Int)++-- | Print the value produced by a generator, and the first level of shrinks,+--   for the given size and seed.+--+--   Use 'print' to generate a value from a random seed.+--+printWith :: (MonadIO m, Show a) => Size -> Seed -> Gen a -> m ()+printWith size seed gen =+  liftIO $ do+    let+      Node x ss =+        runIdentity . runTree $ renderNodes size seed gen++    putStrLn "=== Outcome ==="+    putStrLn x+    putStrLn "=== Shrinks ==="++    for_ ss $ \s ->+      let+        Node y _ =+          runIdentity $ runTree s+      in+        putStrLn y++-- | Print the shrink tree produced by a generator, for the given size and+--   seed.+--+--   Use 'printTree' to generate a value from a random seed.+--+printTreeWith :: (MonadIO m, Show a) => Size -> Seed -> Gen a -> m ()+printTreeWith size seed gen = do+  liftIO . putStr . runIdentity . Tree.render $ renderNodes size seed gen++-- | Run a generator with a random seed and print the outcome, and the first+--   level of shrinks.+--+-- @+-- Gen.print (Gen.'enum' \'a\' \'f\')+-- @+--+--   > === Outcome ===+--   > 'd'+--   > === Shrinks ===+--   > 'a'+--   > 'b'+--   > 'c'+--+print :: (MonadIO m, Show a) => Gen a -> m ()+print gen = do+  seed <- liftIO Seed.random+  printWith 30 seed gen++-- | Run a generator with a random seed and print the resulting shrink tree.+--+-- @+-- Gen.printTree (Gen.'enum' \'a\' \'f\')+-- @+--+--   > 'd'+--   >  ├╼'a'+--   >  ├╼'b'+--   >  │  └╼'a'+--   >  └╼'c'+--   >     ├╼'a'+--   >     └╼'b'+--   >        └╼'a'+--+--   /This may not terminate when the tree is very large./+--+printTree :: (MonadIO m, Show a) => Gen a -> m ()+printTree gen = do+  seed <- liftIO Seed.random+  printTreeWith 30 seed gen++-- | Render a generator as a tree of strings.+--+renderNodes :: (Monad m, Show a) => Size -> Seed -> Gen a -> Tree m String+renderNodes size seed =+  fmap (Maybe.maybe "<discard>" show) . runDiscardEffect . runGenT size seed . lift++------------------------------------------------------------------------+-- Internal++-- $internal+--+-- These functions are exported in case you need them in a pinch, but are not+-- part of the public API and may change at any time, even as part of a minor+-- update.

@@ -0,0 +1,462 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Savage.Internal.Range (+  -- * Size+    Size(..)++  -- * Range+  , Range(..)+  , origin+  , bounds+  , lowerBound+  , upperBound++  -- * Constant+  , singleton+  , constant+  , constantFrom+  , constantBounded++  -- * Linear+  , linear+  , linearFrom+  , linearFrac+  , linearFracFrom+  , linearBounded++  -- * Exponential+  , exponential+  , exponentialFrom+  , exponentialBounded+  , exponentialFloat+  , exponentialFloatFrom++  -- * Internal+  -- $internal+  , clamp+  , scaleLinear+  , scaleLinearFrac+  , scaleExponential+  , scaleExponentialFloat+  ) where++import           Data.Bifunctor (bimap)++import           Prelude hiding (minimum, maximum)++-- $setup+-- >>> import Data.Int (Int8)+-- >>> let x = 3++-- | Tests are parameterized by the size of the randomly-generated data, the+--   meaning of which depends on the particular generator used.+--+newtype Size =+  Size {+      unSize :: Int+    } deriving (Eq, Ord, Num, Real, Enum, Integral)++instance Show Size where+  showsPrec p (Size x) =+    showParen (p > 10) $+      showString "Size " .+      showsPrec 11 x++instance Read Size where+  readsPrec p =+    readParen (p > 10) $ \r0 -> do+      ("Size", r1) <- lex r0+      (s, r2) <- readsPrec 11 r1+      pure (Size s, r2)++-- | A range describes the bounds of a number to generate, which may or may not+--   be dependent on a 'Size'.+--+data Range a =+  Range !a (Size -> (a, a))++instance Functor Range where+  fmap f (Range z g) =+    Range (f z) $ \sz ->+      bimap f f (g sz)++-- | Get the origin of a range. This might be the mid-point or the lower bound,+--   depending on what the range represents.+--+--   The 'bounds' of a range are scaled around this value when using the+--   'linear' family of combinators.+--+--   When using a 'Range' to generate numbers, the shrinking function will+--   shrink towards the origin.+--+origin :: Range a -> a+origin (Range z _) =+  z++-- | Get the extents of a range, for a given size.+--+bounds :: Size -> Range a -> (a, a)+bounds sz (Range _ f) =+  f sz++-- | Get the lower bound of a range for the given size.+--+lowerBound :: Ord a => Size -> Range a -> a+lowerBound sz range =+  let+    (x, y) =+      bounds sz range+  in+    min x y++-- | Get the upper bound of a range for the given size.+--+upperBound :: Ord a => Size -> Range a -> a+upperBound sz range =+  let+    (x, y) =+      bounds sz range+  in+    max x y++-- | Construct a range which represents a constant single value.+--+--   >>> bounds x $ singleton 5+--   (5,5)+--+--   >>> origin $ singleton 5+--   5+--+singleton :: a -> Range a+singleton x =+  Range x $ \_ -> (x, x)++-- | Construct a range which is unaffected by the size parameter.+--+--   A range from @0@ to @10@, with the origin at @0@:+--+--   >>> bounds x $ constant 0 10+--   (0,10)+--+--   >>> origin $ constant 0 10+--   0+--+constant :: a -> a -> Range a+constant x y =+  constantFrom x x y++-- | Construct a range which is unaffected by the size parameter with a origin+--   point which may differ from the bounds.+--+--   A range from @-10@ to @10@, with the origin at @0@:+--+--   >>> bounds x $ constantFrom 0 (-10) 10+--   (-10,10)+--+--   >>> origin $ constantFrom 0 (-10) 10+--   0+--+--   A range from @1970@ to @2100@, with the origin at @2000@:+--+--   >>> bounds x $ constantFrom 2000 1970 2100+--   (1970,2100)+--+--   >>> origin $ constantFrom 2000 1970 2100+--   2000+--+constantFrom :: a -> a -> a -> Range a+constantFrom z x y =+  Range z $ \_ -> (x, y)++-- | Construct a range which is unaffected by the size parameter using the full+--   range of a data type.+--+--   A range from @-128@ to @127@, with the origin at @0@:+--+--   >>> bounds x (constantBounded :: Range Int8)+--   (-128,127)+--+--   >>> origin (constantBounded :: Range Int8)+--   0+--+constantBounded :: (Bounded a, Num a) => Range a+constantBounded =+  constantFrom 0 minBound maxBound++-- | Construct a range which scales the second bound relative to the size+--   parameter.+--+--   >>> bounds 0 $ linear 0 10+--   (0,0)+--+--   >>> bounds 50 $ linear 0 10+--   (0,5)+--+--   >>> bounds 99 $ linear 0 10+--   (0,10)+--+linear :: Integral a => a -> a -> Range a+linear x y =+  linearFrom x x y++-- | Construct a range which scales the bounds relative to the size parameter.+--+--   >>> bounds 0 $ linearFrom 0 (-10) 10+--   (0,0)+--+--   >>> bounds 50 $ linearFrom 0 (-10) 20+--   (-5,10)+--+--   >>> bounds 99 $ linearFrom 0 (-10) 20+--   (-10,20)+--+linearFrom :: Integral a => a -> a -> a -> Range a+linearFrom z x y =+  Range z $ \sz ->+    let+      x_sized =+        clamp x y $ scaleLinear sz z x++      y_sized =+        clamp x y $ scaleLinear sz z y+    in+      (x_sized, y_sized)++-- | Construct a range which is scaled relative to the size parameter and uses+--   the full range of a data type.+--+--   >>> bounds 0 (linearBounded :: Range Int8)+--   (0,0)+--+--   >>> bounds 50 (linearBounded :: Range Int8)+--   (-64,64)+--+--   >>> bounds 99 (linearBounded :: Range Int8)+--   (-128,127)+--+linearBounded :: (Bounded a, Integral a) => Range a+linearBounded =+  linearFrom 0 minBound maxBound++-- | Construct a range which scales the second bound relative to the size+--   parameter.+--+--   This works the same as 'linear', but for fractional values.+--+linearFrac :: (Fractional a, Ord a) => a -> a -> Range a+linearFrac x y =+  linearFracFrom x x y++-- | Construct a range which scales the bounds relative to the size parameter.+--+--   This works the same as 'linearFrom', but for fractional values.+--+linearFracFrom :: (Fractional a, Ord a) => a -> a -> a -> Range a+linearFracFrom z x y =+  Range z $ \sz ->+    let+      x_sized =+        clamp x y $ scaleLinearFrac sz z x++      y_sized =+        clamp x y $ scaleLinearFrac sz z y+    in+      (x_sized, y_sized)++-- | Truncate a value so it stays within some range.+--+--   >>> clamp 5 10 15+--   10+--+--   >>> clamp 5 10 0+--   5+--+clamp :: Ord a => a -> a -> a -> a+clamp x y n =+  if x > y then+    min x (max y n)+  else+    min y (max x n)++-- | Scale an integral linearly with the size parameter.+--+scaleLinear :: Integral a => Size -> a -> a -> a+scaleLinear sz0 z0 n0 =+  let+    sz =+      max 0 (min 99 sz0)++    z =+      toInteger z0++    n =+      toInteger n0++    diff =+      ((n - z) * fromIntegral sz) `quot` 99+  in+    fromInteger $ z + diff++-- | Scale a fractional number linearly with the size parameter.+--+scaleLinearFrac :: Fractional a => Size -> a -> a -> a+scaleLinearFrac sz0 z n =+  let+    sz =+      max 0 (min 99 sz0)++    diff =+      (n - z) * (fromIntegral sz / 99)+  in+    z + diff++-- | Construct a range which scales the second bound exponentially relative to+--   the size parameter.+--+--   >>> bounds 0 $ exponential 1 512+--   (1,1)+--+--   >>> bounds 11 $ exponential 1 512+--   (1,2)+--+--   >>> bounds 22 $ exponential 1 512+--   (1,4)+--+--   >>> bounds 77 $ exponential 1 512+--   (1,128)+--+--   >>> bounds 88 $ exponential 1 512+--   (1,256)+--+--   >>> bounds 99 $ exponential 1 512+--   (1,512)+--+exponential :: Integral a => a -> a -> Range a+exponential x y =+  exponentialFrom x x y++-- | Construct a range which scales the bounds exponentially relative to the+-- size parameter.+--+--   >>> bounds 0 $ exponentialFrom 0 (-128) 512+--   (0,0)+--+--   >>> bounds 25 $ exponentialFrom 0 (-128) 512+--   (-2,4)+--+--   >>> bounds 50 $ exponentialFrom 0 (-128) 512+--   (-11,22)+--+--   >>> bounds 75 $ exponentialFrom 0 (-128) 512+--   (-39,112)+--+--   >>> bounds 99 $ exponentialFrom x (-128) 512+--   (-128,512)+--+exponentialFrom :: Integral a => a -> a -> a -> Range a+exponentialFrom z x y =+  Range z $ \sz ->+    let+      sized_x =+        clamp x y $ scaleExponential sz z x++      sized_y =+        clamp x y $ scaleExponential sz z y+    in+      (sized_x, sized_y)++-- | Construct a range which is scaled exponentially relative to the size+--   parameter and uses the full range of a data type.+--+--   >>> bounds 0 (exponentialBounded :: Range Int8)+--   (0,0)+--+--   >>> bounds 50 (exponentialBounded :: Range Int8)+--   (-11,11)+--+--   >>> bounds 99 (exponentialBounded :: Range Int8)+--   (-128,127)+--+exponentialBounded :: (Bounded a, Integral a) => Range a+exponentialBounded =+  exponentialFrom 0 minBound maxBound++-- | Construct a range which scales the second bound exponentially relative to+--   the size parameter.+--+--   This works the same as 'exponential', but for floating-point values.+--+--   >>> bounds 0 $ exponentialFloat 0 10+--   (0.0,0.0)+--+--   >>> bounds 50 $ exponentialFloat 0 10+--   (0.0,2.357035250656098)+--+--   >>> bounds 99 $ exponentialFloat 0 10+--   (0.0,10.0)+--+exponentialFloat :: (Floating a, Ord a) => a -> a -> Range a+exponentialFloat x y =+  exponentialFloatFrom x x y++-- | Construct a range which scales the bounds exponentially relative to the+--   size parameter.+--+--   This works the same as 'exponentialFrom', but for floating-point values.+--+--   >>> bounds 0 $ exponentialFloatFrom 0 (-10) 20+--   (0.0,0.0)+--+--   >>> bounds 50 $ exponentialFloatFrom 0 (-10) 20+--   (-2.357035250656098,3.6535836249197002)+--+--   >>> bounds 99 $ exponentialFloatFrom x (-10) 20+--   (-10.0,20.0)+--+exponentialFloatFrom :: (Floating a, Ord a) => a -> a -> a -> Range a+exponentialFloatFrom z x y =+  Range z $ \sz ->+    let+      sized_x =+        clamp x y $ scaleExponentialFloat sz z x++      sized_y =+        clamp x y $ scaleExponentialFloat sz z y+    in+      (sized_x, sized_y)++-- | Scale an integral exponentially with the size parameter.+--+scaleExponential :: Integral a => Size -> a -> a -> a+scaleExponential sz z0 n0 =+  let+    z =+      fromIntegral z0++    n =+      fromIntegral n0+  in+    round (scaleExponentialFloat sz z n :: Double)++-- | Scale a floating-point number exponentially with the size parameter.+--+scaleExponentialFloat :: Floating a => Size -> a -> a -> a+scaleExponentialFloat sz0 z n =+  let+    sz =+      clamp 0 99 sz0++    diff =+      (((abs (n - z) + 1) ** (realToFrac sz / 99)) - 1) * signum (n - z)+  in+    z + diff+++------------------------------------------------------------------------+-- Internal++-- $internal+--+-- These functions are exported in case you need them in a pinch, but are not+-- part of the public API and may change at any time, even as part of a minor+-- update.

@@ -0,0 +1,230 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE CPP #-}+-- |+-- This is a port of "Fast Splittable Pseudorandom Number Generators" by Steele+-- et. al. [1].+--+-- The paper's algorithm provides decent randomness for most purposes but+-- sacrifices cryptographic-quality randomness in favor of speed.  The original+-- implementation is tested with DieHarder and BigCrush; see the paper for+-- details.+--+-- This implementation, originally from [2], is a port from the paper.+--+-- It also takes in to account the SplittableRandom.java source code in OpenJDK+-- v8u40-b25 as well as splittable_random.ml in Jane Street's standard library+-- overlay (kernel) v113.33.03, and Random.fs in FsCheck v3.+--+-- Other than the choice of initial seed for 'from' this port should be+-- faithful. Currently, we have not rerun the DieHarder, or BigCrush tests on+-- this implementation.+--+-- 1. Guy L. Steele, Jr., Doug Lea, Christine H. Flood+--    Fast splittable pseudorandom number generators+--    Comm ACM, 49(10), Oct 2014, pp453-472.+--+-- 2. Nikos Baxevanis+--    https://github.com/moodmosaic/SplitMix/blob/master/SplitMix.hs+--+module Savage.Internal.Seed (+    Seed(..)+  , random+  , from+  , split+  , nextInteger+  , nextDouble++  -- * Internal+  -- $internal+  , goldenGamma+  , nextInt64+  , nextInt32+  , mix64+  , mix64variant13+  , mix32+  , mixGamma+  ) where++import           Control.Monad.IO.Class (MonadIO(..))++import           Data.Bifunctor (first)+import           Data.Bits ((.|.), xor, shiftR, popCount)+import           Data.Int (Int32, Int64)+import           Data.Time.Clock.POSIX (getPOSIXTime)+import           Data.IORef (IORef)+import qualified Data.IORef as IORef++import           System.IO.Unsafe (unsafePerformIO)+import           System.Random (RandomGen)+import qualified System.Random as Random++-- | A splittable random number generator.+--+data Seed =+  Seed {+      seedValue :: !Int64+    , seedGamma :: !Int64 -- ^ must be an odd number+    } deriving (Eq, Ord)++instance Show Seed where+  showsPrec p (Seed v g) =+    showParen (p > 10) $+      showString "Seed " .+      showsPrec 11 v .+      showChar ' ' .+      showsPrec 11 g++instance Read Seed where+  readsPrec p =+    readParen (p > 10) $ \r0 -> do+      ("Seed", r1) <- lex r0+      (v, r2) <- readsPrec 11 r1+      (g, r3) <- readsPrec 11 r2+      pure (Seed v g, r3)++global :: IORef Seed+global =+  unsafePerformIO $ do+    -- FIXME use /dev/urandom on posix+    seconds <- getPOSIXTime+    IORef.newIORef $ from (round (seconds * 1000))+{-# NOINLINE global #-}++-- | Create a random 'Seed' using an effectful source of randomness.+--+random :: MonadIO m => m Seed+random =+  liftIO $ IORef.atomicModifyIORef' global split++-- | Create a 'Seed' using an 'Int64'.+--+from :: Int64 -> Seed+from x =+  Seed x goldenGamma++-- | A predefined gamma value's needed for initializing the "root" instances of+--   'Seed'. That is, instances not produced by splitting an already existing+--   instance.+--+--   We choose: the odd integer closest to @2^64/φ@, where @φ = (1 + √5)/2@ is+--   the golden ratio.+--+goldenGamma :: Int64+goldenGamma =+  -7046029254386353131++-- | Get the next value in the SplitMix sequence.+--+next :: Seed -> (Int64, Seed)+next (Seed v0 g) =+  let+    v = v0 + g+  in+    (v, Seed v g)++-- | Splits a random number generator in to two.+--+split :: Seed -> (Seed, Seed)+split s0 =+  let+    (v0, s1) = next s0+    (g0, s2) = next s1+  in+    (s2, Seed (mix64 v0) (mixGamma g0))++-- | Generate a random 'Int64'.+--+nextInt64 :: Seed -> (Int64, Seed)+nextInt64 s0 =+  let+    (v0, s1) = next s0+  in+    (mix64 v0, s1)++-- | Generate a random 'Int32'.+--+nextInt32 :: Seed -> (Int32, Seed)+nextInt32 s0 =+  let+    (v0, s1) = next s0+  in+    (mix32 v0, s1)++-- | Generate a random 'Integer' in the [inclusive,inclusive] range.+--+nextInteger :: Integer -> Integer -> Seed -> (Integer, Seed)+nextInteger lo hi =+  Random.randomR (lo, hi)++-- | Generate a random 'Double' in the [inclusive,exclusive) range.+--+nextDouble :: Double -> Double -> Seed -> (Double, Seed)+nextDouble lo hi =+  Random.randomR (lo, hi)++mix64 :: Int64 -> Int64+mix64 x =+  let+    y = (x `xor` (x `shiftR` 33)) * (-49064778989728563)+    z = (y `xor` (y `shiftR` 33)) * (-4265267296055464877)+  in+    z `xor` (z `shiftR` 33)++mix32 :: Int64 -> Int32+mix32 x =+  let+    y = (x `xor` (x `shiftR` 33)) * (-49064778989728563)+    z = (y `xor` (y `shiftR` 33)) * (-4265267296055464877)+  in+    fromIntegral (z `shiftR` 32)++mix64variant13 :: Int64 -> Int64+mix64variant13 x =+  let+    y = (x `xor` (x `shiftR` 30)) * (-4658895280553007687)+    z = (y `xor` (y `shiftR` 27)) * (-7723592293110705685)+  in+    z `xor` (z `shiftR` 31)++mixGamma :: Int64 -> Int64+mixGamma x =+  let+    y = mix64variant13 x .|. 1+    n = popCount $ y `xor` (y `shiftR` 1)+  in+    if n < 24 then+      y `xor` (-6148914691236517206)+    else+      y++------------------------------------------------------------------------+-- RandomGen instances++#include "MachDeps.h"++#if (SIZEOF_HSINT == 8)+instance RandomGen Seed where+  next =+    first fromIntegral . nextInt64+  genRange _ =+    (fromIntegral (minBound :: Int64), fromIntegral (maxBound :: Int64))+  split =+    split+#else+instance RandomGen Seed where+  next =+    first fromIntegral . nextInt32+  genRange _ =+    (fromIntegral (minBound :: Int32), fromIntegral (maxBound :: Int32))+  split =+    split+#endif++------------------------------------------------------------------------+-- Internal++-- $internal+--+-- These functions are exported in case you need them in a pinch, but are not+-- part of the public API and may change at any time, even as part of a minor+-- update.

@@ -0,0 +1,129 @@+{-# OPTIONS_HADDOCK not-home #-}+module Savage.Internal.Shrink (+    towards+  , towardsFloat+  , list++  , halves+  , removes+  , consNub+  ) where+++-- | Shrink an integral number by edging towards a destination.+--+--   >>> towards 0 100+--   [0,50,75,88,94,97,99]+--+--   >>> towards 500 1000+--   [500,750,875,938,969,985,993,997,999]+--+--   >>> towards (-50) (-26)+--   [-50,-38,-32,-29,-27]+--+--   /Note we always try the destination first, as that is the optimal shrink./+--+towards :: Integral a => a -> a -> [a]+towards destination x =+  if destination == x then+    []+  else+    let+      -- Halve the operands before subtracting them so they don't overflow.+      -- Consider 'minBound' and 'maxBound' for a fixed sized type like 'Int64'.+      diff =+        (x `quot` 2) - (destination `quot` 2)+    in+      destination `consNub` fmap (x -) (halves diff)++-- | Shrink a floating-point number by edging towards a destination.+--+--   >>> take 7 (towardsFloat 0.0 100)+--   [0.0,50.0,75.0,87.5,93.75,96.875,98.4375]+--+--   >>> take 7 (towardsFloat 1.0 0.5)+--   [1.0,0.75,0.625,0.5625,0.53125,0.515625,0.5078125]+--+--   /Note we always try the destination first, as that is the optimal shrink./+--+towardsFloat :: RealFloat a => a -> a -> [a]+towardsFloat destination x =+  if destination == x then+    []+  else+    let+      diff =+        x - destination++      ok y =+        y /= x && not (isNaN y) && not (isInfinite y)+    in+      takeWhile ok .+      fmap (x -) $+      iterate (/ 2) diff++-- | Shrink a list by edging towards the empty list.+--+--   >>> list [1,2,3]+--   [[],[2,3],[1,3],[1,2]]+--+--   >>> list "abcd"+--   ["","cd","ab","bcd","acd","abd","abc"]+--+--   /Note we always try the empty list first, as that is the optimal shrink./+--+list :: [a] -> [[a]]+list xs =+ concatMap+   (\k -> removes k xs)+   (halves $ length xs)++-- | Produce all permutations of removing 'k' elements from a list.+--+--   >>> removes 2 "abcdef"+--   ["cdef","abef","abcd"]+--+removes :: Int -> [a] -> [[a]]+removes k0 xs0 =+  let+    loop k n xs =+      let+        (hd, tl) =+          splitAt k xs+      in+        if k > n then+          []+        else if null tl then+          [[]]+        else+          tl : fmap (hd ++) (loop k (n - k) tl)+  in+    loop k0 (length xs0) xs0++-- | Produce a list containing the progressive halving of an integral.+--+--   >>> halves 15+--   [15,7,3,1]+--+--   >>> halves 100+--   [100,50,25,12,6,3,1]+--+--   >>> halves (-26)+--   [-26,-13,-6,-3,-1]+--+halves :: Integral a => a -> [a]+halves =+  takeWhile (/= 0) . iterate (`quot` 2)++-- | Cons an element on to the front of a list unless it is already there.+--+consNub :: Eq a => a -> [a] -> [a]+consNub x ys0 =+  case ys0 of+    [] ->+      x : []+    y : ys ->+      if x == y then+        y : ys+      else+        x : y : ys

@@ -0,0 +1,390 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} -- MonadBase+module Savage.Internal.Tree (+    Tree(..)+  , Node(..)++  , fromNode++  , unfold+  , unfoldForest++  , expand+  , prune++  , render+  ) where++import           Control.Applicative (Alternative(..))+import           Control.Monad (MonadPlus(..), ap, join)+import           Control.Monad.Base (MonadBase(..))+import           Control.Monad.Catch (MonadThrow(..), MonadCatch(..), Exception)+import           Control.Monad.Error.Class (MonadError(..))+import           Control.Monad.IO.Class (MonadIO(..))+import           Control.Monad.Morph (MFunctor(..), MMonad(..))+import           Control.Monad.Primitive (PrimMonad(..))+import           Control.Monad.Reader.Class (MonadReader(..))+import           Control.Monad.State.Class (MonadState(..))+import           Control.Monad.Trans.Class (MonadTrans(..))+import           Control.Monad.Trans.Resource (MonadResource(..))+import           Control.Monad.Writer.Class (MonadWriter(..))++#if MIN_VERSION_base(4,9,0)+import           Data.Functor.Classes (Show1(..), showsPrec1)+import           Data.Functor.Classes (showsUnaryWith, showsBinaryWith)+#endif++import           Savage.Internal.Distributive++------------------------------------------------------------------------++-- | An effectful tree, each node in the tree can have an effect before it is+--   produced.+--+newtype Tree m a =+  Tree {+      runTree :: m (Node m a)+    }++-- | A node in an effectful tree, as well as its unevaluated children.+--+data Node m a =+  Node {+      nodeValue :: a+    , nodeChildren :: [Tree m a]+    }++-- | Create a 'Tree' from a 'Node'+--+fromNode :: Applicative m => Node m a -> Tree m a+fromNode =+  Tree . pure++-- | Create a tree from a value and an unfolding function.+--+unfold :: Monad m => (a -> [a]) -> a -> Tree m a+unfold f x =+  Tree . pure $+    Node x (unfoldForest f x)++-- | Create a forest from a value and an unfolding function.+--+unfoldForest :: Monad m => (a -> [a]) -> a -> [Tree m a]+unfoldForest f =+  fmap (unfold f) . f++-- | Expand a tree using an unfolding function.+--+expand :: Monad m => (a -> [a]) -> Tree m a -> Tree m a+expand f m =+  Tree $ do+    Node x xs <- runTree m+    pure . Node x $+      fmap (expand f) xs ++ unfoldForest f x++-- | Throw away a tree's children.+--+prune :: Monad m => Tree m a -> Tree m a+prune m =+  Tree $ do+    Node x _ <- runTree m+    pure $ Node x []++------------------------------------------------------------------------+-- Node/Tree instances++instance Functor m => Functor (Node m) where+  fmap f (Node x xs) =+    Node (f x) (fmap (fmap f) xs)++instance Functor m => Functor (Tree m) where+  fmap f =+    Tree . fmap (fmap f) . runTree++instance Monad m => Applicative (Node m) where+  pure =+    return+  (<*>) =+    ap++instance Monad m => Applicative (Tree m) where+  pure =+    return+  (<*>) =+    ap++instance Monad m => Monad (Node m) where+  return x =+    Node x []++  (>>=) (Node x xs) k =+    case k x of+      Node y ys ->+        Node y $+          fmap (Tree . fmap (>>= k) . runTree) xs ++ ys++instance Monad m => Monad (Tree m) where+  return x =+    Tree . pure $ Node x []++  (>>=) m k =+    Tree $ do+      Node x xs <- runTree m+      Node y ys <- runTree (k x)+      pure . Node y $+        fmap (>>= k) xs ++ ys++instance MonadPlus m => Alternative (Tree m) where+  empty =+    mzero+  (<|>) =+    mplus++instance MonadPlus m => MonadPlus (Tree m) where+  mzero =+    Tree mzero+  mplus x y =+    Tree (runTree x `mplus` runTree y)++instance MonadTrans Tree where+  lift m =+    Tree $ do+      x <- m+      pure (Node x [])++instance MFunctor Node where+  hoist f (Node x xs) =+    Node x (fmap (hoist f) xs)++instance MFunctor Tree where+  hoist f (Tree m) =+    Tree . f $ fmap (hoist f) m++embedNode :: Monad m => (t (Node t b) -> Tree m (Node t b)) -> Node t b -> Node m b+embedNode f (Node x xs) =+  Node x (fmap (embedTree f) xs)++embedTree :: Monad m => (t (Node t b) -> Tree m (Node t b)) -> Tree t b -> Tree m b+embedTree f (Tree m) =+  Tree . pure . embedNode f =<< f m++instance MMonad Tree where+  embed f m =+    embedTree f m++distributeNode :: Transformer t Tree m => Node (t m) a -> t (Tree m) a+distributeNode (Node x xs) =+  join . lift . fromNode . Node (pure x) $+    fmap (pure . distributeTree) xs++distributeTree :: Transformer t Tree m => Tree (t m) a -> t (Tree m) a+distributeTree x =+  distributeNode =<< hoist lift (runTree x)++instance Distributive Tree where+  distribute =+    distributeTree++instance PrimMonad m => PrimMonad (Tree m) where+  type PrimState (Tree m) =+    PrimState m+  primitive =+    lift . primitive++instance MonadIO m => MonadIO (Tree m) where+  liftIO =+    lift . liftIO++instance MonadBase b m => MonadBase b (Tree m) where+  liftBase =+    lift . liftBase++instance MonadThrow m => MonadThrow (Tree m) where+  throwM =+    lift . throwM++handleNode :: (Exception e, MonadCatch m) => (e -> Tree m a) -> Node m a -> Node m a+handleNode onErr (Node x xs) =+  Node x $+    fmap (handleTree onErr) xs++handleTree :: (Exception e, MonadCatch m) => (e -> Tree m a) -> Tree m a -> Tree m a+handleTree onErr m =+  Tree . fmap (handleNode onErr) $+    catch (runTree m) (runTree . onErr)++instance MonadCatch m => MonadCatch (Tree m) where+  catch =+    flip handleTree++localNode :: MonadReader r m => (r -> r) -> Node m a -> Node m a+localNode f (Node x xs) =+  Node x $+    fmap (localTree f) xs++localTree :: MonadReader r m => (r -> r) -> Tree m a -> Tree m a+localTree f (Tree m) =+  Tree $+    pure . localNode f =<< local f m++instance MonadReader r m => MonadReader r (Tree m) where+  ask =+    lift ask+  local =+    localTree++instance MonadState s m => MonadState s (Tree m) where+  get =+    lift get+  put =+    lift . put+  state =+    lift . state++listenNode :: MonadWriter w m => w -> Node m a -> Node m (a, w)+listenNode w (Node x xs) =+  Node (x, w) $+    fmap (listenTree w) xs++listenTree :: MonadWriter w m => w -> Tree m a -> Tree m (a, w)+listenTree w0 (Tree m) =+  Tree $ do+    (x, w) <- listen m+    pure $ listenNode (mappend w0 w) x++-- FIXME This just throws away the writer modification function.+passNode :: MonadWriter w m => Node m (a, w -> w) -> Node m a+passNode (Node (x, _) xs) =+  Node x $+    fmap passTree xs++passTree :: MonadWriter w m => Tree m (a, w -> w) -> Tree m a+passTree (Tree m) =+  Tree $+    pure . passNode =<< m++instance MonadWriter w m => MonadWriter w (Tree m) where+  writer =+    lift . writer+  tell =+    lift . tell+  listen =+    listenTree mempty+  pass =+    passTree++handleErrorNode :: MonadError e m => (e -> Tree m a) -> Node m a -> Node m a+handleErrorNode onErr (Node x xs) =+  Node x $+    fmap (handleErrorTree onErr) xs++handleErrorTree :: MonadError e m => (e -> Tree m a) -> Tree m a -> Tree m a+handleErrorTree onErr m =+  Tree . fmap (handleErrorNode onErr) $+    catchError (runTree m) (runTree . onErr)++instance MonadError e m => MonadError e (Tree m) where+  throwError =+    lift . throwError+  catchError =+    flip handleErrorTree++instance MonadResource m => MonadResource (Tree m) where+  liftResourceT =+    lift . liftResourceT++------------------------------------------------------------------------+-- Show/Show1 instances++#if MIN_VERSION_base(4,9,0)+instance (Show1 m, Show a) => Show (Node m a) where+  showsPrec =+    showsPrec1++instance (Show1 m, Show a) => Show (Tree m a) where+  showsPrec =+    showsPrec1++instance Show1 m => Show1 (Node m) where+  liftShowsPrec sp sl d (Node x xs) =+    let+      sp1 =+        liftShowsPrec sp sl++      sl1 =+        liftShowList sp sl++      sp2 =+        liftShowsPrec sp1 sl1+    in+      showsBinaryWith sp sp2 "Node" d x xs++instance Show1 m => Show1 (Tree m) where+  liftShowsPrec sp sl d (Tree m) =+    let+      sp1 =+        liftShowsPrec sp sl++      sl1 =+        liftShowList sp sl++      sp2 =+        liftShowsPrec sp1 sl1+    in+      showsUnaryWith sp2 "Tree" d m+#endif++------------------------------------------------------------------------+-- Pretty Printing++--+-- Rendering implementation based on the one from containers/Data.Tree+--++renderTreeLines :: Monad m => Tree m String -> m [String]+renderTreeLines (Tree m) = do+  Node x xs0 <- m+  xs <- renderForestLines xs0+  pure $+    lines (renderNode x) ++ xs++renderNode :: String -> String+renderNode xs =+  case xs of+    [_] ->+      ' ' : xs+    _ ->+      xs++renderForestLines :: Monad m => [Tree m String] -> m [String]+renderForestLines xs0 =+  let+    shift hd other =+      zipWith (++) (hd : repeat other)+  in+    case xs0 of+      [] ->+        pure []++      [x] -> do+        s <- renderTreeLines x+        pure $+          shift " └╼" "   " s++      x : xs -> do+        s <- renderTreeLines x+        ss <- renderForestLines xs+        pure $+          shift " ├╼" " │ " s ++ ss++-- | Render a tree of strings, note that this forces all the delayed effects in+--   the tree.+render :: Monad m => Tree m String -> m String+render =+  fmap unlines . renderTreeLines

@@ -1,83 +1,106 @@-{-# LANGUAGE CPP #-}--module Savage.Randy where--import System.Random-import System.Random.TF-import System.Random.TF.Gen (splitn)-import Data.Word-import Data.Bits+module Savage.Randy (+  -- * Combinators+    lift -#define TheGen TFGen+  -- ** Shrinking+  , shrink+  , prune -newTheGen :: IO TFGen-newTheGen = newTFGen+  -- ** Size+  , small+  , scale+  , resize+  , sized -bits, mask, doneBit :: Integral a => a-bits = 14-mask = 0x3fff-doneBit = 0x4000+  -- ** Integral+  , integral+  , integral_ -chip :: Bool -> Word32 -> TFGen -> TFGen-chip done n g = splitn g (bits+1) (if done then m .|. doneBit else m)-  where-    m = n .&. mask+  , int+  , int8+  , int16+  , int32+  , int64 -chop :: Integer -> Integer-chop n = n `shiftR` bits+  , word+  , word8+  , word16+  , word32+  , word64 -stop :: Integral a => a -> Bool-stop n = n <= mask+  -- ** Floating-point+  , realFloat+  , realFrac_+  , float+  , double -mkTheGen :: Int -> TFGen-mkTheGen = mkTFGen+  -- ** Enumeration+  , enum+  , enumBounded+  , bool+  , bool_ --- | The "standard" QuickCheck random number generator.--- A wrapper around either 'TFGen' on GHC, or 'StdGen'--- on other Haskell systems.-newtype SVGen = SVGen TheGen+  -- ** Characters+  , binit+  , octit+  , digit+  , hexit+  , lower+  , upper+  , alpha+  , alphaNum+  , ascii+  , latin1+  , unicode+  , unicodeAll -instance Show SVGen where-  showsPrec n (SVGen g) s = showsPrec n g "" ++ s-instance Read SVGen where-  readsPrec n xs = [(SVGen g, ys) | (g, ys) <- readsPrec n xs]+  -- ** Strings+  , string+  , text+  , utf8+  , bytes -instance RandomGen SVGen where-  split (SVGen g) =-    case split g of-      (g1, g2) -> (SVGen g1, SVGen g2)-  genRange (SVGen g) = genRange g-  next (SVGen g) =-    case next g of-      (x, g') -> (x, SVGen g')+  -- ** Choice+  , constant+  , element+  , choice+  , frequency+  , recursive -newSVGen :: IO SVGen-newSVGen = fmap SVGen newTheGen+  -- ** Conditional+  , discard+  , filter+  , just -mkSVGen :: Int -> SVGen-mkSVGen n = SVGen (mkTheGen n)+  -- ** Collections+  , maybe+  , list+  , seq+  , nonEmpty+  , set+  , map -bigNatVariant :: Integer -> TheGen -> TheGen-bigNatVariant n g-  | g `seq` stop n = chip True (fromInteger n) g-  | otherwise      = (bigNatVariant $! chop n) $! chip False (fromInteger n) g+  -- ** Subterms+  , freeze+  , subterm+  , subtermM+  , subterm2+  , subtermM2+  , subterm3+  , subtermM3 -{-# INLINE natVariant #-}-natVariant :: Integral a => a -> TheGen -> TheGen-natVariant n g-  | g `seq` stop n = chip True (fromIntegral n) g-  | otherwise      = bigNatVariant (toInteger n) g+  -- ** Combinations & Permutations+  , subsequence+  , shuffle -{-# INLINE variantTheGen #-}-variantTheGen :: Integral a => a -> TheGen -> TheGen-variantTheGen n g-  | n >= 1    = natVariant (n-1) (boolVariant False g)-  | n == 0   = natVariant (0 `asTypeOf` n) (boolVariant True g)-  | otherwise = bigNatVariant (negate (toInteger n)) (boolVariant True g)+  -- * Sampling Generators+  , sample+  , print+  , printTree+  , printWith+  , printTreeWith+  ) where -boolVariant :: Bool -> TheGen -> TheGen-boolVariant False = fst . split-boolVariant True = snd . split+import           Savage.Internal.Gen -variantSVGen :: Integral a => a -> SVGen -> SVGen-variantSVGen n (SVGen g) = SVGen (variantTheGen n g)+import           Prelude hiding (filter, print, maybe, map, seq)

@@ -0,0 +1,34 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Savage.Range (+  -- * Size+    Size(..)++  -- * Range+  , Range+  , origin+  , bounds+  , lowerBound+  , upperBound++  -- * Constant+  , singleton+  , constant+  , constantFrom+  , constantBounded++  -- * Linear+  , linear+  , linearFrom+  , linearFrac+  , linearFracFrom+  , linearBounded++  -- * Exponential+  , exponential+  , exponentialFrom+  , exponentialBounded+  , exponentialFloat+  , exponentialFloatFrom+  ) where++import           Savage.Internal.Range