{-# LANGUAGE CPP #-}
-- |
-- Module      : Test.LeanCheck.Function.ShowFunction
-- 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 the 'ShowFunction' typeclass,
-- its instances and related functions.
--
-- Using this module, it is possible to implement
-- a 'Show' instance for functions:
--
-- > import Test.LeanCheck.ShowFunction
-- > instance (Show a, Listable a, ShowFunction b) => Show (a->b) where
-- >   show = showFunction 8
--
-- This shows functions as a case pattern with up to 8 cases.
--
-- It will only work for functions whose ultimate return value is an instance
-- of 'ShowFunction'.  This module provides instances for most standard data
-- types ('Int', 'Bool', 'Maybe', ...).  Please see the 'ShowFunction'
-- typeclass documentation for how to declare istances for user-defined data
-- types.
--
-- The modules
-- "Test.LeanCheck.Function"
-- and
-- "Test.LeanCheck.Function.Show"
-- exports an instance like the one above.
{-# LANGUAGE CPP #-}
module Test.LeanCheck.Function.ShowFunction
  (
  -- * Showing functions
    showFunction
  , showFunctionLine

  -- * Support for user-defined algebraic datatypes on return values
  , ShowFunction (..)
  , bindtiersShow

  -- * Listing functional bindings
  , Binding
  , bindings

  -- * Pipeline for explaining, describing and clarifying bindings
  , explainedBindings
  , describedBindings
  , clarifiedBindings

  -- * Re-exports
  , Listable
  )
where

import Test.LeanCheck.Core
import Test.LeanCheck.Error (errorToNothing)
import Test.LeanCheck.Utils.Types
import Test.LeanCheck.Stats (classifyOn)
import Data.Maybe
import Data.Function (on)
import Data.Word
import Data.Int
import Data.Ratio
import Data.Complex
import Data.Char (GeneralCategory)
import System.Exit (ExitCode)
import System.IO (IOMode, BufferMode, SeekMode)
import Foreign.C
#ifndef __HUGS__
import Data.List (intercalate, sortBy)
#else
import Data.List (sortBy)

intercalate :: [a] -> [[a]] -> [a]
intercalate xs xss = concat (intersperse xs xss)
  where
  intersperse             :: a -> [a] -> [a]
  intersperse _   []      = []
  intersperse sep (x:xs)  = x : prependToAll sep xs
    where
    prependToAll            :: a -> [a] -> [a]
    prependToAll _   []     = []
    prependToAll sep (x:xs) = sep : x : prependToAll sep xs
#endif

-- | A functional binding in a showable format.
--   Argument values are represented as a list of strings.
--   The result value is represented by 'Just' a 'String' when defined
--   or by 'Nothing' when 'undefined'.
type Binding = ([String], Maybe String)

-- | 'ShowFunction' values are those for which
--   we can return a list of functional bindings.
--
-- Instances for 'show'able algebraic datatypes are defined using
-- 'bindtiersShow':
--
-- > instance ShowFunction Ty where bindtiers = bindtiersShow
class ShowFunction a where
  bindtiers :: a -> [[Binding]]

-- | Given a 'ShowFunction' value, return a list of 'Binding's.
--   If the domain of the given argument function is infinite,
--   the resulting list is infinite.
--
-- Some examples follow.  These are used as running examples in the definition
-- of 'explainedBindings', 'describedBindings' and 'clarifiedBindings'.
--
-- * Defined return values are represented as 'Just' 'String's:
--
--     > > bindings True
--     > [([],Just "True")]
--
-- * Undefined return values are represented as @Nothing@:
--
--     > > bindings undefined
--     > [([],Nothing)]
--
-- * Infinite domains result in an infinite bindings list:
--
--     > > bindings (id::Int->Int)
--     > [ (["0"], Just "0")
--     > , (["1"], Just "1")
--     > , (["-1"], Just "-1")
--     > , ...
--     > ]
--
-- * Finite domains result in a finite bindings list:
--
--     > > bindings (&&)
--     > [ (["False","False"], Just "False")
--     > , (["False","True"], Just "False")
--     > , (["True","False"], Just "False")
--     > , (["True","True"], Just "True")
--     > ]
--
--     > > bindings (||)
--     > [ (["False","False"], Just "False")
--     > , (["False","True"], Just "True")
--     > , (["True","False"], Just "True")
--     > , (["True","True"], Just "True")
--     > ]
--
-- * Even very simple functions are represented by an infinite list of bindings:
--
--     > > bindings (== 0)
--     > [ (["0"], Just "True")
--     > , (["1"], Just "False")
--     > , (["-1"], Just "False")
--     > , ...
--     > ]
--
--     > > bindings (== 1)
--     > [ (["0"], Just "False")
--     > , (["1"], Just "True")
--     > , (["-1"], Just "False")
--     > , ...
--     > ]
--
-- * Ignored arguments are still listed:
--
--     > > bindings ((\_ y -> y == 1) :: Int -> Int -> Bool)
--     > [ (["0","0"], Just "False")
--     > , (["0","1"], Just "True")
--     > , (["1","0"], Just "False")
--     > , ...
--     > ]
--
-- * Again, undefined values are represented as 'Nothing'.
--   Here, the 'head' of an empty list is undefined:
--
--     > > bindings (head :: [Int] -> Int)
--     > [ (["[]"], Nothing)
--     > , (["[0]"], Just "0")
--     > , (["[0,0]"], Just "0")
--     > , (["[1]"], Just "1")
--     > , ...
--     > ]
bindings :: ShowFunction a => a -> [Binding]
bindings :: a -> [Binding]
bindings = [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Binding]] -> [Binding]) -> (a -> [[Binding]]) -> a -> [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [[Binding]]
forall a. ShowFunction a => a -> [[Binding]]
bindtiers


-- | A drop-in implementation of 'bindtiers' for 'show'able types.
--
-- Define instances for 'show'able algebraic datatypes as:
--
-- > instance ShowFunction Ty where bindtiers = bindtiersShow
bindtiersShow :: Show a => a -> [[Binding]]
bindtiersShow :: a -> [[Binding]]
bindtiersShow a
x = [[([],String -> Maybe String
forall a. a -> Maybe a
errorToNothing (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x)]]

instance ShowFunction ()       where bindtiers :: () -> [[Binding]]
bindtiers = () -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Bool     where bindtiers :: Bool -> [[Binding]]
bindtiers = Bool -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Int      where bindtiers :: Int -> [[Binding]]
bindtiers = Int -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Word     where bindtiers :: Word -> [[Binding]]
bindtiers = Word -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Integer  where bindtiers :: Integer -> [[Binding]]
bindtiers = Integer -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Char     where bindtiers :: Char -> [[Binding]]
bindtiers = Char -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Float    where bindtiers :: Float -> [[Binding]]
bindtiers = Float -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Double   where bindtiers :: Double -> [[Binding]]
bindtiers = Double -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Ordering where bindtiers :: Ordering -> [[Binding]]
bindtiers = Ordering -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance Show a => ShowFunction [a]       where bindtiers :: [a] -> [[Binding]]
bindtiers = [a] -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance Show a => ShowFunction (Maybe a) where bindtiers :: Maybe a -> [[Binding]]
bindtiers = Maybe a -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance (Show a, Show b) => ShowFunction (Either a b) where bindtiers :: Either a b -> [[Binding]]
bindtiers = Either a b -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance (Show a, Show b) => ShowFunction (a,b) where bindtiers :: (a, b) -> [[Binding]]
bindtiers = (a, b) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

-- instance for functional value type --
instance (Show a, Listable a, ShowFunction b) => ShowFunction (a->b) where
  bindtiers :: (a -> b) -> [[Binding]]
bindtiers a -> b
f = (a -> [[Binding]]) -> [[a]] -> [[Binding]]
forall a b. (a -> [[b]]) -> [[a]] -> [[b]]
concatMapT a -> [[Binding]]
bindtiersFor [[a]]
forall a. Listable a => [[a]]
tiers
    where bindtiersFor :: a -> [[Binding]]
bindtiersFor a
x = ([String] -> [String]) -> Binding -> Binding
forall t a b. (t -> a) -> (t, b) -> (a, b)
mapFst (a -> String
forall a. Show a => a -> String
show a
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) (Binding -> Binding) -> [[Binding]] -> [[Binding]]
forall a b. (a -> b) -> [[a]] -> [[b]]
`mapT` b -> [[Binding]]
forall a. ShowFunction a => a -> [[Binding]]
bindtiers (a -> b
f a
x)
          mapFst :: (t -> a) -> (t, b) -> (a, b)
mapFst t -> a
f (t
x,b
y) = (t -> a
f t
x, b
y)

paren :: String -> String
paren :: String -> String
paren String
s = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

showTuple :: [String] -> String
showTuple :: [String] -> String
showTuple [String
x]  =  String
x
showTuple [String]
xs | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_") [String]
xs  =  String
"_"
             | Bool
otherwise        =  String -> String
paren (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
xs

showBindings :: [Binding] -> [String]
showBindings :: [Binding] -> [String]
showBindings [Binding]
bs = [ [String] -> String
showTuple [String]
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r | ([String]
as, Just String
r) <- [Binding]
bs ]

showNBindings :: Bool -> Int -> [Binding] -> [String]
showNBindings :: Bool -> Int -> [Binding] -> [String]
showNBindings Bool
infinite Int
n [Binding]
bs' = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
n [String]
bs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"..." | Bool
infinite Bool -> Bool -> Bool
|| [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n]
  where
  bs :: [String]
bs = [Binding] -> [String]
showBindings [Binding]
bs'

isValue :: ShowFunction a => a -> Bool
isValue :: a -> Bool
isValue a
f = case a -> [Binding]
forall a. ShowFunction a => a -> [Binding]
bindings a
f of
              [([],Maybe String
_)] -> Bool
True
              [Binding]
_        -> Bool
False

showValueOf :: ShowFunction a => a -> String
showValueOf :: a -> String
showValueOf a
x = case Binding -> Maybe String
forall a b. (a, b) -> b
snd (Binding -> Maybe String) -> (a -> Binding) -> a -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Binding] -> Binding
forall a. [a] -> a
head ([Binding] -> Binding) -> (a -> [Binding]) -> a -> Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Binding]
forall a. ShowFunction a => a -> [Binding]
bindings (a -> Maybe String) -> a -> Maybe String
forall a b. (a -> b) -> a -> b
$ a
x of
                  Maybe String
Nothing -> String
"undefined"
                  Just String
x' -> String
x'

-- | Given the number of patterns to show, shows a 'ShowFunction' value.
--
-- > > putStrLn $ showFunction undefined True
-- > True
-- >
-- > > putStrLn $ showFunction 3 (id::Int->Int)
-- > \x -> case x of
-- >       0 -> 0
-- >       1 -> 1
-- >       -1 -> -1
-- >       ...
-- >
-- > > putStrLn $ showFunction 4 (&&)
-- > \x y -> case (x,y) of
-- >         (True,True) -> True
-- >         _ -> False
-- >
--
-- In the examples above, "@...@" should be interpreted literally.
--
-- This can be used as an implementation of 'show' for functions:
--
-- > instance (Show a, Listable a, ShowFunction b) => Show (a->b) where
-- >   show = showFunction 8
--
-- See 'showFunctionLine' for an alternative without line breaks.
showFunction :: ShowFunction a => Int -> a -> String
showFunction :: Int -> a -> String
showFunction Int
n = Bool -> Int -> Int -> a -> String
forall a. ShowFunction a => Bool -> Int -> Int -> a -> String
showFunctionL Bool
False (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n

-- | Same as 'showFunction', but has no line breaks.
--
-- > > putStrLn $ showFunctionLine 3 (id::Int->Int)
-- > \x -> case x of 0 -> 0; 1 -> 1; -1 -> -1; ...
-- > > putStrLn $ showFunctionLine 3 (&&)
-- > \x y -> case (x,y) of (True,True) -> True; _ -> False
--
-- This can be used as an implementation of 'show' for functions:
--
-- > instance (Show a, Listable a, ShowFunction b) => Show (a->b) where
-- >   show = showFunction 8
showFunctionLine :: ShowFunction a => Int -> a -> String
showFunctionLine :: Int -> a -> String
showFunctionLine Int
n = Bool -> Int -> Int -> a -> String
forall a. ShowFunction a => Bool -> Int -> Int -> a -> String
showFunctionL Bool
True (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n

-- | isUndefined checks if a function is totally undefined
--   for the given maximum number of values
isUndefined :: ShowFunction a => Int -> a -> Bool
isUndefined :: Int -> a -> Bool
isUndefined Int
m = (Binding -> Bool) -> [Binding] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool)
-> (Binding -> Maybe String) -> Binding -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binding -> Maybe String
forall a b. (a, b) -> b
snd) ([Binding] -> Bool) -> (a -> [Binding]) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Binding] -> [Binding]
forall a. Int -> [a] -> [a]
take Int
m ([Binding] -> [Binding]) -> (a -> [Binding]) -> a -> [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Binding]
forall a. ShowFunction a => a -> [Binding]
bindings

