-- |
-- Module      : Test.LeanCheck.Tiers
-- Copyright   : (c) 2015-2020 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- LeanCheck is a simple enumerative property-based testing library.
--
-- This module provides advanced functions for manipulating 'tiers'.
-- Most definitions given here are exported by "Test.LeanCheck", except:
--   'listCons',
--   'choices',
--   'setChoices' and
--   'bagChoices'.
module Test.LeanCheck.Tiers
  (
  -- * Additional tiers constructors
    listCons
  , setCons
  , bagCons
  , mapCons
  , noDupListCons

  , maybeCons0
  , maybeCons1
  , maybeCons2

  -- * Products of tiers
  , product3
  , product3With
  , productMaybeWith

  -- * Tiers of lists
  , listsOf
  , bagsOf
  , setsOf
  , noDupListsOf
  , products
  , maps
  , listsOfLength

  -- * Tiers of pairs
  , distinctPairs
  , distinctPairsWith
  , unorderedPairs
  , unorderedPairsWith
  , unorderedDistinctPairs
  , unorderedDistinctPairsWith

  , deleteT
  , normalizeT
  , catMaybesT
  , mapMaybeT
  , discardT
  , discardLaterT
  , nubT

  -- * Tiers of choices
  , choices
  , setChoices
  , bagChoices

  -- * Showing and printing lists-of-tiers
  -- | Lists-of-tiers are already show instances as their type is just @[[a]]@.
  --   The following functions are alternatives to 'print' and 'show' with one
  --   element per line and can be useful for debugging.
  , printTiers
  , showTiers

  , finite
  )
where

import Test.LeanCheck.Basic
import Data.Maybe (catMaybes)

-- | Given a constructor that takes a list,
--   return tiers of applications of this constructor.
--
-- This is basically a type-restricted version of 'cons1'.
-- You should use 'cons1' instead: this serves more as an illustration of how
-- 'setCons' and 'bagCons' work (see source).
listCons :: Listable a => ([a] -> b) -> [[b]]
listCons :: forall a b. Listable a => ([a] -> b) -> [[b]]
listCons  =  (forall a b. (a -> b) -> [[a]] -> [[b]]
`mapT` forall a. [[a]] -> [[[a]]]
listsOf forall a. Listable a => [[a]]
tiers)

-- | Given a constructor that takes a bag of elements (as a list),
--   lists tiers of applications of this constructor.
--
-- For example, a @Bag@ represented as a list.
--
-- > bagCons Bag
bagCons :: Listable a => ([a] -> b) -> [[b]]
bagCons :: forall a b. Listable a => ([a] -> b) -> [[b]]
bagCons  =  (forall a b. (a -> b) -> [[a]] -> [[b]]
`mapT` forall a. [[a]] -> [[[a]]]
bagsOf forall a. Listable a => [[a]]
tiers)

-- | Given a constructor that takes a set of elements (as a list),
--   lists tiers of applications of this constructor.
--
-- A naive 'Listable' instance for the 'Data.Set.Set' (of "Data.Set")
-- would read:
--
-- > instance Listable a => Listable (Set a) where
-- >   tiers  =  cons0 empty \/ cons2 insert
--
-- The above instance has a problem: it generates repeated sets.
-- A more efficient implementation that does not repeat sets is given by:
--
-- >   tiers  =  setCons fromList
--
-- Alternatively, you can use 'setsOf' direclty.
setCons :: Listable a => ([a] -> b) -> [[b]]
setCons :: forall a b. Listable a => ([a] -> b) -> [[b]]
setCons  =  (forall a b. (a -> b) -> [[a]] -> [[b]]
`mapT` forall a. [[a]] -> [[[a]]]
setsOf forall a. Listable a => [[a]]
tiers)

-- | Given a constructor that takes a map of elements (encoded as a list),
--   lists tiers of applications of this constructor
--
--   So long as the underlying 'Listable' enumerations have no repetitions,
--   this will generate no repetitions.
--
--   This allows defining an efficient implementation of `tiers` that does not
--   repeat maps given by:
--
--   >   tiers  =  mapCons fromList
mapCons :: (Listable a, Listable b) => ([(a,b)] -> c) -> [[c]]
mapCons :: forall a b c. (Listable a, Listable b) => ([(a, b)] -> c) -> [[c]]
mapCons  =  (forall a b. (a -> b) -> [[a]] -> [[b]]
`mapT` forall a b. [[a]] -> [[b]] -> [[[(a, b)]]]
maps forall a. Listable a => [[a]]
tiers forall a. Listable a => [[a]]
tiers)

