-- |
-- Module      : Test.LeanCheck.Function.ListsOfPairs
-- Copyright   : (c) 2015-2020 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of LeanCheck,
-- a simple enumerative property-based testing library.
--
-- This module exports means to enumerate functions via lists of pairs.
--
-- This module considers functions as a finite list of exceptional input-output
-- cases to a default value (list of pairs of arguments and results).
module Test.LeanCheck.Function.ListsOfPairs
  ( (-->>)
  , exceptionPairs
  )
where

import Test.LeanCheck
import Test.LeanCheck.Tiers

-- | Given tiers of argument and result values,
--   return tiers of functional values.
(-->>) :: Eq a => [[a]] -> [[b]] -> [[a->b]]
[[a]]
xss -->> :: forall a b. Eq a => [[a]] -> [[b]] -> [[a -> b]]
-->> [[b]]
yss
  | forall a. [[a]] -> Bool
finite [[a]]
xss  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT ((forall a. HasCallStack => a
undefined forall a b. Eq a => (a -> b) -> [(a, b)] -> a -> b
`mutate`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
xss))
                        (forall a. [[[a]]] -> [[[a]]]
products forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
xss) [[b]]
yss)
  | Bool
otherwise   =  forall a b. (a -> [[b]]) -> [[a]] -> [[b]]
concatMapT (\(b
r,[[b]]
yss) -> forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (forall a b. a -> b -> a
const b
r forall a b. Eq a => (a -> b) -> [(a, b)] -> a -> b
`mutate`)
                                                (forall a b. [[a]] -> [[b]] -> [[[(a, b)]]]
exceptionPairs [[a]]
xss [[b]]
yss))
                              (forall a. [[a]] -> [[(a, [[a]])]]
choices [[b]]
yss)


mutate :: Eq a => (a -> b) -> [(a,b)] -> (a -> b)
mutate :: forall a b. Eq a => (a -> b) -> [(a, b)] -> a -> b
mutate a -> b
f [(a, b)]
ms  =  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {t} {b}. Eq t => (t, b) -> (t -> b) -> t -> b
mut a -> b
f [(a, b)]
ms
  where
  mut :: (t, b) -> (t -> b) -> t -> b
mut (t
x',b
fx') t -> b
f t
x  =  if t
x forall a. Eq a => a -> a -> Bool
== t
x' then b
fx' else t -> b
f t
x


-- | Given tiers of input values and tiers of output values,
-- return tiers with all possible lists of input-output pairs.
-- These represent functional relations.
-- In the implementation of '-->>',
-- they represent exceptions to a constant function,
-- hence the name 'exceptionPairs'.
exceptionPairs :: [[a]] -> [[b]] -> [[ [(a,b)] ]]
exceptionPairs :: forall a b. [[a]] -> [[b]] -> [[[(a, b)]]]
exceptionPairs [[a]]
xss [[b]]
yss  =  forall a b. (a -> [[b]]) -> [[a]] -> [[b]]
concatMapT forall {a}. [a] -> [[[(a, b)]]]
exceptionsFor (forall a. [[a]] -> [[[a]]]
incompleteSetsOf [[a]]
xss)
  where
--exceptionsFor :: [a] -> [[ [(a,b)] ]]
  exceptionsFor :: [a] -> [[[(a, b)]]]
exceptionsFor [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)
-- incompleteSetsOf is needed, instead of setsOf, because mutating *all* values
-- of a constant function makes no sense (we would have already enumerated that
-- function anyway).  As of 2c23c1a, it makes no difference whether
-- incompleteSetsOf is used instead of setsOf for types with less than 12
-- values because of the finite guard on `-->>`.

-- | Returns tiers of sets excluding the universe set.
--
-- > incompleteSetsOf (tiers :: [[Bool]])  =  [[],[[False],[True]],[]]
-- > incompleteSetsOf (tiers :: [[()]])    =  [[]]
--
-- This is the same as 'setsOf' on types with infinite values:
--
-- > incompleteSetsOf (tiers :: [[Int]])  =  setsOf (tiers :: [[Int]])
incompleteSetsOf :: [[a]] -> [[ [a] ]]
incompleteSetsOf :: forall a. [[a]] -> [[[a]]]
incompleteSetsOf  =  forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[[a]]]
setsOf
-- the above implementation works because, and depends on the fact that:
-- the last tier returned by setsOf contains only the complete set