-- | checks if a function is constant
--   for the given maximum number of values
isConstant :: ShowFunction a => Int -> a -> Bool
isConstant :: Int -> a -> Bool
isConstant Int
m a
f = case Int -> [Binding] -> [Binding]
forall a. Int -> [a] -> [a]
take Int
m ([Binding] -> [Binding]) -> [Binding] -> [Binding]
forall a b. (a -> b) -> a -> b
$ a -> [Binding]
forall a. ShowFunction a => a -> [Binding]
bindings a
f of
                 []          -> Bool
False -- uninhabited type?
                 (([String]
_,Maybe String
r'):[Binding]
bs) -> (Binding -> Bool) -> [Binding] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\([String]
_,Maybe String
r) -> Maybe String
r Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
r') [Binding]
bs

-- | shows a constant function
showConstant :: ShowFunction a => Int -> a -> String
showConstant :: Int -> a -> String
showConstant Int
m a
f = String
"\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
vs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"undefined" Maybe String
r
  where
  ([String]
as,Maybe String
r) = [Binding] -> Binding
forall a. [a] -> a
head ([Binding] -> Binding) -> [Binding] -> Binding
forall a b. (a -> b) -> a -> b
$ a -> [Binding]
forall a. ShowFunction a => a -> [Binding]
bindings a
f
  vs :: [String]
vs = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
as) String
"_"