-- | Given a constructor that takes a list with no duplicate elements,
--   return tiers of applications of this constructor.
noDupListCons :: Listable a => ([a] -> b) -> [[b]]
noDupListCons :: forall a b. Listable a => ([a] -> b) -> [[b]]
noDupListCons  =  (forall a b. (a -> b) -> [[a]] -> [[b]]
`mapT` forall a. [[a]] -> [[[a]]]
noDupListsOf forall a. Listable a => [[a]]
tiers)

-- | Like 'cons0' but lifted over a 'Maybe' value.
--
-- Only a 'Just' value will be returned.
maybeCons0 :: Maybe b -> [[b]]
maybeCons0 :: forall b. Maybe b -> [[b]]
maybeCons0 Maybe b
Nothing   =  []
maybeCons0 (Just b
x)  =  [[b
x]]

-- | Like 'cons1' but lifted over a 'Maybe' result.
--
-- This discard 'Nothing' values.
-- Only 'Just' values are returned.
maybeCons1 :: Listable a => (a -> Maybe b) -> [[b]]
maybeCons1 :: forall a b. Listable a => (a -> Maybe b) -> [[b]]
maybeCons1 a -> Maybe b
f  =  forall a. [[a]] -> [[a]]
delay forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [[a]] -> [[b]]
mapMaybeT a -> Maybe b
f forall a. Listable a => [[a]]
tiers

-- | Like 'cons2' but lifted over a 'Maybe' result.
--
-- This discard 'Nothing' values.
-- Only 'Just' values are returned.
--
-- Useful when declaring generators which have pre-conditions:
--
-- > data Fraction  =  Fraction Int Int
-- >
-- > mkFraction _ 0  =  Nothing
-- > mkFraction n d  =  Fraction n d
-- >
-- > instance Listable Fraction where
-- >   tiers  =  maybeCons2 mkFraction
maybeCons2 :: (Listable a, Listable b) => (a -> b -> Maybe c) -> [[c]]
maybeCons2 :: forall a b c.
(Listable a, Listable b) =>
(a -> b -> Maybe c) -> [[c]]
maybeCons2 a -> b -> Maybe c
f  =  forall a. [[a]] -> [[a]]
delay forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [[a]] -> [[b]]
mapMaybeT (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> Maybe c
f) forall a. Listable a => [[a]]
tiers

-- | Like '><', but over 3 lists of tiers.
product3 :: [[a]] -> [[b]]-> [[c]] -> [[(a,b,c)]]
product3 :: forall a b c. [[a]] -> [[b]] -> [[c]] -> [[(a, b, c)]]
product3  =  forall a b c d.
(a -> b -> c -> d) -> [[a]] -> [[b]] -> [[c]] -> [[d]]
product3With (\a
x b
y c
z -> (a
x,b
y,c
z))

-- | Like 'productWith', but over 3 lists of tiers.
product3With :: (a->b->c->d) -> [[a]] -> [[b]] -> [[c]] -> [[d]]
product3With :: forall a b c d.
(a -> b -> c -> d) -> [[a]] -> [[b]] -> [[c]] -> [[d]]
product3With a -> b -> c -> d
f [[a]]
xss [[b]]
yss [[c]]
zss  =  forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
productWith forall a b. (a -> b) -> a -> b
($) (forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
productWith a -> b -> c -> d
f [[a]]
xss [[b]]
yss) [[c]]
zss

-- | Take the product of lists of tiers
--   by a function returning a 'Maybe' value
--   discarding 'Nothing' values.
productMaybeWith :: (a->b->Maybe c) -> [[a]] -> [[b]] -> [[c]]
productMaybeWith :: forall a b c. (a -> b -> Maybe c) -> [[a]] -> [[b]] -> [[c]]
productMaybeWith a -> b -> Maybe c
_ [[a]]
_ []  =  []
productMaybeWith a -> b -> Maybe c
_ [] [[b]]
_  =  []
productMaybeWith a -> b -> Maybe c
f ([a]
xs:[[a]]
xss) [[b]]
yss  =  forall a b. (a -> b) -> [a] -> [b]
map ([a]
xs [a] -> [b] -> [c]
**) [[b]]
yss
                                 forall a. [[a]] -> [[a]] -> [[a]]
