-- |
-- Module      : Conjure.Settings
-- Copyright   : (c) 2021-2025 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- An internal module of "Conjure",
-- a library for Conjuring function implementations
-- from tests or partial definitions.
-- (a.k.a.: functional inductive programming)
--
-- This contains the settings for functions in "Conjure.Engine".
{-# LANGUAGE CPP, RecordWildCards, TupleSections #-}
module Conjure.Settings
  (
  -- * Basic settings
    maxTests
  , maxSize
  , target

  -- * Advanced settings
  , maxRecursions
  , maxEquationSize
  , maxSearchTests
  , maxDeconstructionSize
  , maxConstantSize
  , maxPatternSize
  , maxPatternDepth

  -- * Debug options
  , showCandidates
  , showTheory
  , singlePattern
  , showTests
  , showPatterns
  , showDeconstructions
  , carryOn

  -- * Pruning options
  , dontRewrite
  , dontRequireDescent
  , omitAssortedPruning
  , omitEarlyTests
  , dontCopyBindings
  , nonAtomicNumbers
  , uniqueCandidates

  -- * Filtering settings
  , actual

  -- * Read basic settings
  , maxTestsI
  , targetAndMaxSizeI

  -- * Read advanced settings
  , maxRecursionsI
  , maxEquationSizeI
  , maxSearchTestsI
  , maxDeconstructionSizeI
  , maxConstantSizeI
  , maxPatternSizeI
  , maxPatternDepthI

  -- * Read debug options
  , showCandidatesI
  , showTheoryI
  , singlePatternI
  , showTestsI
  , showPatternsI
  , showDeconstructionsI
  , carryOnI

  -- * Read pruning options
  , rewriteI
  , requireDescentI
  , assortedPruningI
  , earlyTestsI
  , copyBindingsI
  , atomicNumbersI
  , uniqueCandidatesI
  )
where


import Conjure.Utils
import Data.Express (val, eval, typ)
import Conjure.Ingredient (Ingredient)


-- | Arguments to be passed to
--   'Conjure.conjureWith' or 'Conjure.conjpureWith'.
--   You should use smart constructors instead.
data Setting
  = Noop                       -- ^ internal use: no-op setting

  | MaxTests              Int  -- ^ maximum number of tests to each candidate
  | MaxSize               Int  -- ^ maximum size of candidate bodies
  | Target                Int  -- ^ enumerate further sizes of candidates until this target
  | MaxRecursions         Int  -- ^ maximum number of recursive evaluations when testing candidates
  | MaxEquationSize       Int  -- ^ maximum size of equation operands
  | MaxSearchTests        Int  -- ^ maximum number of tests to search for defined values
  | MaxDeconstructionSize Int  -- ^ maximum size of deconstructions (e.g.: @- 1@)
  | MaxConstantSize       Int  -- ^ maximum size of constants (0 for no limit)
  | MaxPatternSize        Int  -- ^ maximum size of patterns (0 for no limit)
  | MaxPatternDepth       Int  -- ^ maximum depth of patterns

  -- advanced & debug options --
  | CarryOn              -- ^ carry on after finding a suitable candidate
  | ShowTheory           -- ^ show theory discovered by Speculate used in pruning
  | SinglePattern        -- ^ restrict candidates to a single pattern
  | ShowCandidates       -- ^ (debug) show candidates -- warning: wall of text
  | ShowTests            -- ^ (debug) show tests
  | ShowPatterns         -- ^ (debug) show possible LHS patterns
  | ShowDeconstructions  -- ^ (debug) show conjectured-and-allowed deconstructions

  -- pruning options --
  | DontRewrite          -- ^ turns off unique-modulo-rewriting candidates
  | DontRequireDescent   -- ^ require recursive calls to deconstruct arguments
  | OmitAssortedPruning  -- ^ omit other assorted pruning rules
  | OmitEarlyTests       -- ^ don't perform tests early-and-independently on each binding
  | DontCopyBindings     -- ^ don't copy partial definition bindings in candidates
  | AtomicNumbers        -- ^ restrict constant/ground numeric expressions to atoms
  | NonAtomicNumbers     -- ^ lift constant/ground numetic expression restrictions
  | UniqueCandidates     -- ^ unique-modulo-testing candidates
  deriving (Setting -> Setting -> Bool
(Setting -> Setting -> Bool)
-> (Setting -> Setting -> Bool) -> Eq Setting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Setting -> Setting -> Bool
== :: Setting -> Setting -> Bool
$c/= :: Setting -> Setting -> Bool
/= :: Setting -> Setting -> Bool
Eq, Eq Setting
Eq Setting =>
(Setting -> Setting -> Ordering)
-> (Setting -> Setting -> Bool)
-> (Setting -> Setting -> Bool)
-> (Setting -> Setting -> Bool)
-> (Setting -> Setting -> Bool)
-> (Setting -> Setting -> Setting)
-> (Setting -> Setting -> Setting)
-> Ord Setting
Setting -> Setting -> Bool
Setting -> Setting -> Ordering
Setting -> Setting -> Setting
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Setting -> Setting -> Ordering
compare :: Setting -> Setting -> Ordering
$c< :: Setting -> Setting -> Bool
< :: Setting -> Setting -> Bool
$c<= :: Setting -> Setting -> Bool
<= :: Setting -> Setting -> Bool
$c> :: Setting -> Setting -> Bool
> :: Setting -> Setting -> Bool
$c>= :: Setting -> Setting -> Bool
>= :: Setting -> Setting -> Bool
$cmax :: Setting -> Setting -> Setting
max :: Setting -> Setting -> Setting
$cmin :: Setting -> Setting -> Setting
min :: Setting -> Setting -> Setting
Ord, Int -> Setting -> ShowS
[Setting] -> ShowS
Setting -> String
(Int -> Setting -> ShowS)
-> (Setting -> String) -> ([Setting] -> ShowS) -> Show Setting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Setting -> ShowS
showsPrec :: Int -> Setting -> ShowS
$cshow :: Setting -> String
show :: Setting -> String
$cshowList :: [Setting] -> ShowS
showList :: [Setting] -> ShowS
Show, ReadPrec [Setting]
ReadPrec Setting
Int -> ReadS Setting
ReadS [Setting]
(Int -> ReadS Setting)
-> ReadS [Setting]
-> ReadPrec Setting
-> ReadPrec [Setting]
-> Read Setting
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Setting
readsPrec :: Int -> ReadS Setting
$creadList :: ReadS [Setting]
readList :: ReadS [Setting]
$creadPrec :: ReadPrec Setting
readPrec :: ReadPrec Setting
$creadListPrec :: ReadPrec [Setting]
readListPrec :: ReadPrec [Setting]
Read)


-- | Constructs an ingredient from a setting
setting :: Setting -> Ingredient
setting :: Setting -> Ingredient
setting Setting
x  =  (Setting -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val Setting
x, String -> Reification
forall a. HasCallStack => String -> a
error String
"Conjure.Settings: evaluating reification, this is a bug")
  -- using 'id' instead of 'error' above would work,
  -- but we want to be warned in case we accidentally evaluate the reification

extract :: Ingredient -> Setting
extract :: Ingredient -> Setting
extract  =  Setting -> Expr -> Setting
forall a. Typeable a => a -> Expr -> a
eval Setting
Noop (Expr -> Setting) -> (Ingredient -> Expr) -> Ingredient -> Setting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ingredient -> Expr
forall a b. (a, b) -> a
fst

-- | Lists actual incredients in the list
actual :: [Ingredient] -> [Ingredient]
actual :: [Ingredient] -> [Ingredient]
actual [Ingredient]
is  =  [Ingredient
i | Ingredient
i <- [Ingredient]
is, Expr -> TypeRep
typ (Ingredient -> Expr
forall a b. (a, b) -> a
fst Ingredient
i) TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= Setting -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Setting
Noop]

-- | By default,
-- 'Conjure.conjure' tests candidates up to a maximum of 360 tests.
-- This configures the maximum number of tests to each candidate,
-- when provided in the list of ingredients:
--
-- > conjure "..." ... [ ...
-- >                   , maxTests 1080
-- >                   , ... ]
maxTests :: Int -> Ingredient
maxTests :: Int -> Ingredient
maxTests =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
MaxTests

-- | Finds the set maximum number of tests or set the default of 360
maxTestsI  :: [Ingredient] -> Int
maxTestsI :: [Ingredient] -> Int
maxTestsI [Ingredient]
is  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
360 [Int
m | MaxTests Int
m <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]
  -- the use of magic numbers goes well with the theme of Conjure.

-- | By default,
-- 'Conjure.conjure' imposes no limit on the size of candidates.
--
-- This configures a different maximum
-- when provided in the list of ingredients.
--
-- If only one of 'maxSize' and 'target' is defined,
-- it is used.  If none, target is used.
maxSize :: Int -> Ingredient
maxSize :: Int -> Ingredient
maxSize =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
MaxSize

-- | By default, 'Conjure.conjure' targets testing 10080 candidates.
-- This configures a different target when
-- provided in the list of ingredients:
--
-- > conjure "..." ... [ ...
-- >                   , target 5040
-- >                   , ... ]
target :: Int -> Ingredient
target :: Int -> Ingredient
target =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
Target

-- | Computes the target and maxSize.
--
-- When none is provided, we default to a target of 10080.
targetAndMaxSizeI :: [Ingredient] -> (Int, Int)
targetAndMaxSizeI :: [Ingredient] -> (Int, Int)
targetAndMaxSizeI [Ingredient]
is  =
  case (Int
t, Int
m) of
  (Int
0, Int
0) -> (Int
10080, Int
0)
  (Int
t, Int
m) -> (Int
t, Int
m)
  where
  t :: Int
t  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
0 [Int
m | Target Int
m  <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]
  m :: Int
m  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
0 [Int
m | MaxSize Int
m <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]
-- above is a perfect use for the These datatype,
-- one of my favourite non-standard,
-- but I don't want to impose a dependency on my users...

-- | By default,
-- 'Conjure.conjure' evaluates candidates for up to 60 recursive calls.
--
-- This allows overriding the default
-- when provided in the ingredient list.
maxRecursions :: Int -> Ingredient
maxRecursions :: Int -> Ingredient
maxRecursions =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
MaxRecursions

maxRecursionsI :: [Ingredient] -> Int
maxRecursionsI :: [Ingredient] -> Int
maxRecursionsI [Ingredient]
is  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
60 [Int
m | MaxRecursions Int
m <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]


-- | By default,
-- 'Conjure.conjure' considers equations of up to 5 symbols
-- for pruning-through-rewriting.
--
-- This allows overriding the default:
-- 6 or 7 are also good values for this depending on the number of ingredients.
--
-- > conjure ... ... [ ...
-- >                 , maxEquationSize 6
-- >                 , ... ]
--
-- Internally, this is the maximum size passed to the Speculate tool.
maxEquationSize :: Int -> Ingredient
maxEquationSize :: Int -> Ingredient
maxEquationSize =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
MaxEquationSize

maxEquationSizeI :: [Ingredient] -> Int
maxEquationSizeI :: [Ingredient] -> Int
maxEquationSizeI [Ingredient]
is  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
5 [Int
m | MaxEquationSize Int
m <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]


-- | By default,
-- 'Conjure.conjure' enumerates up to 110880 argument combinations
-- while reifying the partial definition passed by the user.
--
-- This allows configuring a higher default
-- when provided in the ingredient list.
--
-- Increasing this setting is useful
-- when the partial definition is not exercised enough.
maxSearchTests :: Int -> Ingredient
maxSearchTests :: Int -> Ingredient
maxSearchTests =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
MaxSearchTests

maxSearchTestsI :: [Ingredient] -> Int
maxSearchTestsI :: [Ingredient] -> Int
maxSearchTestsI [Ingredient]
is  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
110880 [Int
m | MaxSearchTests Int
m <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | By default
-- 'Conjure.conjure' allows deconstruction expressions
-- of up to 4 symbols.
--
-- This allows overriding the default
-- when provided in the ingredient list.
maxDeconstructionSize :: Int -> Ingredient
maxDeconstructionSize :: Int -> Ingredient
maxDeconstructionSize =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
MaxDeconstructionSize

maxDeconstructionSizeI :: [Ingredient] -> Int
maxDeconstructionSizeI :: [Ingredient] -> Int
maxDeconstructionSizeI [Ingredient]
is  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
4 [Int
m | MaxDeconstructionSize Int
m <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | Configures a maximum size of constant sub-expressions
-- when provided in the ingredient list
-- of 'Conjure.conjure' or 'Conjure.conjureFromSpec'.
maxConstantSize :: Int -> Ingredient
maxConstantSize :: Int -> Ingredient
maxConstantSize =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
MaxConstantSize

maxConstantSizeI :: [Ingredient] -> Int
maxConstantSizeI :: [Ingredient] -> Int
maxConstantSizeI [Ingredient]
is  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
0 [Int
m | MaxConstantSize Int
m <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | By default,
-- 'Conjure.conjure' places no limit in the LHS pattern sizes.
--
-- This allows configuring a limit when provided in the ingredient list
maxPatternSize :: Int -> Ingredient
maxPatternSize :: Int -> Ingredient
maxPatternSize =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
MaxPatternSize

maxPatternSizeI :: [Ingredient] -> Int
maxPatternSizeI :: [Ingredient] -> Int
maxPatternSizeI [Ingredient]
is  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
0 [Int
m | MaxPatternSize Int
m <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | By default,
-- 'Conjure.conjure' enumerates pattern breakdowns of the outernmost constructor
-- of depth 1.
--
-- This allows overriding the default when provided in the ingredient list:
-- a depth of 2 allows breakdowns of the two outernmost constructors;
-- a depth of 3, three outernmost constructors;
-- etc.
maxPatternDepth :: Int -> Ingredient
maxPatternDepth :: Int -> Ingredient
maxPatternDepth =  Setting -> Ingredient
setting (Setting -> Ingredient) -> (Int -> Setting) -> Int -> Ingredient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Setting
MaxPatternDepth

maxPatternDepthI :: [Ingredient] -> Int
maxPatternDepthI :: [Ingredient] -> Int
maxPatternDepthI [Ingredient]
is  =  Int -> [Int] -> Int
forall a. a -> [a] -> a
headOr Int
1 [Int
m | MaxPatternDepth Int
m <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | Carry on after finding a suitable candidate.
--   To be provided as a setting in the list of ingredients.
carryOn :: Ingredient
carryOn :: Ingredient
carryOn =  Setting -> Ingredient
setting Setting
CarryOn

carryOnI :: [Ingredient] -> Bool
carryOnI :: [Ingredient] -> Bool
carryOnI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
notNull [Bool
True | Setting
CarryOn <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | (Debug option).
--   Shows the underlying theory used in pruning
--   when this is provided in the ingredient list.
showTheory :: Ingredient
showTheory :: Ingredient
showTheory =  Setting -> Ingredient
setting Setting
ShowTheory

showTheoryI :: [Ingredient] -> Bool
showTheoryI :: [Ingredient] -> Bool
showTheoryI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
notNull [Bool
True | Setting
ShowTheory <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | (Debug option)
--   When provided in the ingredient list,
--   this reverts to a legacy enumeration that
--   contains candidates with a single LHS matching everything.
singlePattern :: Ingredient
singlePattern :: Ingredient
singlePattern =  Setting -> Ingredient
setting Setting
SinglePattern

singlePatternI :: [Ingredient] -> Bool
singlePatternI :: [Ingredient] -> Bool
singlePatternI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
notNull [Bool
True | Setting
SinglePattern <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | (Debug option)
-- When provided in the ingredients list,
-- this enables showing enumerated candidates.
--
-- > conjure ... ... [ ...
-- >                 , showCandidates
-- >                 , ... ]
--
-- Warning: activating this will likely produce a humongous wall-of-text.
showCandidates :: Ingredient
showCandidates :: Ingredient
showCandidates =  Setting -> Ingredient
setting Setting
ShowCandidates

showCandidatesI :: [Ingredient] -> Bool
showCandidatesI :: [Ingredient] -> Bool
showCandidatesI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
notNull [Bool
True | Setting
ShowCandidates <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | (Debug option)
-- When provided in the ingredients list,
-- 'Conjure.conjure' will print the tests reified from the partial definition.
-- (cf. 'maxTests', 'maxSearchTests')
showTests :: Ingredient
showTests :: Ingredient
showTests =  Setting -> Ingredient
setting Setting
ShowTests

showTestsI :: [Ingredient] -> Bool
showTestsI :: [Ingredient] -> Bool
showTestsI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
notNull [Bool
True | Setting
ShowTests <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | (Debug option)
-- When this option is provided in the ingredients list,
-- 'Conjure.conjure' will print the enumrated LHS patterns.
-- (cf. 'maxPatternSize', 'maxPatternDepth')
showPatterns :: Ingredient
showPatterns :: Ingredient
showPatterns =  Setting -> Ingredient
setting Setting
ShowPatterns

showPatternsI :: [Ingredient] -> Bool
showPatternsI :: [Ingredient] -> Bool
showPatternsI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
notNull [Bool
True | Setting
ShowPatterns <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | (Debug option)
-- Makes 'Conjure.conjure' print enumerated deconstructions
-- when provided in its ingredient list.
showDeconstructions :: Ingredient
showDeconstructions :: Ingredient
showDeconstructions =  Setting -> Ingredient
setting Setting
ShowDeconstructions

showDeconstructionsI :: [Ingredient] -> Bool
showDeconstructionsI :: [Ingredient] -> Bool
showDeconstructionsI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
notNull [Bool
True | Setting
ShowDeconstructions <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | Disables rewriting-as-pruning
--   when provided in the ingredient list
--   of 'Conjure.conjure' or 'Conjure.conjureFromSpec'.
dontRewrite :: Ingredient
dontRewrite :: Ingredient
dontRewrite  =  Setting -> Ingredient
setting Setting
DontRewrite

rewriteI :: [Ingredient] -> Bool
rewriteI :: [Ingredient] -> Bool
rewriteI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool
False | Setting
DontRewrite <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | Disables the recursive descent requirement
--   when provided in the ingredient list
--   of 'Conjure.conjure' or 'Conjure.conjureFromSpec'.
dontRequireDescent :: Ingredient
dontRequireDescent :: Ingredient
dontRequireDescent  =  Setting -> Ingredient
setting Setting
DontRequireDescent

requireDescentI :: [Ingredient] -> Bool
requireDescentI :: [Ingredient] -> Bool
requireDescentI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool
False | Setting
DontRequireDescent <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | Disables assorted pruning rules
--   when provided in the ingredient list
--   of 'Conjure.conjure' or 'Conjure.conjureFromSpec'.
omitAssortedPruning :: Ingredient
omitAssortedPruning :: Ingredient
omitAssortedPruning  =  Setting -> Ingredient
setting Setting
OmitAssortedPruning

assortedPruningI :: [Ingredient] -> Bool
assortedPruningI :: [Ingredient] -> Bool
assortedPruningI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool
False | Setting
OmitAssortedPruning <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | Omits early tests
--   when provided in the ingredient list
--   of 'Conjure.conjure' or 'Conjure.conjureFromSpec'.
omitEarlyTests :: Ingredient
omitEarlyTests :: Ingredient
omitEarlyTests  =  Setting -> Ingredient
setting Setting
OmitEarlyTests

earlyTestsI :: [Ingredient] -> Bool
earlyTestsI :: [Ingredient] -> Bool
earlyTestsI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool
False | Setting
OmitEarlyTests <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | Disables the copy-bindings rule
--   when provided in the ingredient list
--   of 'Conjure.conjure' or 'Conjure.conjureFromSpec'.
dontCopyBindings :: Ingredient
dontCopyBindings :: Ingredient
dontCopyBindings  =  Setting -> Ingredient
setting Setting
DontCopyBindings

copyBindingsI :: [Ingredient] -> Bool
copyBindingsI :: [Ingredient] -> Bool
copyBindingsI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool
False | Setting
DontCopyBindings <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

atomicNumbers :: Ingredient
atomicNumbers :: Ingredient
atomicNumbers =  Setting -> Ingredient
setting Setting
AtomicNumbers

-- | Disables the requirement of atomic numeric expressions
--   when provided in the ingredient list
--   of 'Conjure.conjure' or 'Conjure.conjureFromSpec'.
--   (cf. 'maxConstantSize')
nonAtomicNumbers :: Ingredient
nonAtomicNumbers :: Ingredient
nonAtomicNumbers =  Setting -> Ingredient
setting Setting
NonAtomicNumbers

atomicNumbersI :: [Ingredient] -> Bool
atomicNumbersI :: [Ingredient] -> Bool
atomicNumbersI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool
False | Setting
NonAtomicNumbers <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]

-- | Enables expensive unique-modulo-testing candidates
--   when provided in the ingredient list
--   of 'Conjure.conjure' or 'Conjure.conjureFromSpec'.
--
-- Warning: this makes 'Conjure.conjure' very slow,
-- it is only intended for approximating the theoretical
-- limits of pruning in toy examples.
uniqueCandidates :: Ingredient
uniqueCandidates :: Ingredient
uniqueCandidates =  Setting -> Ingredient
setting Setting
UniqueCandidates

uniqueCandidatesI :: [Ingredient] -> Bool
uniqueCandidatesI :: [Ingredient] -> Bool
uniqueCandidatesI [Ingredient]
is  =  [Bool] -> Bool
forall a. [a] -> Bool
notNull [Bool
True | Setting
UniqueCandidates <- (Ingredient -> Setting) -> [Ingredient] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Ingredient -> Setting
extract [Ingredient]
is]