<commit_before>module Test.Speculate
  ( report

  , Args (..)
  , args
  , speculate
  , getArgs

  , module Test.Speculate.Expr
  , module Test.Speculate.Engine
  , module Test.LeanCheck.Utils
  , module Test.LeanCheck

  , module Data.Typeable
  )
where

import Data.Typeable
import Data.Dynamic
import Data.Maybe
import Data.List hiding (insert)
import qualified Data.List as L
import Data.Function
import Control.Monad
import Test.LeanCheck
import Test.LeanCheck.Utils hiding (comparison)
import Test.LeanCheck.Tiers (unorderedPairsWith)
import Test.Speculate.Utils
import Test.Speculate.Utils.Colour
import Data.Ratio ((%))

import System.Console.CmdArgs.Explicit

import Test.Speculate.Expr
import Test.Speculate.Reason
import Test.Speculate.CondReason
import Test.Speculate.SemiReason
import Test.Speculate.Engine

data Args = Args
  { maxSize              :: Int
  , maxTests             :: Int
  , maxSemiSize          :: Int
  , maxCondSize          :: Int
  , customTypeInfo       :: [TypeInfo]
  , showConstants        :: Bool
  , showTheory           :: Bool
  , showEquivalences     :: Bool
  , showSemiequivalences :: Bool
  , showConditions       :: Bool
  , showConstantLaws     :: Bool
  , showDot              :: Bool
  , quietDot             :: Bool
  , showClassesFor       :: [Int]
  , maxVars              :: Int
  , maxConstants         :: Maybe Int
  , evalTimeout          :: Maybe Double
--, closureLimit         :: Int
--, order                :: OptOrder  -- data OptOrder = Dershowitz | KnuthBendix
--, maxRuleSize          :: Maybe Int
--, maxEquationSize      :: Maybe Int
--, keepRewriteRules     :: Bool
  , showHelp             :: Bool
  , extra                :: [String] -- unused, user-defined meaning
  , backgroundConstants  :: [Expr] -- ^ background constants
  , constants            :: [Expr] -- ^ constants used on both conditions and equations
  , conditionConstants   :: [Expr] -- ^ constants exclusive to conditions
  , equationConstants    :: [Expr] -- ^ constants exclusive to equations
  }
-- Maybe add an empty Thy here.

args = Args
  { maxSize              = 5
  , maxTests             = 500
  , maxSemiSize          = -2
  , maxCondSize          = -1
  , customTypeInfo       = []
  , showConstants        = True
  , showTheory           = False
  , showEquivalences     = True
  , showSemiequivalences = True
  , showConditions       = True
  , showConstantLaws     = False
  , showDot              = False
  , quietDot             = False
  , showClassesFor       = []
  , maxVars              = 2
  , maxConstants         = Nothing
  , evalTimeout          = Nothing
--, closureLimit         = 2
--, order                = Dershowitz
--, maxRuleSize          = Nothing
--, maxEquationSize      = Nothing
--, keepRewriteRules     = False
  , showHelp             = False
  , extra                = []
  , backgroundConstants  = []
  , constants            = []
  , conditionConstants   = []
  , equationConstants    = []
  }

computeMaxSemiSize :: Args -> Int
computeMaxSemiSize args
  | maxSemiSize args > 0 = maxSemiSize args
  | otherwise            = maxSize args + maxSemiSize args

computeMaxCondSize :: Args -> Int
computeMaxCondSize args
  | maxCondSize args > 0 = maxCondSize args
  | otherwise            = maxSize args + maxCondSize args

shouldShow2 :: Args -> (Expr,Expr) -> Bool
shouldShow2 args (e1,e2) = showConstantLaws args || hasVar e1 || hasVar e2
-- `allAbout` constants // (conditionAtoms `union` equationAtoms)

shouldShowEquation :: Args -> (Expr,Expr) -> Bool
shouldShowEquation args (e1,e2) =
  shouldShow2 args (e1,e2) && (e1 `about` ea || e2 `about` ea)
  where
  ea = equationConstants args
    ++ ((constants args \\ conditionConstants args) \\ backgroundConstants args)

shouldShow3 :: Args -> (Expr,Expr,Expr) -> Bool
shouldShow3 args (e1,e2,e3) = showConstantLaws args
                           || hasVar e1 || hasVar e2 || hasVar e3