\/ forall a. [[a]] -> [[a]]
delay (forall a b c. (a -> b -> Maybe c) -> [[a]] -> [[b]] -> [[c]]
productMaybeWith a -> b -> Maybe c
f [[a]]
xss [[b]]
yss)
  where
  [a]
xs ** :: [a] -> [b] -> [c]
** [b]
ys  =  forall a. [Maybe a] -> [a]
catMaybes [ a -> b -> Maybe c
f a
x b
y | a
x <- [a]
xs, b
y <- [b]
ys ]

-- | Takes as argument tiers of element values;
--   returns tiers of pairs with distinct element values.
--
-- When argument tiers have no repeated elements:
--
-- > distinctPairs xss  =  xss >< xss  `suchThat` uncurry (/=)
distinctPairs :: [[a]] -> [[(a,a)]]
distinctPairs :: forall a. [[a]] -> [[(a, a)]]
distinctPairs  =  forall a b. (a -> a -> b) -> [[a]] -> [[b]]
distinctPairsWith (,)

-- | 'distinctPairs' by a given function:
--
-- > distinctPairsWith f  =  mapT (uncurry f) . distinctPairs
distinctPairsWith :: (a -> a -> b) -> [[a]] -> [[b]]
distinctPairsWith :: forall a b. (a -> a -> b) -> [[a]] -> [[b]]
distinctPairsWith a -> a -> b
f  =  forall a. [[[[a]]]] -> [[a]]
concatT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
choicesWith (\a
e -> forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (a -> a -> b
f a
e))

-- | Takes as argument tiers of element values;
--   returns tiers of unordered pairs where, in enumeration order,
--   the first element is less than or equal to the second.
--
-- The name of this function is perhaps a misnomer.  But in mathematics,
-- an unordered pair is a pair where you don't care about element order, e.g.:
-- @(1,2) = (2,1)@.  This function will enumerate canonical versions of such
-- pairs where the first element is less than the second.
--
-- The returned element pairs can be seen as bags with two elements.
--
-- When argument tiers are listed in 'Ord':
--
-- > distinctPairs xss  =  xss >< xss  `suchThat` uncurry (<=)
unorderedPairs :: [[a]] -> [[(a,a)]]
unorderedPairs :: forall a. [[a]] -> [[(a, a)]]
unorderedPairs  =  forall a b. (a -> a -> b) -> [[a]] -> [[b]]
unorderedPairsWith (,)

-- | 'unorderedPairs' by a given function:
--
-- > unorderedPairsWith f  =  mapT (uncurry f) . unorderedPairs
unorderedPairsWith :: (a -> a -> b) -> [[a]] -> [[b]]
unorderedPairsWith :: forall a b. (a -> a -> b) -> [[a]] -> [[b]]
unorderedPairsWith a -> a -> b
f  =  forall a. [[[[a]]]] -> [[a]]
concatT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
bagChoicesWith (\a
e -> forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (a -> a -> b
f a
e))

-- | Takes as argument tiers of element values;
--   returns tiers of unordered pairs where, in enumeration order,
--   the first element is strictly less than the second.
--
-- The returned element pairs can be seen as sets with two elements.
--
-- When argument tiers are listed in 'Ord':
--
-- > distinctPairs xss  =  xss >< xss  `suchThat` uncurry (<)
unorderedDistinctPairs :: [[a]] -> [[(a,a)]]
unorderedDistinctPairs :: forall a. [[a]] -> [[(a, a)]]
unorderedDistinctPairs  =  forall a b. (a -> a -> b) -> [[a]] -> [[b]]
unorderedDistinctPairsWith (,)

-- | 'unorderedPairs' by a given function:
--
-- > unorderedDistinctPairsWith f  =  mapT (uncurry f) . unorderedDistinctPairs
unorderedDistinctPairsWith :: (a -> a -> b) -> [[a]] -> [[b]]
unorderedDistinctPairsWith :: forall a b. (a -> a -> b) -> [[a]] -> [[b]]
unorderedDistinctPairsWith a -> a -> b
f  =  forall a. [[[[a]]]] -> [[a]]
concatT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
setChoicesWith (\a
e -> forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (a -> a -> b
f a
e))

