-- |
-- Module      : Test.Extrapolate.Speculation
-- Copyright   : (c) 2017-2019 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of Extrapolate,
-- a library for generalization of counter-examples.
--
-- This defines utilities for speculation about side conditions.
--
-- You are probably better off importing "Test.Extrapolate".
module Test.Extrapolate.Speculation
  ( theoryAndReprConds

  -- re-exports from Speculate
  , Thy
  , Expr
  , classesFromSchemasAndVariables
  )
where

import Data.Monoid ((<>)) -- for GHC <= 8.2

import Test.LeanCheck ((\/))

import Test.Speculate.Engine (theoryAndRepresentativesFromAtoms, classesFromSchemasAndVariables)
import Test.Speculate.Reason (Thy)

import Test.Extrapolate.Utils
import Test.Extrapolate.Expr

theoryAndReprExprs :: (Expr -> Expr -> Bool) -> Int -> [[Expr]] -> (Thy,[Expr])
theoryAndReprExprs :: (Expr -> Expr -> Bool) -> Int -> [[Expr]] -> (Thy, [Expr])
theoryAndReprExprs Expr -> Expr -> Bool
(===) Int
maxConditionSize  =
    (\(Thy
thy,[[Expr]]
ess) -> (Thy
thy, [[Expr]] -> [Expr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Expr]] -> [Expr]) -> [[Expr]] -> [Expr]
forall a b. (a -> b) -> a -> b
$ Int -> [[Expr]] -> [[Expr]]
forall a. Int -> [a] -> [a]
take Int
maxConditionSize [[Expr]]
ess))
  ((Thy, [[Expr]]) -> (Thy, [Expr]))
-> ([[Expr]] -> (Thy, [[Expr]])) -> [[Expr]] -> (Thy, [Expr])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Expr -> Bool) -> Int -> [[Expr]] -> (Thy, [[Expr]])
theoryAndRepresentativesFromAtoms Expr -> Expr -> Bool
(===) Int
maxConditionSize

theoryAndReprConds :: (Expr -> Expr -> Bool) -> Int -> [[Expr]] -> (Thy, [Expr])
theoryAndReprConds :: (Expr -> Expr -> Bool) -> Int -> [[Expr]] -> (Thy, [Expr])
theoryAndReprConds Expr -> Expr -> Bool
(===) Int
maxConditionSize [[Expr]]
ess  =  (Thy
thy, (Expr -> Bool) -> [Expr] -> [Expr]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Expr
c -> Expr -> TypeRep
typ Expr
c TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
boolTy) [Expr]
es)
  where
  (Thy
thy,[Expr]
es) = (Expr -> Expr -> Bool) -> Int -> [[Expr]] -> (Thy, [Expr])
theoryAndReprExprs Expr -> Expr -> Bool
(===) Int
maxConditionSize [[Expr]]
ess