-- The first boolean parameter tells if we are showing
-- the function on a single line
showFunctionL :: ShowFunction a => Bool -> Int -> Int -> a -> String
showFunctionL :: Bool -> Int -> Int -> a -> String
showFunctionL Bool
singleLine Int
m Int
n a
f | a -> Bool
forall a. ShowFunction a => a -> Bool
isValue a
f = a -> String
forall a. ShowFunction a => a -> String
showValueOf a
f
showFunctionL Bool
singleLine Int
m Int
n a
f | Int -> a -> Bool
forall a. ShowFunction a => Int -> a -> Bool
isConstant Int
m a
f = Int -> a -> String
forall a. ShowFunction a => Int -> a -> String
showConstant Int
m a
f
--showFunctionL singleLine m n f | canName m f = showName m f
showFunctionL Bool
singleLine Int
m Int
n a
f | Bool
otherwise = String
lambdaPat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
caseExp
  where
    lambdaPat :: String
lambdaPat = String
"\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
vs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> "
    casePat :: String
casePat = String
"case " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showTuple ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"_") [String]
vs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of"
    ([String]
vs, [Binding]
bindings) = Int -> Int -> a -> ([String], [Binding])
forall a.
ShowFunction a =>
Int -> Int -> a -> ([String], [Binding])
clarifiedBindings Int
m Int
n a
f
    bs :: [String]