-- | Takes as argument tiers of element values;
--   returns tiers of lists of elements.
--
-- > listsOf [[]]  =  [[[]]]
--
-- > listsOf [[x]]  =  [ [[]]
-- >                   , [[x]]
-- >                   , [[x,x]]
-- >                   , [[x,x,x]]
-- >                   , ...
-- >                   ]
--
-- > listsOf [[x],[y]]  =  [ [[]]
-- >                       , [[x]]
-- >                       , [[x,x],[y]]
-- >                       , [[x,x,x],[x,y],[y,x]]
-- >                       , ...
-- >                       ]
listsOf :: [[a]] -> [[[a]]]
listsOf :: forall a. [[a]] -> [[[a]]]
listsOf [[a]]
xss  =  forall a. a -> [[a]]
cons0 []
             forall a. [[a]] -> [[a]] -> [[a]]
\/ forall a. [[a]] -> [[a]]
delay (forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
productWith (:) [[a]]
xss (forall a. [[a]] -> [[[a]]]
listsOf [[a]]
xss))

-- | Takes the product of N lists of tiers, producing lists of length N.
--
-- Alternatively,
-- takes as argument a list of lists of tiers of elements;
-- returns lists combining elements of each list of tiers.
--
-- > products [xss]  =  mapT (:[]) xss
-- > products [xss,yss]  =  mapT (\(x,y) -> [x,y]) (xss >< yss)
-- > products [xss,yss,zss]  =  product3With (\x y z -> [x,y,z]) xss yss zss
products :: [ [[a]] ] -> [[ [a] ]]
products :: forall a. [[[a]]] -> [[[a]]]
products  =  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
productWith (:)) [[[]]]

-- | Delete the first occurence of an element in a tier.
--
-- For normalized lists-of-tiers without repetitions, the following holds:
--
-- > deleteT x  =  normalizeT . (`suchThat` (/= x))
deleteT :: Eq a => a -> [[a]] -> [[a]]
deleteT :: forall a. Eq a => a -> [[a]] -> [[a]]
deleteT a
_ []  =  []
deleteT a
y ([]:[[a]]
xss)  =  [] forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [[a]] -> [[a]]
deleteT a
y [[a]]
xss
deleteT a
y [[a
x]]        | a
x forall a. Eq a => a -> a -> Bool
== a
y     =  []
deleteT a
y ((a
x:[a]
xs):[[a]]
xss) | a
x forall a. Eq a => a -> a -> Bool
== a
y     =  [a]
xsforall a. a -> [a] -> [a]
:[[a]]
xss
                       | Bool
otherwise  =  [[a
x]] forall a. [[a]] -> [[a]] -> [[a]]
\/ forall a. Eq a => a -> [[a]] -> [[a]]
deleteT a
y ([a]
xsforall a. a -> [a] -> [a]
:[[a]]
xss)

-- | Normalizes tiers by removing up to 12 empty tiers from the end of a list
--   of tiers.
--
-- > normalizeT [xs0,xs1,...,xsN,[]]     =  [xs0,xs1,...,xsN]
-- > normalizeT [xs0,xs1,...,xsN,[],[]]  =  [xs0,xs1,...,xsN]
--
-- The arbitrary limit of 12 tiers is necessary as this function would loop if
-- there is an infinite trail of empty tiers.
normalizeT :: [[a]] -> [[a]]
normalizeT :: forall a. [[a]] -> [[a]]
normalizeT []  =  []
normalizeT [[]]  =  []
normalizeT [[],[]]  =  []
normalizeT [[],[],[]]  =  []
normalizeT [[],[],[],[]]  =  []
normalizeT [[],[],[],[], []]  =  []
normalizeT [[],[],[],[], [],[]]  =  []
normalizeT [[],[],[],[], [],[],[]]  =  []
normalizeT [[],[],[],[], [],[],[],[]]  =  []
normalizeT [[],[],[],[], [],[],[],[], []]  =  []
normalizeT [[],[],[],[], [],[],[],[], [],[]]  =  []
normalizeT [[],[],[],[], [],[],[],[], [],[],[]]  =  []
normalizeT [[],[],[],[], [],[],[],[], [],[],[],[]]  =  []
normalizeT ([a]
xs:[[a]]
xss)  =  [a]
xsforall a. a -> [a] -> [a]
:forall a. [[a]] -> [[a]]
normalizeT [[a]]
xss