shouldShowConditionalEquation :: Args -> (Expr,Expr,Expr) -> Bool
shouldShowConditionalEquation args (ce,e1,e2) = shouldShow3 args (ce,e1,e2)
                                             && (ce `about` ca
                                              || e1 `about` ea
                                              || e2 `about` ea)
  where
  ca = conditionConstants args ++ ((constants args \\ equationConstants args)  \\ backgroundConstants args)
  ea = equationConstants args  ++ ((constants args \\ conditionConstants args) \\ backgroundConstants args)

keepExpr :: Args -> Expr -> Bool
keepExpr (Args {maxConstants = Nothing}) e = True
keepExpr (Args {maxConstants = Just n})  e = length (consts e) <= n

-- | Are all constants in an expression about a list of constants?
-- Examples in pseudo-Haskell:
--
-- > x + y `allAbout` [(+)] == True
-- > x + y == z `allAbout` [(+)] == False
-- > x + y == z `allAbout` [(+),(==)] == True
allAbout :: Expr -> [Expr] -> Bool
e `allAbout` es = atomicConstants e `areAll` (`elem` es)

about :: Expr -> [Expr] -> Bool
e `about` es = atomicConstants e `areAny` (`elem` es)

notAbout :: Expr -> [Expr] -> Bool
notAbout = not .: about

timeout :: Args -> Bool -> Bool
timeout Args{evalTimeout = Nothing} = id
timeout Args{evalTimeout = Just t}  = timeoutToFalse t

report :: Args -> IO ()
report args@Args {maxSize = sz, maxTests = n} = do
  let ti = concat (customTypeInfo args) ++ basicTypeInfo
  let ds = constants args `union` backgroundConstants args `union` conditionConstants args `union` equationConstants args
  let (ts,uts) = partition (existsInfo ti) $ nubMergeMap (typesIn . typ) ds<commit_msg>Add and use computeTypeInfo on Test.Speculate<commit_after>module Test.Speculate
  ( report

  , Args (..)
  , args
  , speculate
  , getArgs

  , module Test.Speculate.Expr
  , module Test.Speculate.Engine
  , module Test.LeanCheck.Utils
  , module Test.LeanCheck

  , module Data.Typeable
  )
where

import Data.Typeable
import Data.Dynamic
import Data.Maybe
import Data.List hiding (insert)
import qualified Data.List as L
import Data.Function
import Control.Monad
import Test.LeanCheck
import Test.LeanCheck.Utils hiding (comparison)
import Test.LeanCheck.Tiers (unorderedPairsWith)
import Test.Speculate.Utils
import Test.Speculate.Utils.Colour
import Data.Ratio ((%))

import System.Console.CmdArgs.Explicit

import Test.Speculate.Expr
import Test.Speculate.Reason
import Test.Speculate.CondReason
import Test.Speculate.SemiReason
import Test.Speculate.Engine

data Args = Args
  { maxSize              :: Int
  , maxTests             :: Int
  , maxSemiSize          :: Int
  , maxCondSize          :: Int
  , customTypeInfo       :: [TypeInfo]
  , showConstants        :: Bool
  , showTheory           :: Bool
  , showEquivalences     :: Bool
  , showSemiequivalences :: Bool
  , showConditions       :: Bool
  , showConstantLaws     :: Bool
  , showDot              :: Bool
  , quietDot             :: Bool
  , showClassesFor       :: [Int]
  , maxVars              :: Int
  , maxConstants         :: Maybe Int
  , evalTimeout          :: Maybe Double
--, closureLimit         :: Int
--, order                :: OptOrder  -- data OptOrder = Dershowitz | KnuthBendix
--, maxRuleSize          :: Maybe Int
--, maxEquationSize      :: Maybe Int
--, keepRewriteRules     :: Bool
  , showHelp             :: Bool
  , extra                :: [String] -- unused, user-defined meaning
  , backgroundConstants  :: [Expr] -- ^ background constants
  , constants            :: [Expr] -- ^ constants used on both conditions and equations
  , conditionConstants   :: [Expr] -- ^ constants exclusive to conditions
  , equationConstants    :: [Expr] -- ^ constants exclusive to equations
  }
-- Maybe add an empty Thy here.