bs = Bool -> Int -> [Binding] -> [String]
showNBindings ([Binding] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Binding]
bindings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m) Int
n [Binding]
bindings
    sep :: String
sep | Bool
singleLine = String
" "
        | Bool
otherwise = String
"\n"
    cases :: String
cases | Bool
singleLine = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"; " [String]
bs
          | Bool
otherwise  = [String] -> String
unlines
                       ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
lambdaPat) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
`map` [String]
bs
    caseExp :: String
caseExp = if Int -> a -> Bool
forall a. ShowFunction a => Int -> a -> Bool
isUndefined Int
m a
f
                then String
"undefined"
                else String
casePat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sep String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cases

-- instances for further tuple arities --
instance (Show a, Show b, Show c)
      => ShowFunction (a,b,c) where bindtiers :: (a, b, c) -> [[Binding]]
bindtiers = (a, b, c) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance (Show a, Show b, Show c, Show d)
      => ShowFunction (a,b,c,d) where bindtiers :: (a, b, c, d) -> [[Binding]]
bindtiers = (a, b, c, d) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance (Show a, Show b, Show c, Show d, Show e)
      => ShowFunction (a,b,c,d,e) where bindtiers :: (a, b, c, d, e) -> [[Binding]]
bindtiers = (a, b, c, d, e) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
#ifndef __HUGS__
instance (Show a, Show b, Show c, Show d, Show e, Show f)
      => ShowFunction (a,b,c,d,e,f) where bindtiers :: (a, b, c, d, e, f) -> [[Binding]]
bindtiers = (a, b, c, d, e, f) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)
      => ShowFunction (a,b,c,d,e,f,g) where bindtiers :: (a, b, c, d, e, f, g) -> [[Binding]]
bindtiers = (a, b, c, d, e, f, g) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)
      => ShowFunction (a,b,c,d,e,f,g,h) where bindtiers :: (a, b, c, d, e, f, g, h) -> [[Binding]]
bindtiers = (a, b, c, d, e, f, g, h) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ( Show a, Show b, Show c, Show d
         , Show e, Show f, Show g, Show h
         , Show i )
      => ShowFunction (a,b,c,d,e,f,g,h,i) where bindtiers :: (a, b, c, d, e, f, g, h, i) -> [[Binding]]
bindtiers = (a, b, c, d, e, f, g, h, i) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ( Show a, Show b, Show c, Show d
         , Show e, Show f, Show g, Show h
         , Show i, Show j )
      => ShowFunction (a,b,c,d,e,f,g,h,i,j) where bindtiers :: (a, b, c, d, e, f, g, h, i, j) -> [[Binding]]
bindtiers = (a, b, c, d, e, f, g, h, i, j) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ( Show a, Show b, Show c, Show d
         , Show e, Show f, Show g, Show h
         , Show i, Show j, Show k )
      => ShowFunction (a,b,c,d,e,f,g,h,i,j,k) where bindtiers :: (a, b, c, d, e, f, g, h, i, j, k) -> [[Binding]]
bindtiers = (a, b, c, d, e, f, g, h, i, j, k) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ( Show a, Show b, Show c, Show d
         , Show e, Show f, Show g, Show h
         , Show i, Show j, Show k, Show l )
      => ShowFunction (a,b,c,d,e,f,g,h,i,j,k,l) where bindtiers :: (a, b, c, d, e, f, g, h, i, j, k, l) -> [[Binding]]
bindtiers = (a, b, c, d, e, f, g, h, i, j, k, l) -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
#endif

-- Data.Ratio
instance (Integral a, Show a) => ShowFunction (Ratio a) where bindtiers :: Ratio a -> [[Binding]]
bindtiers = Ratio a -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

-- Data.Complex
instance (RealFloat a, Show a) => ShowFunction (Complex a) where bindtiers :: Complex a -> [[Binding]]
bindtiers = Complex a -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

-- instance for types from Data.Int and Data.Word
instance ShowFunction Int8  where bindtiers :: Int8 -> [[Binding]]
bindtiers = Int8 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Int16 where bindtiers :: Int16 -> [[Binding]]
bindtiers = Int16 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Int32 where bindtiers :: Int32 -> [[Binding]]
bindtiers = Int32 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Int64 where bindtiers :: Int64 -> [[Binding]]
bindtiers = Int64 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Word8  where bindtiers :: Word8 -> [[Binding]]
bindtiers = Word8 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Word16 where bindtiers :: Word16 -> [[Binding]]
bindtiers = Word16 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Word32 where bindtiers :: Word32 -> [[Binding]]
bindtiers = Word32 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Word64 where bindtiers :: Word64 -> [[Binding]]
bindtiers = Word64 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