-- | Concatenate tiers of maybes
catMaybesT :: [[Maybe a]] -> [[a]]
catMaybesT :: forall a. [[Maybe a]] -> [[a]]
catMaybesT  =  forall a b. (a -> b) -> [a] -> [b]
map forall a. [Maybe a] -> [a]
catMaybes

-- | Like 'Data.Maybe.mapMaybe' but for tiers.
mapMaybeT :: (a -> Maybe b) -> [[a]] -> [[b]]
mapMaybeT :: forall a b. (a -> Maybe b) -> [[a]] -> [[b]]
mapMaybeT a -> Maybe b
f  =  forall a. [[Maybe a]] -> [[a]]
catMaybesT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [[a]] -> [[b]]
mapT a -> Maybe b
f

-- | Discard elements _not_ matching a predicate.
--
-- > discardT odd [[1],[2,3],[4]]  =  [[],[2],[4]]
discardT :: (a -> Bool) -> [[a]] -> [[a]]
discardT :: forall a. (a -> Bool) -> [[a]] -> [[a]]
discardT a -> Bool
p  =  forall a. (a -> Bool) -> [[a]] -> [[a]]
filterT (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

-- | Discard later elements maching a binary predicate
--   (in relation to an earlier element).
--
-- > discardLaterT (>) [[0],[1],[-1],[2],[-2],...]  =  [[0],[],[-1],[],[-2],...]
-- > discardLaterT (==) [[0],[0,1],[0,1,2],[0,1,2,3],...]  =  [[0],[1],[2],[3]]
--
-- This function is quite innefficient, use with care.
-- Consuming the n-th element takes @O(n^2)@ operations.
discardLaterT :: (a -> a -> Bool) -> [[a]] -> [[a]]
discardLaterT :: forall a. (a -> a -> Bool) -> [[a]] -> [[a]]
discardLaterT a -> a -> Bool
d []            =  []
discardLaterT a -> a -> Bool
d ([]:[[a]]
xss)      =  [] forall a. a -> [a] -> [a]
: forall a. (a -> a -> Bool) -> [[a]] -> [[a]]
discardLaterT a -> a -> Bool
d [[a]]
xss
discardLaterT a -> a -> Bool
d ((a
x:[a]
xs):[[a]]
xss)  =  [[a
x]]
                              forall a. [[a]] -> [[a]] -> [[a]]
\/ forall a. (a -> a -> Bool) -> [[a]] -> [[a]]
discardLaterT a -> a -> Bool
d (forall a. (a -> Bool) -> [[a]] -> [[a]]
discardT (a -> a -> Bool
`d` a
x) ([a]
xsforall a. a -> [a] -> [a]
:[[a]]
xss))

-- | Removes repetitions from tiers.
--
-- > nubT [[0],[0,1],[0,1,2],[0,1,2,3],...]  =  [[0],[1],[2],[3],...]
-- > nubT [[0],[-1,0,1],[-2,-1,0,1,2],...]  =  [[0],[-1,1],[-2,2],...]
--
-- Consuming the n-th element takes @O(n^2)@ operations.
nubT :: Ord a => [[a]] -> [[a]]
nubT :: forall a. Ord a => [[a]] -> [[a]]
nubT  =  forall a. (a -> a -> Bool) -> [[a]] -> [[a]]
discardLaterT forall a. Eq a => a -> a -> Bool
(==)

-- | Takes as argument tiers of element values;
--   returns tiers of lists with no repeated elements.
--
-- > noDupListsOf [[0],[1],[2],...] ==
-- >   [ [[]]
-- >   , [[0]]
-- >   , [[1]]
-- >   , [[0,1],[1,0],[2]]
-- >   , [[0,2],[2,0],[3]]
-- >   , ...
-- >   ]
noDupListsOf :: [[a]] -> [[[a]]]
noDupListsOf :: forall a. [[a]] -> [[[a]]]
noDupListsOf =
  ([[]]forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[[[a]]]] -> [[a]]
concatT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
choicesWith (\a
x [[a]]
xss -> forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (a
xforall a. a -> [a] -> [a]
:) (forall a. [[a]] -> [[[a]]]
noDupListsOf [[a]]
xss))

-- | Takes as argument tiers of element values;
--   returns tiers of size-ordered lists of elements possibly with repetition.
--
-- > bagsOf [[0],[1],[2],...] =
-- >   [ [[]]
-- >   , [[0]]
-- >   , [[0,0],[1]]
-- >   , [[0,0,0],[0,1],[2]]
-- >   , [[0,0,0,0],[0,0,1],[0,2],[1,1],[3]]
-- >   , [[0,0,0,0,0],[0,0,0,1],[0,0,2],[0,1,1],[0,3],[1,2],[4]]
-- >   , ...
-- >   ]
bagsOf :: [[a]] -> [[[a]]]
bagsOf :: forall a. [[a]] -> [[[a]]]
bagsOf  =  ([[]]forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[[[a]]]] -> [[a]]
concatT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
bagChoicesWith (\a
x [[a]]
xss -> forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (a
xforall a. a -> [a] -> [a]
:) (forall a. [[a]] -> [[[a]]]
bagsOf [[a]]
xss))


-- | Takes as argument tiers of element values;
--   returns tiers of size-ordered lists of elements without repetition.
--
-- > setsOf [[0],[1],[2],...] =
-- >   [ [[]]
-- >   , [[0]]
-- >   , [[1]]
-- >   , [[0,1],[2]]
-- >   , [[0,2],[3]]
-- >   , [[0,3],[1,2],[4]]
-- >   , [[0,1,2],[0,4],[1,3],[5]]
-- >   , ...
-- >   ]
--
-- Can be used in the constructor of specialized 'Listable' instances.
-- For 'Data.Set.Set' (from "Data.Set"), we would have:
--
-- > instance Listable a => Listable (Set a) where
-- >   tiers  =  mapT fromList $ setsOf tiers
setsOf :: [[a]] -> [[[a]]]
setsOf :: forall a. [[a]] -> [[[a]]]
setsOf  =  ([[]]forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[[[a]]]] -> [[a]]
concatT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
setChoicesWith (\a
x [[a]]
xss -> forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (a
xforall a. a -> [a] -> [a]
:) (forall a. [[a]] -> [[[a]]]
setsOf [[a]]
xss))

-- | Takes as arguments tiers of source and target values;
--   returns tiers of maps from the source to the target encoded as lists
--   without repetition.
maps :: [[a]] -> [[b]] -> [[[(a,b)]]]
maps :: forall a b. [[a]] -> [[b]] -> [[[(a, b)]]]
maps [[a]]
xss [[b]]
yss  =  forall a b. (a -> [[b]]) -> [[a]] -> [[b]]
concatMapT forall {a}. [a] -> [[[(a, b)]]]
mapsFor (forall a. [[a]] -> [[[a]]]
setsOf [[a]]
xss)
  where
--mapsFor :: [a] -> [[ [(a,b)] ]]
  mapsFor :: [a] -> [[[(a, b)]]]
mapsFor [a]
xs  =  forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs forall a b. (a -> b) -> [[a]] -> [[b]]
`mapT` forall a. [[[a]]] -> [[[a]]]
products (forall a b. a -> b -> a
const [[b]]
yss forall a b. (a -> b) -> [a] -> [b]
`map` [a]
xs)

-- | Lists tiers of choices.
-- Choices are pairs of values and tiers excluding that value.
--
-- > choices [[False,True]] == [[(False,[[True]]),(True,[[False]])]]
-- > choices [[1],[2],[3]]
-- >   == [ [(1,[[],[2],[3]])]
-- >      , [(2,[[1],[],[3]])]
-- >      , [(3,[[1],[2],[]])] ]
--
-- Each choice is sized by the extracted element.
choices :: [[a]] -> [[(a,[[a]])]]
choices :: forall a. [[a]] -> [[(a, [[a]])]]
choices  =  forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
choicesWith (,)

-- | Like 'choices', but allows a custom function.
choicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]
choicesWith :: forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
choicesWith a -> [[a]] -> b
f []  =  []
choicesWith a -> [[a]] -> b
f [[]]  =  []
choicesWith a -> [[a]] -> b
f ([]:[[a]]
xss)
  =  [] forall a. a -> [a] -> [a]
: forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
choicesWith (\a
y [[a]]
yss -> a -> [[a]] -> b
f a
y ([]forall a. a -> [a] -> [a]
:forall a. [[a]] -> [[a]]
normalizeT [[a]]
yss)) [[a]]
xss
choicesWith a -> [[a]] -> b
f ((a
x:[a]
xs):[[a]]
xss)
  =  [[a -> [[a]] -> b
f a
x ([a]
xsforall a. a -> [a] -> [a]
:[[a]]
xss)]]
  forall a. [[a]] -> [[a]] -> [[a]]
\/ forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
choicesWith (\a
y ([a]
ys:[[a]]
yss) -> a -> [[a]] -> b
f a
y ((a
xforall a. a -> [a] -> [a]
:[a]
ys)forall a. a -> [a] -> [a]
:[[a]]
yss)) ([a]
xsforall a. a -> [a] -> [a]
:[[a]]
xss)

-- | Like 'choices' but lists tiers of non-decreasing (ascending) choices.
--   Used to construct 'bagsOf' values.
--
-- > bagChoices [[False,True]] =
-- >   [ [(False,[[False,True]]), (True,[[True]])]
-- >   ]
--
-- > bagChoices [[1],[2],[3],...] =
-- >   [ [(1,[[1],[2],[3],...])]
-- >   , [(2,[[ ],[2],[3],...])]
-- >   , [(3,[[ ],[ ],[3],...])]
-- >   , ...
-- >   ]
bagChoices :: [[a]] -> [[(a,[[a]])]]
bagChoices :: forall a. [[a]] -> [[(a, [[a]])]]
bagChoices  =  forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
bagChoicesWith (,)