args = Args
  { maxSize              = 5
  , maxTests             = 500
  , maxSemiSize          = -2
  , maxCondSize          = -1
  , customTypeInfo       = []
  , showConstants        = True
  , showTheory           = False
  , showEquivalences     = True
  , showSemiequivalences = True
  , showConditions       = True
  , showConstantLaws     = False
  , showDot              = False
  , quietDot             = False
  , showClassesFor       = []
  , maxVars              = 2
  , maxConstants         = Nothing
  , evalTimeout          = Nothing
--, closureLimit         = 2
--, order                = Dershowitz
--, maxRuleSize          = Nothing
--, maxEquationSize      = Nothing
--, keepRewriteRules     = False
  , showHelp             = False
  , extra                = []
  , backgroundConstants  = []
  , constants            = []
  , conditionConstants   = []
  , equationConstants    = []
  }

computeMaxSemiSize :: Args -> Int
computeMaxSemiSize args
  | maxSemiSize args > 0 = maxSemiSize args
  | otherwise            = maxSize args + maxSemiSize args

computeMaxCondSize :: Args -> Int
computeMaxCondSize args
  | maxCondSize args > 0 = maxCondSize args
  | otherwise            = maxSize args + maxCondSize args

computeTypeInfo :: Args -> TypeInfo
computeTypeInfo args = concat (customTypeInfo args) ++ basicTypeInfo

shouldShow2 :: Args -> (Expr,Expr) -> Bool
shouldShow2 args (e1,e2) = showConstantLaws args || hasVar e1 || hasVar e2
-- `allAbout` constants // (conditionAtoms `union` equationAtoms)

shouldShowEquation :: Args -> (Expr,Expr) -> Bool
shouldShowEquation args (e1,e2) =
  shouldShow2 args (e1,e2) && (e1 `about` ea || e2 `about` ea)
  where
  ea = equationConstants args
    ++ ((constants args \\ conditionConstants args) \\ backgroundConstants args)

shouldShow3 :: Args -> (Expr,Expr,Expr) -> Bool
shouldShow3 args (e1,e2,e3) = showConstantLaws args
                           || hasVar e1 || hasVar e2 || hasVar e3

shouldShowConditionalEquation :: Args -> (Expr,Expr,Expr) -> Bool
shouldShowConditionalEquation args (ce,e1,e2) = shouldShow3 args (ce,e1,e2)
                                             && (ce `about` ca
                                              || e1 `about` ea
                                              || e2 `about` ea)
  where
  ca = conditionConstants args ++ ((constants args \\ equationConstants args)  \\ backgroundConstants args)
  ea = equationConstants args  ++ ((constants args \\ conditionConstants args) \\ backgroundConstants args)

keepExpr :: Args -> Expr -> Bool
keepExpr (Args {maxConstants = Nothing}) e = True
keepExpr (Args {maxConstants = Just n})  e = length (consts e) <= n

-- | Are all constants in an expression about a list of constants?
-- Examples in pseudo-Haskell:
--
-- > x + y `allAbout` [(+)] == True
-- > x + y == z `allAbout` [(+)] == False
-- > x + y == z `allAbout` [(+),(==)] == True
allAbout :: Expr -> [Expr] -> Bool
e `allAbout` es = atomicConstants e `areAll` (`elem` es)

about :: Expr -> [Expr] -> Bool
e `about` es = atomicConstants e `areAny` (`elem` es)

notAbout :: Expr -> [Expr] -> Bool
notAbout = not .: about

timeout :: Args -> Bool -> Bool
timeout Args{evalTimeout = Nothing} = id
timeout Args{evalTimeout = Just t}  = timeoutToFalse t

report :: Args -> IO ()
report args@Args {maxSize = sz, maxTests = n} = do
  let ti = computeTypeInfo args
  let ds = constants args `union` backgroundConstants args `union` conditionConstants args `union` equationConstants args
  let (ts,uts) = partition (existsInfo ti) $ nubMergeMap (typesIn . typ) ds
{'fraction_non_alphanumeric': 0.11072602861459166, 'fraction_numerical': 0.006753754554341064, 'mean_word_length': 2.3424413424413424, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 56, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '474360', 'n_tokens_mistral': 3301, 'n_tokens_neox': 3239, 'n_words': 943}