-- instance for types from Test.LeanCheck.Utils.Types
instance ShowFunction Nat   where bindtiers :: Nat -> [[Binding]]
bindtiers = Nat -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Nat1  where bindtiers :: Nat1 -> [[Binding]]
bindtiers = Nat1 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Nat2  where bindtiers :: Nat2 -> [[Binding]]
bindtiers = Nat2 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Nat3  where bindtiers :: Nat3 -> [[Binding]]
bindtiers = Nat3 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Nat4  where bindtiers :: Nat4 -> [[Binding]]
bindtiers = Nat4 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Nat5  where bindtiers :: Nat5 -> [[Binding]]
bindtiers = Nat5 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Nat6  where bindtiers :: Nat6 -> [[Binding]]
bindtiers = Nat6 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Nat7  where bindtiers :: Nat7 -> [[Binding]]
bindtiers = Nat7 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Int1  where bindtiers :: Int1 -> [[Binding]]
bindtiers = Int1 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Int2  where bindtiers :: Int2 -> [[Binding]]
bindtiers = Int2 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Int3  where bindtiers :: Int3 -> [[Binding]]
bindtiers = Int3 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Int4  where bindtiers :: Int4 -> [[Binding]]
bindtiers = Int4 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Word1 where bindtiers :: Word1 -> [[Binding]]
bindtiers = Word1 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Word2 where bindtiers :: Word2 -> [[Binding]]
bindtiers = Word2 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Word3 where bindtiers :: Word3 -> [[Binding]]
bindtiers = Word3 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Word4 where bindtiers :: Word4 -> [[Binding]]
bindtiers = Word4 -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

instance ShowFunction Natural where bindtiers :: Natural -> [[Binding]]
bindtiers = Natural -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

instance ShowFunction Letter    where bindtiers :: Letter -> [[Binding]]
bindtiers = Letter -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction AlphaNum  where bindtiers :: AlphaNum -> [[Binding]]
bindtiers = AlphaNum -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Digit     where bindtiers :: Digit -> [[Binding]]
bindtiers = Digit -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Alpha     where bindtiers :: Alpha -> [[Binding]]
bindtiers = Alpha -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Upper     where bindtiers :: Upper -> [[Binding]]
bindtiers = Upper -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Lower     where bindtiers :: Lower -> [[Binding]]
bindtiers = Lower -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Space     where bindtiers :: Space -> [[Binding]]
bindtiers = Space -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

instance ShowFunction Spaces    where bindtiers :: Spaces -> [[Binding]]
bindtiers = Spaces -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Lowers    where bindtiers :: Lowers -> [[Binding]]
bindtiers = Lowers -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Uppers    where bindtiers :: Uppers -> [[Binding]]
bindtiers = Uppers -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Alphas    where bindtiers :: Alphas -> [[Binding]]
bindtiers = Alphas -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Digits    where bindtiers :: Digits -> [[Binding]]
bindtiers = Digits -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction AlphaNums where bindtiers :: AlphaNums -> [[Binding]]
bindtiers = AlphaNums -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction Letters   where bindtiers :: Letters -> [[Binding]]
bindtiers = Letters -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

instance Show a => ShowFunction (X a) where bindtiers :: X a -> [[Binding]]
bindtiers = X a -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance Show a => ShowFunction (Xs a) where bindtiers :: Xs a -> [[Binding]]
bindtiers = Xs a -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance Show a => ShowFunction (Set a) where bindtiers :: Set a -> [[Binding]]
bindtiers = Set a -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance Show a => ShowFunction (Bag a) where bindtiers :: Bag a -> [[Binding]]
bindtiers = Bag a -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance Show a => ShowFunction (NoDup a) where bindtiers :: NoDup a -> [[Binding]]
bindtiers = NoDup a -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance (Show a, Show b) => ShowFunction (Map a b) where bindtiers :: Map a b -> [[Binding]]
bindtiers = Map a b -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

-- misc instances
instance ShowFunction ExitCode   where bindtiers :: ExitCode -> [[Binding]]
bindtiers = ExitCode -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction SeekMode   where bindtiers :: SeekMode -> [[Binding]]
bindtiers = SeekMode -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction IOMode     where bindtiers :: IOMode -> [[Binding]]
bindtiers = IOMode -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction BufferMode where bindtiers :: BufferMode -> [[Binding]]
bindtiers = BufferMode -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction GeneralCategory where bindtiers :: GeneralCategory -> [[Binding]]
bindtiers = GeneralCategory -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow

-- instances for Foreign.C types
instance ShowFunction CChar      where bindtiers :: CChar -> [[Binding]]
bindtiers = CChar -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CSChar     where bindtiers :: CSChar -> [[Binding]]
bindtiers = CSChar -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CUChar     where bindtiers :: CUChar -> [[Binding]]
bindtiers = CUChar -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CShort     where bindtiers :: CShort -> [[Binding]]
bindtiers = CShort -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CUShort    where bindtiers :: CUShort -> [[Binding]]
bindtiers = CUShort -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CInt       where bindtiers :: CInt -> [[Binding]]
bindtiers = CInt -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CUInt      where bindtiers :: CUInt -> [[Binding]]
bindtiers = CUInt -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CLong      where bindtiers :: CLong -> [[Binding]]
bindtiers = CLong -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CULong     where bindtiers :: CULong -> [[Binding]]
bindtiers = CULong -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CPtrdiff   where bindtiers :: CPtrdiff -> [[Binding]]
bindtiers = CPtrdiff -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CSize      where bindtiers :: CSize -> [[Binding]]
bindtiers = CSize -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CWchar     where bindtiers :: CWchar -> [[Binding]]
bindtiers = CWchar -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CSigAtomic where bindtiers :: CSigAtomic -> [[Binding]]
bindtiers = CSigAtomic -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CLLong     where bindtiers :: CLLong -> [[Binding]]
bindtiers = CLLong -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CULLong    where bindtiers :: CULLong -> [[Binding]]
bindtiers = CULLong -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CIntPtr    where bindtiers :: CIntPtr -> [[Binding]]
bindtiers = CIntPtr -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CUIntPtr   where bindtiers :: CUIntPtr -> [[Binding]]
bindtiers = CUIntPtr -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CIntMax    where bindtiers :: CIntMax -> [[Binding]]
bindtiers = CIntMax -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CUIntMax   where bindtiers :: CUIntMax -> [[Binding]]
bindtiers = CUIntMax -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CClock     where bindtiers :: CClock -> [[Binding]]
bindtiers = CClock -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CTime      where bindtiers :: CTime -> [[Binding]]
bindtiers = CTime -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CFloat     where bindtiers :: CFloat -> [[Binding]]
bindtiers = CFloat -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CDouble    where bindtiers :: CDouble -> [[Binding]]
bindtiers = CDouble -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
#if __GLASGOW_HASKELL__ >= 802
instance ShowFunction CBool      where bindtiers :: CBool -> [[Binding]]
bindtiers = CBool -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
#endif
#if __GLASGOW_HASKELL__
instance ShowFunction CUSeconds  where bindtiers :: CUSeconds -> [[Binding]]
bindtiers = CUSeconds -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
instance ShowFunction CSUSeconds where bindtiers :: CSUSeconds -> [[Binding]]
bindtiers = CSUSeconds -> [[Binding]]
forall a. Show a => a -> [[Binding]]
bindtiersShow
#endif

-- | Returns a set of variables and a set of bindings
--   describing how a function works.
--
-- Some argument values are generalized to "@_@" when possible.
-- If one of the function arguments is not used altogether, it is ommited in
-- the set of bindings and appears as "_" in the variables list.
--
-- This is the /last/ function in the clarification pipeline.
--
-- It takes two integer arguments:
--
-- 1. @m@: the maximum number of cases considered for computing the description;
-- 2. @n@: the maximum number of cases in the actual description.
--
-- As a general rule of thumb, set @m=n*n+1@.
--
-- Some examples follow:
--
-- * When all arguments are used, the result is the same as 'describedBindings':
--
--     > > clarifiedBindings 100 10 (==1)
--     > ( ["x"], [ (["1"],Just "True"),
--     >          , (["_"],Just "False") ] )
--
-- * When some arguments are unused, they are omitted in the list of bindings and
--   appear as @"_"@ in the list of variables.
--
--     > > clarifiedBindings 100 10 (\_ y -> y == 1)
--     > ( ["_", "y"], [ (["1"],Just "True")
--     >               , (["_"],Just "False") ] )
clarifiedBindings :: ShowFunction a => Int -> Int -> a -> ([String],[Binding])
clarifiedBindings :: Int -> Int -> a -> ([String], [Binding])
clarifiedBindings Int
m Int
n = [Binding] -> ([String], [Binding])
clarifyBindings ([Binding] -> ([String], [Binding]))
-> (a -> [Binding]) -> a -> ([String], [Binding])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> [Binding]
forall a. ShowFunction a => Int -> Int -> a -> [Binding]
describedBindings Int
m Int
n

clarifyBindings :: [Binding] -> ([String],[Binding])
clarifyBindings :: [Binding] -> ([String], [Binding])
clarifyBindings [Binding]
bs  =  ([Bool] -> [String]
varnamesByUsage [Bool]
used, (Binding -> Binding) -> [Binding] -> [Binding]
forall a b. (a -> b) -> [a] -> [b]
map (([String] -> [String]) -> Binding -> Binding
forall t a b. (t -> a) -> (t, b) -> (a, b)
mapFst (([String] -> [String]) -> Binding -> Binding)
-> ([String] -> [String]) -> Binding -> Binding
forall a b. (a -> b) -> a -> b
$ [Bool] -> [String] -> [String]
forall a. [Bool] -> [a] -> [a]
select [Bool]
used) [Binding]
bs)
  where
  mapFst :: (t -> a) -> (t, b) -> (a, b)
mapFst t -> a
f (t
x,b
y) = (t -> a
f t
x, b
y)
  used :: [Bool]
used = [Binding] -> [Bool]
usedArgs [Binding]
bs

varnamesByUsage :: [Bool] -> [String]
varnamesByUsage :: [Bool] -> [String]
varnamesByUsage = (String -> Bool -> String) -> [String] -> [Bool] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Bool -> String
used [String]
varnames
  where
  used :: String -> Bool -> String
used String
s Bool
False = String
"_"
  used String
s Bool
True  = String
s
  varnames :: [String]
varnames = [String
"x",String
"y",String
"z",String
"w"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'") [String]
varnames

usedArgs :: [Binding] -> [Bool]
usedArgs :: [Binding] -> [Bool]
usedArgs = ([Bool] -> [Bool] -> [Bool]) -> [[Bool]] -> [Bool]
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ((Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(||))
         ([[Bool]] -> [Bool])
-> ([Binding] -> [[Bool]]) -> [Binding] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binding -> [Bool]) -> [Binding] -> [[Bool]]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"_") ([String] -> [Bool]) -> (Binding -> [String]) -> Binding -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binding -> [String]
forall a b. (a, b) -> a
fst)