-- | Like 'bagChoices' but customized by a function.
bagChoicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]
bagChoicesWith :: forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
bagChoicesWith a -> [[a]] -> b
f []  =  []
bagChoicesWith a -> [[a]] -> b
f [[]]  =  []
bagChoicesWith a -> [[a]] -> b
f ([]:[[a]]
xss)
  =  []
  forall a. a -> [a] -> [a]
:  forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
bagChoicesWith (\a
y [[a]]
yss -> a -> [[a]] -> b
f a
y ([]forall a. a -> [a] -> [a]
:[[a]]
yss)) [[a]]
xss
bagChoicesWith a -> [[a]] -> b
f ((a
x:[a]
xs):[[a]]
xss)
  =  [[a -> [[a]] -> b
f a
x ((a
xforall a. a -> [a] -> [a]
:[a]
xs)forall a. a -> [a] -> [a]
:[[a]]
xss)]]
  forall a. [[a]] -> [[a]] -> [[a]]
\/ forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
bagChoicesWith a -> [[a]] -> b
f ([a]
xsforall a. a -> [a] -> [a]
:[[a]]
xss)

-- | Like 'choices' but lists tiers of strictly ascending choices.
--   Used to construct 'setsOf' values.
--
-- > setChoices [[False,True]] == [[(False,[[True]]),(True,[[]])]]
-- > setChoices [[1],[2],[3]]
-- >   == [ [(1,[[],[2],[3]])]
-- >      , [(2,[[],[],[3]])]
-- >      , [(3,[[],[],[]])]
-- >      ]
setChoices :: [[a]] -> [[(a,[[a]])]]
setChoices :: forall a. [[a]] -> [[(a, [[a]])]]
setChoices  =  forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
setChoicesWith (,)

-- | Like 'setChoices' but customized by a function.
setChoicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]
setChoicesWith :: forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
setChoicesWith a -> [[a]] -> b
f []  =  []
setChoicesWith a -> [[a]] -> b
f [[]]  =  []
setChoicesWith a -> [[a]] -> b
f ([]:[[a]]
xss)
  =  []
  forall a. a -> [a] -> [a]
:  forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
setChoicesWith (\a
y [[a]]
yss -> a -> [[a]] -> b
f a
y ([]forall a. a -> [a] -> [a]
:forall a. [[a]] -> [[a]]
normalizeT [[a]]
yss)) [[a]]
xss
setChoicesWith a -> [[a]] -> b
f ((a
x:[a]
xs):[[a]]
xss)
  =  [[a -> [[a]] -> b
f a
x ([a]
xsforall a. a -> [a] -> [a]
:[[a]]
xss)]]
  forall a. [[a]] -> [[a]] -> [[a]]
\/ forall a b. (a -> [[a]] -> b) -> [[a]] -> [[b]]
setChoicesWith a -> [[a]] -> b
f ([a]
xsforall a. a -> [a] -> [a]
:[[a]]
xss)