-- | Returns a set of bindings describing how a function works.
-- Some argument values are generalized to "@_@" when possible.
-- It takes two integer arguments:
--
-- 1. @m@: the maximum number of cases considered for computing description;
-- 2. @n@: the maximum number of cases in the actual description.
--
-- As a general rule of thumb, set @m=n*n+1@.
--
-- This is the /second/ function in the clarification pipeline.
--
-- This function processes the result of 'explainedBindings'
-- to sometimes return shorter descriptions.
-- It chooses the shortest of the following (in order):
--
-- * regular unexplained-undescribed 'bindings';
-- * regular 'explainedBindings';
-- * 'explainedBindings' with least occurring cases generalized first;
--
-- Here are some examples:
--
-- * Sometimes the result is the same as 'explainedBindings':
--
--     > > describedBindings 100 10 (||)
--     > [ (["False","False"],Just "False")
--     > , (["_","_"],Just "True") ]
--
--     > > describedBindings 100 10 (==0)
--     > [ (["0"],Just "True")
--     > , (["_"],Just "False") ]
--
-- * but sometimes it is shorter because we consider generalizing least
--   occurring cases first:
--
--     > > describedBindings 100 10 (&&)
--     > [ ( ["True","True"],Just "True")
--     > , ( ["_","_"],Just "False") ]
--
--     > > describedBindings 100 10 (==1)
--     > [ (["1"],Just "True"),
--     > , (["_"],Just "False") ]
--
--     > > describedBindings 100 10 (\_ y -> y == 1)
--     > [ (["_","1"],Just "True")
--     > , (["_","_"],Just "False") ]
describedBindings :: ShowFunction a => Int -> Int -> a -> [Binding]
describedBindings :: Int -> Int -> a -> [Binding]
describedBindings Int
m Int
n a
f
  | [Binding] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Binding]
bs1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n  =  [Binding]
bs1
  | Bool
otherwise        =  [Binding]
bs0
  where
  bs0 :: [Binding]
bs0  =  Int -> [Binding] -> [Binding]
forall a. Int -> [a] -> [a]
take Int
m ([Binding] -> [Binding]) -> [Binding] -> [Binding]
forall a b. (a -> b) -> a -> b
$ a -> [Binding]
forall a. ShowFunction a => a -> [Binding]
bindings a
f
  bs1 :: [Binding]
bs1  =  [Binding] -> [Binding]
describeBindings [Binding]
bs0

describeBindings :: [Binding] -> [Binding]
describeBindings :: [Binding] -> [Binding]
describeBindings [Binding]
bs = [[Binding]] -> [Binding]
forall a. [a] -> a
head ([[Binding]] -> [Binding]) -> [[Binding]] -> [Binding]
forall a b. (a -> b) -> a -> b
$ ([Binding] -> Int) -> [[Binding]] -> [[Binding]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn [Binding] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Binding]] -> [[Binding]]) -> [[Binding]] -> [[Binding]]
forall a b. (a -> b) -> a -> b
$
  [ [Binding]
bs
  , [Binding] -> [Binding]
explainBindings [Binding]
bs
  , [Binding] -> [Binding]
explainBindings ([Binding] -> [Binding])
-> ([[Binding]] -> [Binding]) -> [[Binding]] -> [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Binding]] -> [Binding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Binding]] -> [Binding])
-> ([[Binding]] -> [[Binding]]) -> [[Binding]] -> [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Binding] -> Int) -> [[Binding]] -> [[Binding]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn [Binding] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Binding]] -> [Binding]) -> [[Binding]] -> [Binding]
forall a b. (a -> b) -> a -> b
$ (Binding -> Maybe String) -> [Binding] -> [[Binding]]
forall b a. Eq b => (a -> b) -> [a] -> [[a]]
classifyOn Binding -> Maybe String
forall a b. (a, b) -> b
snd [Binding]
bs
  ]

-- | Returns a set of bindings explaining how a function works.
--   Some argument values are generalized to "@_@" when possible.
--   It takes as argument the maximum number of cases
--   considered for computing the explanation.
--
-- A measure of success in this generalization process is if this function
-- returns less values than the asked maximum number of cases.
--
-- This is the /first/ function in the clarification pipeline.
--
-- * In some cases, 'bindings' cannot be "explained"
--   an almost unchanged result of 'bindings' is returned
--   with the last binding having variables replaced by "@_@":
--
--     > > explainedBindings 4 (id::Int->Int)
--     > [ (["0"],Just "0")
--     > , (["1"],Just "1")
--     > , (["-1"],Just "-1")
--     > , (["_"],Just "2") ]
--
-- * When possible, some cases are generalized using @_@:
--
--     > > explainedBindings 10 (||)
--     > [ (["False","False"],Just "False")
--     > , (["_","_"],Just "True") ]
--
--     but the resulting "explanation" might not be the shortest possible
--     (cf. 'describedBindings'):
--
--     > > explainedBindings 10 (&&)
--     > [ ( ["False","_"],Just "False")
--     > , (["_","False"],Just "False")
--     > , (["_","_"],Just "True") ]
--
-- * Generalization works for infinite domains (heuristically):
--
--     > > explainedBindings 10 (==0)
--     > [ (["0"],Just "True")
--     > , (["_"],Just "False") ]
--
-- * Generalization for each item is processed in the order they are generated by 'bindings'
--   hence explanations are not always the shortest possible (cf. 'describedBindings').
--   In the following examples, the first case is redundant.
--
--     > > explainedBindings 10 (==1)
--     > [ (["0"],Just "False")
--     > , (["1"],Just "True"),
--     > , (["_"],Just "False") ]
--
--     > > explainedBindings 10 (\_ y -> y == 1)
--     > [ (["_","0"],Just "False")
--     > , (["_","1"],Just "True")
--     > , (["_","_"],Just "False") ]
explainedBindings :: ShowFunction a => Int -> a -> [Binding]
explainedBindings :: Int -> a -> [Binding]
explainedBindings Int
m = [Binding] -> [Binding]
explainBindings ([Binding] -> [Binding]) -> (a -> [Binding]) -> a -> [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Binding] -> [Binding]
forall a. Int -> [a] -> [a]
take Int
m ([Binding] -> [Binding]) -> (a -> [Binding]) -> a -> [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Binding]
forall a. ShowFunction a => a -> [Binding]
bindings

explainBindings :: [Binding] -> [Binding]
explainBindings :: [Binding] -> [Binding]
explainBindings = [Binding] -> [Binding] -> [Binding]
explain []
  where
  explain :: [Binding] -> [Binding] -> [Binding]
  explain :: [Binding] -> [Binding] -> [Binding]
explain [Binding]
bs' []           =  [Binding] -> [Binding]
forall a. [a] -> [a]
reverse [Binding]
bs'
  explain [Binding]
bs' (([String]
as,Maybe String
r):[Binding]
bs)  =  [Binding] -> [Binding] -> [Binding]
explain ([Binding]
bs''[Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
++[Binding]
bs') [Binding
b | Binding
b <- [Binding]
bs, (Binding -> Bool) -> [Binding] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
none (Binding
b Binding -> Binding -> Bool
<~~) [Binding]
bs'']
    where
    bs'' :: [Binding]
bs'' = (Binding -> Binding -> Bool) -> [Binding] -> [Binding]
forall a. (a -> a -> Bool) -> [a] -> [a]
discardLater Binding -> Binding -> Bool
(<~~)
         [ ([String]
gas,Maybe String
r) | [String]
gas <- [String] -> [[String]]
generalizations [String]
as
                   , [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Maybe String
r' Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
r | ([String]
as',Maybe String
r') <- [Binding]
bs, [String]
as' [String] -> [String] -> Bool
<~ [String]
gas] ]

generalizations :: [String] -> [[String]]
generalizations :: [String] -> [[String]]
generalizations []     = [[]]
generalizations (String
v:[String]
vs) = ([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (String
"_"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) [[String]]
gvs [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (String
vString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) [[String]]
gvs
  where
  gvs :: [[String]]
gvs = [String] -> [[String]]
generalizations [String]
vs

-- | Should be read as "is generalized by":
--
-- > > ["1","2","3"] <~ ["_","_","_"]
-- > True
-- > > ["_","_","_"] <~ ["1","2","3"]
-- > False
-- > > ["1","3"] <~ ["_","3"]
-- > True
-- > > ["_","3"] <~ ["_","4"]
-- > False
(<~) :: [String] -> [String] -> Bool
[]     <~ :: [String] -> [String] -> Bool
<~ []       =  Bool
True
(String
v:[String]
vs) <~ (String
"_":[String]
ws) =  [String]
vs [String] -> [String] -> Bool
<~ [String]
ws
(String
v:[String]
vs) <~ (String
w:[String]
ws)   =  String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
w Bool -> Bool -> Bool
&& [String]
vs [String] -> [String] -> Bool
<~ [String]
ws
[String]
_      <~ [String]
_        =  Bool
False

-- | Should be read as "is generalized by".
(<~~) :: Binding -> Binding -> Bool
([String]
as,Maybe String
r) <~~ :: Binding -> Binding -> Bool
<~~ ([String]
as',Maybe String
r') = [String]
as [String] -> [String] -> Bool
<~ [String]
as' Bool -> Bool -> Bool
&& Maybe String
r Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
r'


-- general auxiliary functions

discard :: (a -> Bool) -> [a] -> [a]
discard :: (a -> Bool) -> [a] -> [a]
discard a -> Bool
p = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

discardLater :: (a -> a -> Bool) -> [a] -> [a]
discardLater :: (a -> a -> Bool) -> [a] -> [a]
discardLater a -> a -> Bool
(?>) = [a] -> [a]
dl
  where
  dl :: [a] -> [a]
dl []     = []
  dl (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
discard (a -> a -> Bool
?> a
x) ([a] -> [a]
dl [a]
xs)

none :: (a -> Bool) -> [a] -> Bool
none :: (a -> Bool) -> [a] -> Bool
none a -> Bool
p = Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
p

-- sortOn is only available on GHC > 7.8
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn :: (a -> b) -> [a] -> [a]
sortOn a -> b
f = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)

select :: [Bool] -> [a] -> [a]
select :: [Bool] -> [a] -> [a]
select [] [a]
_ = []
select [Bool]
_ [] = []
select (Bool
p:[Bool]
ps) (a
x:[a]
xs) = if Bool
p then a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs' else [a]
xs' where xs' :: [a]
xs' = [Bool] -> [a] -> [a]
forall a. [Bool] -> [a] -> [a]
select [Bool]
ps [a]
xs