-- | Takes as argument an integer length and tiers of element values;
--   returns tiers of lists of element values of the given length.
--
-- > listsOfLength 3 [[0],[1],[2],[3],[4]...] =
-- >   [ [[0,0,0]]
-- >   , [[0,0,1],[0,1,0],[1,0,0]]
-- >   , [[0,0,2],[0,1,1],[0,2,0],[1,0,1],[1,1,0],[2,0,0]]
-- >   , ...
-- >   ]
listsOfLength :: Int -> [[a]] -> [[[a]]]
listsOfLength :: forall a. Int -> [[a]] -> [[[a]]]
listsOfLength Int
n [[a]]
xss  =  forall a. [[[a]]] -> [[[a]]]
products (forall a. Int -> a -> [a]
replicate Int
n [[a]]
xss)




-- -- Showing tiers of values -- --

-- | Shows a list of strings, one element per line.
--   The returned string _does not_ end with a line break.
--
-- > listLines []  =  "[]"
-- > listLines ["0"]  =  "[0]"
-- > listLines ["0","1"]  =  "[ 0\n\
-- >                          \, 1\n\
-- >                          \]"
listLines :: [String] -> String
listLines :: [String] -> String
listLines []  =  String
"[]"
listLines [String
s] | Char
'\n' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
s  =  String
"[" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"]"
listLines [String]
ss  =  (forall a. [a] -> [a] -> [a]
++ String
"]")
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
beside ([String
"[ "] forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat String
", ")
              forall a b. (a -> b) -> a -> b
$ [String]
ss
  where
  beside :: String -> String -> String
  beside :: String -> String -> String
beside String
s  =  forall a. [a] -> [a]
init
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) ([String
s] forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat (forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '))
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines


-- | Shows a list, one element per line.
--   The returned string _does not_ end with a line break.
--
-- > listLines []  =  "[]"
-- > listLines [0]  =  "[0]"
-- > listLines [0,1]  =  "[ 0\n\
-- >                     \, 1\n\
-- >                     \]"
showListLines :: Show a => [a] -> String
showListLines :: forall a. Show a => [a] -> String
showListLines  =  [String] -> String
listLines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show

-- | Shows a list of strings, adding @...@ to the end when longer than given
--   length.
--
-- > dotsLongerThan 3 ["1","2"]          =  [1,2]
-- > dotsLongerThan 3 ["1","2","3","4"]  = [1,2,3,...]
-- > dotsLongerThan 5 $ map show [1..]   = [1,2,3,4,5,...]
dotsLongerThan :: Int -> [String] -> [String]
dotsLongerThan :: Int -> [String] -> [String]
dotsLongerThan Int
n [String]
xs  =  forall a. Int -> [a] -> [a]
take Int
n [String]
xs forall a. [a] -> [a] -> [a]
++ [String
"..." | Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
n [String]
xs]

-- | Alternative to 'show' for 'tiers' with one element per line.
--   (useful for debugging, see also 'printTiers').
--
--   This function can be useful when debugging your 'Listable' instances.
showTiers :: Show a => Int -> [[a]] -> String
showTiers :: forall a. Show a => Int -> [[a]] -> String
showTiers Int
n  =  [String] -> String
listLines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
dotsLongerThan Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => [a] -> String
showListLines

-- | Alternative to 'print' for 'tiers' with one element per line.
--   (useful for debugging, see also 'showTiers').
--
-- > > printTiers 3 (tiers :: [[Int]])
-- > [ [0]
-- > , [1]
-- > , [-1]
-- > , ...
-- > ]
-- > > printTiers 3 (tiers :: [[Bool]])
-- > [ [ False
-- >   , True
-- >   ]
-- > ]
--
-- This function can be useful when debugging your 'Listable' instances.
printTiers :: Show a => Int -> [[a]] -> IO ()
printTiers :: forall a. Show a => Int -> [[a]] -> IO ()
printTiers Int
n  =  String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> [[a]] -> String
showTiers Int
n

-- | Checks if a list-of-tiers is finite.
--
-- **Warning:** this is just an approximation, a list-of-tiers is considered
--              finite if it has less than 13 values.  This function may give
--              false negatives.
finite :: [[a]] -> Bool
finite :: forall a. [[a]] -> Bool
finite  =  forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
12 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
60
-- NOTE: `take 60` is there because otherwise this function would not
-- terminate in a tier-of-lists with an infinite tail of empty tiers, like:
-- > import Test.LeanCheck.Function.ListsOfPairs
-- > map length (tiers :: [[ Nat -> () ]]) [1,0,0,0,0,0,...]
-- maybe this `take 60` has to be copied in other places of LeanCheck to avoid
-- similar issues of non-temrination.