{-# language DuplicateRecordFields #-}
{-# language LambdaCase #-}
{-# language NamedFieldPuns #-}

module FastDownward.Exec
  ( Options(..)
  , SearchConfiguration(..)
  , callFastDownward

    -- * Predefined Search Engines
  , bjolp

    -- * Search Engines
  , SearchEngine(..)
  , AStarConfiguration(..)
  , EagerBestFirstConfiguration(..)
  , EagerGreedyConfiguration(..)
  , EnforcedHillClimbingConfiguration(..)
  , IteratedConfiguration(..)
  , LazyBestFirstConfiguration(..)
  , LazyGreedyConfiguration(..)
  , LazyWeightedAStarConfiguration(..)

    -- ** Search Engine Options
  , CostType(..)
  , PreferredOperatorUsage(..)

    -- * Abstract Tasks
  , AbstractTask(..)

    -- * Constraint Generators
  , ConstraintGenerator(..)

    -- * Evaluators
  , Evaluator(..)
  , AddConfiguration(..)
  , AllStatesPotentialConfiguration(..)
  , BlindConfiguration(..)
  , CEAConfiguration(..)
  , CEGARConfiguration(..)
  , CEGARPick(..)
  , CGConfiguration(..)
  , DiversePotentialsConfiguration(..)
  , FFConfiguration(..)
  , GoalCountConfiguration(..)
  , HMConfiguration(..)
  , HMaxConfiguration(..)
  , InitialStatePotentialConfiguration(..)
  , LMCountConfiguration(..)
  , LMCutConfiguration(..)
  , MergeAndShrinkConfiguration(..)
  , Verbosity(..)
  , OperatorCountingConfiguration(..)
  , SampleBasedPotentialsConfiguration(..)
  , CanonicalPDBConfiguration(..)
  , IPDBConfiguration(..)
  , ZeroOnePDBConfiguration(..)

    -- ** Evaluator Configuration
  , LPSolver(..)

    -- * Label Reduction
  , LabelReduction(..)
  , ExactGeneralizedLabelReductionConfiguration(..)
  , LabelReductionMethod(..)
  , SystemOrder(..)

    -- * Landmark Factory
  , LandmarkFactory(..)
  , LMExhaustConfiguration(..)
  , LMHMConfiguration(..)
  , LMMergedConfiguration(..)
  , LMRHWConfiguration(..)
  , LMZGConfiguration(..)

    -- * Merge Scoring Function
  , MergeScoringFunction(..)
  , MIASMConfiguration(..)
  , TotalOrderConfiguration(..)
  , AtomicTsOrder(..)
  , ProductTsOrder(..)

    -- * Merge Selector
  , MergeSelector(..)

    -- * Merge Strategy
  , MergeStrategy(..)
  , MergeSCCsConfiguration(..)
  , OrderOfSCCs(..)

    -- * Merge Tree
  , MergeTree(..)
  , LinearMergeTreeConfiguration(..)
  , UpdateOption(..)
  , VariableOrder(..)

    -- * Open List
  , OpenList(..)
  , AltConfiguration(..)
  , EpsilonGreedyConfiguration(..)
  , ParetoConfiguration(..)
  , SingleConfiguration(..)
  , TiebreakingConfiguration(..)
  , TypeBasedConfiguration(..)

    -- * Pattern Collection Generators
  , PatternCollectionGenerator(..)
  , GeneticConfiguration(..)
  , HillclimbingConfiguration(..)
  , SystematicConfiguration(..)

    -- * Pruning Method
  , PruningMethod(..)
  , StubbornSetsConfiguration(..)

    -- * Shrink Strategy
  , ShrinkStrategy(..)
  , BisimulationConfiguration(..)
  , BisimulationLimitStrategy(..)
  , FPreservingConfiguration(..)
  , HighLow(..)

    -- * Subtask Generators
  , SubtaskGenerator(..)
  , GoalsConfiguration(..)
  , GoalsOrder(..)
  , LandmarksConfiguration(..)
  , OriginalConfiguration(..)
  )
  where

import Control.Monad.IO.Class ( MonadIO, liftIO )
import Data.Char
import Data.List
import Data.Maybe
import Data.Ratio
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.IO
import qualified FastDownward.SAS
import qualified FastDownward.SAS.Plan
import System.Exit ( ExitCode )
import System.IO ( hClose )
import System.Process


bjolp :: SearchConfiguration
bjolp :: SearchConfiguration
bjolp =
  SearchConfiguration
    { $sel:search:SearchConfiguration :: SearchEngine
search =
        AStarConfiguration -> SearchEngine
AStar
          AStarConfiguration
            { $sel:evaluator:AStarConfiguration :: Evaluator
evaluator = String -> Evaluator
Predefined String
"lmc"
            , $sel:lazyEvaluator:AStarConfiguration :: Maybe Evaluator
lazyEvaluator = forall a. a -> Maybe a
Just ( String -> Evaluator
Predefined String
"lmc" )
            , $sel:pruning:AStarConfiguration :: PruningMethod
pruning = PruningMethod
Null
            , $sel:costType:AStarConfiguration :: CostType
costType = CostType
Normal
            , $sel:bound:AStarConfiguration :: Maybe Int
bound = forall a. Maybe a
Nothing
            , $sel:maxTime:AStarConfiguration :: Maybe Double
maxTime = forall a. a -> Maybe a
Just Double
60
            }
    , $sel:evaluators:SearchConfiguration :: [(String, Evaluator)]
evaluators =
        [ ( String
"lmc"
          , LMCountConfiguration -> Evaluator
LMCount
              LMCountConfiguration
                { $sel:lmFactory:LMCountConfiguration :: LandmarkFactory
lmFactory =
                    LMMergedConfiguration -> LandmarkFactory
LMMerged
                      LMMergedConfiguration
                        { $sel:factories:LMMergedConfiguration :: [LandmarkFactory]
factories =
                            [ LMRHWConfiguration -> LandmarkFactory
LMRHW
                                LMRHWConfiguration
                                  { $sel:reasonableOrders:LMRHWConfiguration :: Bool
reasonableOrders = Bool
False
                                  , $sel:onlyCausalLandmarks:LMRHWConfiguration :: Bool
onlyCausalLandmarks = Bool
False
                                  , $sel:disjunctiveLandmarks:LMRHWConfiguration :: Bool
disjunctiveLandmarks = Bool
True
                                  , $sel:conjunctiveLandmarks:LMRHWConfiguration :: Bool
conjunctiveLandmarks = Bool
True
                                  , $sel:noOrders:LMRHWConfiguration :: Bool
noOrders = Bool
False
                                  }
                            , LMHMConfiguration -> LandmarkFactory
LMHM
                                LMHMConfiguration
                                  { $sel:m:LMHMConfiguration :: Int
m = Int
1
                                  , $sel:reasonableOrders:LMHMConfiguration :: Bool
reasonableOrders = Bool
False
                                  , $sel:onlyCausalLandmarks:LMHMConfiguration :: Bool
onlyCausalLandmarks = Bool
False
                                  , $sel:disjunctiveLandmarks:LMHMConfiguration :: Bool
disjunctiveLandmarks = Bool
True
                                  , $sel:conjunctiveLandmarks:LMHMConfiguration :: Bool
conjunctiveLandmarks = Bool
True
                                  , $sel:noOrders:LMHMConfiguration :: Bool
noOrders = Bool
False
                                  }
                            ]
                        , $sel:reasonableOrders:LMMergedConfiguration :: Bool
reasonableOrders = Bool
False
                        , $sel:onlyCausalLandmarks:LMMergedConfiguration :: Bool
onlyCausalLandmarks = Bool
False
                        , $sel:disjunctiveLandmarks:LMMergedConfiguration :: Bool
disjunctiveLandmarks = Bool
True
                        , $sel:conjunctiveLandmarks:LMMergedConfiguration :: Bool
conjunctiveLandmarks = Bool
True
                        , $sel:noOrders:LMMergedConfiguration :: Bool
noOrders = Bool
False
                        }
                , $sel:admissible:LMCountConfiguration :: Bool
admissible = Bool
True
                , $sel:optimal:LMCountConfiguration :: Bool
optimal = Bool
False
                , $sel:pref:LMCountConfiguration :: Bool
pref = Bool
False
                , $sel:alm:LMCountConfiguration :: Bool
alm = Bool
True
                , $sel:lpSolver:LMCountConfiguration :: LPSolver
lpSolver = LPSolver
CLP
                , $sel:transform:LMCountConfiguration :: AbstractTask
transform = AbstractTask
NoTransform
                , $sel:cacheEstimates:LMCountConfiguration :: Bool
cacheEstimates = Bool
True
                }

          )
        ]
    }


data Expr
  = App String [ Expr ] [ ( String, Expr ) ]
  | Lit String
  | List [ Expr ]


infinity :: Expr
infinity :: Expr
infinity =
  String -> Expr
Lit String
"infinity"


intToExpr :: Int -> Expr
intToExpr :: Int -> Expr
intToExpr =
  String -> Expr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


doubleToExpr :: Double -> Expr
doubleToExpr :: Double -> Expr
doubleToExpr =
  String -> Expr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


boolToExpr :: Bool -> Expr
boolToExpr :: Bool -> Expr
boolToExpr =
  String -> Expr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


none :: Expr
none :: Expr
none =
  String -> Expr
Lit String
""


exprToString :: Expr -> String
exprToString :: Expr -> String
exprToString ( App String
f [Expr]
pos [(String, Expr)]
named ) =
  String
f
    forall a. Semigroup a => a -> a -> a
<> String
"("
    forall a. Semigroup a => a -> a -> a
<>
      forall a. [a] -> [[a]] -> [a]
intercalate
        String
","
        ( forall a b. (a -> b) -> [a] -> [b]
map Expr -> String
exprToString [Expr]
pos
            forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map ( \( String
k, Expr
e ) -> String
k forall a. Semigroup a => a -> a -> a
<> String
"=" forall a. Semigroup a => a -> a -> a
<> Expr -> String
exprToString Expr
e ) [(String, Expr)]
named
        )
    forall a. Semigroup a => a -> a -> a
<> String
")"
exprToString ( Lit String
s ) =
  String
s
exprToString ( List [Expr]
l ) =
  String
"[" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
"," ( forall a b. (a -> b) -> [a] -> [b]
map Expr -> String
exprToString [Expr]
l ) forall a. Semigroup a => a -> a -> a
<> String
"]"


data Options =
  Options
    { Options -> String
fastDownward :: FilePath
    , Options -> Plan
problem :: FastDownward.SAS.Plan
    , Options -> String
planFilePath :: FilePath
    , Options -> SearchConfiguration
searchConfiguration :: SearchConfiguration
    }


data SearchConfiguration =
  SearchConfiguration
    { SearchConfiguration -> SearchEngine
search :: SearchEngine
    , SearchConfiguration -> [(String, Evaluator)]
evaluators :: [ ( String, Evaluator ) ]
    }



callFastDownward :: MonadIO m => Options -> m ( ExitCode, String, String )
callFastDownward :: forall (m :: * -> *).
MonadIO m =>
Options -> m (ExitCode, String, String)
callFastDownward Options{ String
fastDownward :: String
$sel:fastDownward:Options :: Options -> String
fastDownward, Plan
problem :: Plan
$sel:problem:Options :: Options -> Plan
problem, String
planFilePath :: String
$sel:planFilePath:Options :: Options -> String
planFilePath, $sel:searchConfiguration:Options :: Options -> SearchConfiguration
searchConfiguration = SearchConfiguration{ SearchEngine
search :: SearchEngine
$sel:search:SearchConfiguration :: SearchConfiguration -> SearchEngine
search, [(String, Evaluator)]
evaluators :: [(String, Evaluator)]
$sel:evaluators:SearchConfiguration :: SearchConfiguration -> [(String, Evaluator)]
evaluators } } = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  ( Just Handle
writeProblemHandle, Just Handle
stdoutHandle, Just Handle
stderrHandle, ProcessHandle
processHandle ) <-
    CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess
      ( String -> [String] -> CreateProcess
proc
          String
fastDownward
          ( forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [ String
"--internal-plan-file", String
planFilePath ]
              , forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                  ( \( String
name, Evaluator
def ) ->
                      [ String
"--evaluator"
                      , String
name forall a. Semigroup a => a -> a -> a
<> String
"=" forall a. Semigroup a => a -> a -> a
<> Expr -> String
exprToString ( Evaluator -> Expr
evaluatorToExpr Evaluator
def )
                      ]
                  )
                  [(String, Evaluator)]
evaluators
              , [ String
"--search", Expr -> String
exprToString ( SearchEngine -> Expr
searchEngineToExpr SearchEngine
search ) ]
              ]
          )
      )
      { std_in :: StdStream
std_in = StdStream
CreatePipe
      , std_out :: StdStream
std_out = StdStream
CreatePipe
      , std_err :: StdStream
std_err = StdStream
CreatePipe
      }

  Handle -> Text -> IO ()
Data.Text.Lazy.IO.hPutStr Handle
writeProblemHandle ( Plan -> Text
FastDownward.SAS.Plan.toSAS Plan
problem )
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
writeProblemHandle

  ExitCode
exitCode <-
    ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
processHandle

  Text
stdout <-
    Handle -> IO Text
Data.Text.Lazy.IO.hGetContents Handle
stdoutHandle

  Text
stderr <-
    Handle -> IO Text
Data.Text.Lazy.IO.hGetContents Handle
stderrHandle

  forall (m :: * -> *) a. Monad m => a -> m a
return ( ExitCode
exitCode, Text -> String
Data.Text.Lazy.unpack Text
stdout, Text -> String
Data.Text.Lazy.unpack Text
stderr )


-- | See <http://www.fast-downward.org/Doc/SearchEngine>
data SearchEngine
  = AStar AStarConfiguration
  | EagerBestFirst EagerBestFirstConfiguration
  | EagerGreedy EagerGreedyConfiguration
  | EnforcedHillClimbing EnforcedHillClimbingConfiguration
  | Iterated IteratedConfiguration
  | LazyBestFirst LazyBestFirstConfiguration
  | LazyGreedy LazyGreedyConfiguration
  | LazyWeightedAStar LazyWeightedAStarConfiguration


searchEngineToExpr :: SearchEngine -> Expr
searchEngineToExpr :: SearchEngine -> Expr
searchEngineToExpr =
  \case
    AStar AStarConfiguration
cfg ->
      AStarConfiguration -> Expr
aStar AStarConfiguration
cfg

    EagerBestFirst EagerBestFirstConfiguration
cfg ->
      EagerBestFirstConfiguration -> Expr
eager EagerBestFirstConfiguration
cfg

    EagerGreedy EagerGreedyConfiguration
cfg ->
      EagerGreedyConfiguration -> Expr
eagerGreedy EagerGreedyConfiguration
cfg

    EnforcedHillClimbing EnforcedHillClimbingConfiguration
cfg ->
      EnforcedHillClimbingConfiguration -> Expr
ehc EnforcedHillClimbingConfiguration
cfg

    Iterated IteratedConfiguration
cfg ->
      IteratedConfiguration -> Expr
iterated IteratedConfiguration
cfg

    LazyBestFirst LazyBestFirstConfiguration
cfg ->
      LazyBestFirstConfiguration -> Expr
lazy LazyBestFirstConfiguration
cfg

    LazyGreedy LazyGreedyConfiguration
cfg ->
      LazyGreedyConfiguration -> Expr
lazyGreedy LazyGreedyConfiguration
cfg

    LazyWeightedAStar LazyWeightedAStarConfiguration
cfg ->
      LazyWeightedAStarConfiguration -> Expr
lazyWAStar LazyWeightedAStarConfiguration
cfg


-- | See <http://www.fast-downward.org/Doc/SearchEngine#A.2A_search_.28eager.29>
data AStarConfiguration =
  AStarConfiguration
    { AStarConfiguration -> Evaluator
evaluator :: Evaluator
    , AStarConfiguration -> Maybe Evaluator
lazyEvaluator :: Maybe Evaluator
    , AStarConfiguration -> PruningMethod
pruning :: PruningMethod
    , AStarConfiguration -> CostType
costType :: CostType
    , AStarConfiguration -> Maybe Int
bound :: Maybe Int
    , AStarConfiguration -> Maybe Double
maxTime :: Maybe Double
    }


aStar :: AStarConfiguration -> Expr
aStar :: AStarConfiguration -> Expr
aStar AStarConfiguration{ Evaluator
evaluator :: Evaluator
$sel:evaluator:AStarConfiguration :: AStarConfiguration -> Evaluator
evaluator, Maybe Evaluator
lazyEvaluator :: Maybe Evaluator
$sel:lazyEvaluator:AStarConfiguration :: AStarConfiguration -> Maybe Evaluator
lazyEvaluator, PruningMethod
pruning :: PruningMethod
$sel:pruning:AStarConfiguration :: AStarConfiguration -> PruningMethod
pruning, CostType
costType :: CostType
$sel:costType:AStarConfiguration :: AStarConfiguration -> CostType
costType, Maybe Int
bound :: Maybe Int
$sel:bound:AStarConfiguration :: AStarConfiguration -> Maybe Int
bound, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:AStarConfiguration :: AStarConfiguration -> Maybe Double
maxTime } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"astar"
    [ Evaluator -> Expr
evaluatorToExpr Evaluator
evaluator ]
    [ ( String
"lazy_evaluator", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
none Evaluator -> Expr
evaluatorToExpr Maybe Evaluator
lazyEvaluator )
    , ( String
"pruning", PruningMethod -> Expr
pruningMethodToExpr PruningMethod
pruning )
    , ( String
"cost_type", CostType -> Expr
costTypeToExpr CostType
costType )
    , ( String
"bound", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
bound )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    ]


-- | See <http://www.fast-downward.org/Doc/SearchEngine#Eager_best-first_search>
data EagerBestFirstConfiguration =
  EagerBestFirstConfiguration
    { EagerBestFirstConfiguration -> OpenList
open :: OpenList
    , EagerBestFirstConfiguration -> Bool
reopenClosed :: Bool
    , EagerBestFirstConfiguration -> Maybe Evaluator
fEval :: Maybe Evaluator
    , EagerBestFirstConfiguration -> [Evaluator]
preferred :: [ Evaluator ]
    , EagerBestFirstConfiguration -> PruningMethod
pruning :: PruningMethod
    , EagerBestFirstConfiguration -> CostType
costType :: CostType
    , EagerBestFirstConfiguration -> Maybe Int
bound :: Maybe Int
    , EagerBestFirstConfiguration -> Maybe Double
maxTime :: Maybe Double
    }


eager :: EagerBestFirstConfiguration -> Expr
eager :: EagerBestFirstConfiguration -> Expr
eager EagerBestFirstConfiguration{ OpenList
open :: OpenList
$sel:open:EagerBestFirstConfiguration :: EagerBestFirstConfiguration -> OpenList
open, Bool
reopenClosed :: Bool
$sel:reopenClosed:EagerBestFirstConfiguration :: EagerBestFirstConfiguration -> Bool
reopenClosed, Maybe Evaluator
fEval :: Maybe Evaluator
$sel:fEval:EagerBestFirstConfiguration :: EagerBestFirstConfiguration -> Maybe Evaluator
fEval, [Evaluator]
preferred :: [Evaluator]
$sel:preferred:EagerBestFirstConfiguration :: EagerBestFirstConfiguration -> [Evaluator]
preferred, PruningMethod
pruning :: PruningMethod
$sel:pruning:EagerBestFirstConfiguration :: EagerBestFirstConfiguration -> PruningMethod
pruning, CostType
costType :: CostType
$sel:costType:EagerBestFirstConfiguration :: EagerBestFirstConfiguration -> CostType
costType, Maybe Int
bound :: Maybe Int
$sel:bound:EagerBestFirstConfiguration :: EagerBestFirstConfiguration -> Maybe Int
bound, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:EagerBestFirstConfiguration :: EagerBestFirstConfiguration -> Maybe Double
maxTime } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"eager"
    [ OpenList -> Expr
openListToExpr OpenList
open ]
    [ ( String
"reopen_closed", Bool -> Expr
boolToExpr Bool
reopenClosed )
    , ( String
"f_eval", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
none Evaluator -> Expr
evaluatorToExpr Maybe Evaluator
fEval )
    , ( String
"preferred", [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
preferred ) )
    , ( String
"pruning", PruningMethod -> Expr
pruningMethodToExpr PruningMethod
pruning )
    , ( String
"cost_type", CostType -> Expr
costTypeToExpr CostType
costType )
    , ( String
"bound", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
bound )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    ]


-- | See <http://www.fast-downward.org/Doc/SearchEngine#Greedy_search_.28eager.29>
data EagerGreedyConfiguration =
  EagerGreedyConfiguration
    { EagerGreedyConfiguration -> [Evaluator]
evaluators :: [ Evaluator ]
    , EagerGreedyConfiguration -> [Evaluator]
preferred :: [ Evaluator ]
    , EagerGreedyConfiguration -> Int
boost :: Int
    , EagerGreedyConfiguration -> PruningMethod
pruning :: PruningMethod
    , EagerGreedyConfiguration -> CostType
costType :: CostType
    , EagerGreedyConfiguration -> Maybe Int
bound :: Maybe Int
    , EagerGreedyConfiguration -> Maybe Double
maxTime :: Maybe Double
    }


eagerGreedy :: EagerGreedyConfiguration -> Expr
eagerGreedy :: EagerGreedyConfiguration -> Expr
eagerGreedy EagerGreedyConfiguration{ [Evaluator]
evaluators :: [Evaluator]
$sel:evaluators:EagerGreedyConfiguration :: EagerGreedyConfiguration -> [Evaluator]
evaluators, [Evaluator]
preferred :: [Evaluator]
$sel:preferred:EagerGreedyConfiguration :: EagerGreedyConfiguration -> [Evaluator]
preferred, Int
boost :: Int
$sel:boost:EagerGreedyConfiguration :: EagerGreedyConfiguration -> Int
boost, PruningMethod
pruning :: PruningMethod
$sel:pruning:EagerGreedyConfiguration :: EagerGreedyConfiguration -> PruningMethod
pruning, CostType
costType :: CostType
$sel:costType:EagerGreedyConfiguration :: EagerGreedyConfiguration -> CostType
costType, Maybe Int
bound :: Maybe Int
$sel:bound:EagerGreedyConfiguration :: EagerGreedyConfiguration -> Maybe Int
bound, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:EagerGreedyConfiguration :: EagerGreedyConfiguration -> Maybe Double
maxTime } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"eager_greedy"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
evaluators ) ]
    [ ( String
"preferred", [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
preferred ) )
    , ( String
"boost", Int -> Expr
intToExpr Int
boost )
    , ( String
"pruning", PruningMethod -> Expr
pruningMethodToExpr PruningMethod
pruning )
    , ( String
"cost_type", CostType -> Expr
costTypeToExpr CostType
costType )
    , ( String
"bound", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
bound )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    ]


-- | See <http://www.fast-downward.org/Doc/SearchEngine#Lazy_enforced_hill-climbing>
data EnforcedHillClimbingConfiguration =
  EnforcedHillClimbingConfiguration
    { EnforcedHillClimbingConfiguration -> Evaluator
h :: Evaluator
    , EnforcedHillClimbingConfiguration -> PreferredOperatorUsage
preferredUsage :: PreferredOperatorUsage
    , EnforcedHillClimbingConfiguration -> [Evaluator]
preferred :: [ Evaluator ]
    , EnforcedHillClimbingConfiguration -> CostType
costType :: CostType
    , EnforcedHillClimbingConfiguration -> Maybe Int
bound :: Maybe Int
    , EnforcedHillClimbingConfiguration -> Maybe Double
maxTime :: Maybe Double
    }


ehc :: EnforcedHillClimbingConfiguration -> Expr
ehc :: EnforcedHillClimbingConfiguration -> Expr
ehc EnforcedHillClimbingConfiguration{ Evaluator
h :: Evaluator
$sel:h:EnforcedHillClimbingConfiguration :: EnforcedHillClimbingConfiguration -> Evaluator
h, PreferredOperatorUsage
preferredUsage :: PreferredOperatorUsage
$sel:preferredUsage:EnforcedHillClimbingConfiguration :: EnforcedHillClimbingConfiguration -> PreferredOperatorUsage
preferredUsage, [Evaluator]
preferred :: [Evaluator]
$sel:preferred:EnforcedHillClimbingConfiguration :: EnforcedHillClimbingConfiguration -> [Evaluator]
preferred, CostType
costType :: CostType
$sel:costType:EnforcedHillClimbingConfiguration :: EnforcedHillClimbingConfiguration -> CostType
costType, Maybe Int
bound :: Maybe Int
$sel:bound:EnforcedHillClimbingConfiguration :: EnforcedHillClimbingConfiguration -> Maybe Int
bound, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:EnforcedHillClimbingConfiguration :: EnforcedHillClimbingConfiguration -> Maybe Double
maxTime } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"ehc"
    [ Evaluator -> Expr
evaluatorToExpr Evaluator
h ]
    [ ( String
"preferred_usage", PreferredOperatorUsage -> Expr
preferredUsageToExpr PreferredOperatorUsage
preferredUsage )
    , ( String
"preferred", [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
preferred ) )
    , ( String
"cost_type", CostType -> Expr
costTypeToExpr CostType
costType )
    , ( String
"bound", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
bound )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    ]


-- | See <http://www.fast-downward.org/Doc/SearchEngine#Iterated_search>
data IteratedConfiguration =
  IteratedConfiguration
    { IteratedConfiguration -> [SearchEngine]
engines :: [ SearchEngine ]
    , IteratedConfiguration -> Bool
passBound :: Bool
    , IteratedConfiguration -> Bool
repeatLast :: Bool
    , IteratedConfiguration -> Bool
continueOnFail :: Bool
    , IteratedConfiguration -> Bool
continueOnSolve :: Bool
    , IteratedConfiguration -> CostType
costType :: CostType
    , IteratedConfiguration -> Maybe Int
bound :: Maybe Int
    , IteratedConfiguration -> Maybe Double
maxTime :: Maybe Double
    }


iterated :: IteratedConfiguration -> Expr
iterated :: IteratedConfiguration -> Expr
iterated IteratedConfiguration{ [SearchEngine]
engines :: [SearchEngine]
$sel:engines:IteratedConfiguration :: IteratedConfiguration -> [SearchEngine]
engines, Bool
passBound :: Bool
$sel:passBound:IteratedConfiguration :: IteratedConfiguration -> Bool
passBound, Bool
repeatLast :: Bool
$sel:repeatLast:IteratedConfiguration :: IteratedConfiguration -> Bool
repeatLast, Bool
continueOnFail :: Bool
$sel:continueOnFail:IteratedConfiguration :: IteratedConfiguration -> Bool
continueOnFail, Bool
continueOnSolve :: Bool
$sel:continueOnSolve:IteratedConfiguration :: IteratedConfiguration -> Bool
continueOnSolve, CostType
costType :: CostType
$sel:costType:IteratedConfiguration :: IteratedConfiguration -> CostType
costType, Maybe Int
bound :: Maybe Int
$sel:bound:IteratedConfiguration :: IteratedConfiguration -> Maybe Int
bound, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:IteratedConfiguration :: IteratedConfiguration -> Maybe Double
maxTime } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"iterated"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map SearchEngine -> Expr
searchEngineToExpr [SearchEngine]
engines ) ]
    [ ( String
"pass_bound", Bool -> Expr
boolToExpr Bool
passBound )
    , ( String
"repeat_last", Bool -> Expr
boolToExpr Bool
repeatLast )
    , ( String
"continue_on_fail", Bool -> Expr
boolToExpr Bool
continueOnFail )
    , ( String
"continue_on_solve", Bool -> Expr
boolToExpr Bool
continueOnSolve )
    , ( String
"cost_type", CostType -> Expr
costTypeToExpr CostType
costType )
    , ( String
"bound", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
bound )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    ]


-- | See <http://www.fast-downward.org/Doc/SearchEngine#Lazy_best-first_search>
data LazyBestFirstConfiguration =
  LazyBestFirstConfiguration
    { LazyBestFirstConfiguration -> OpenList
open :: OpenList
    , LazyBestFirstConfiguration -> Bool
reopenClosed :: Bool
    , LazyBestFirstConfiguration -> [Evaluator]
preferred :: [ Evaluator ]
    , LazyBestFirstConfiguration -> Bool
randomizeSuccessors :: Bool
    , LazyBestFirstConfiguration -> Bool
preferredSuccessorsFirst :: Bool
    , LazyBestFirstConfiguration -> Maybe Int
randomSeed :: Maybe Int
    , LazyBestFirstConfiguration -> CostType
costType :: CostType
    , LazyBestFirstConfiguration -> Maybe Int
bound :: Maybe Int
    , LazyBestFirstConfiguration -> Maybe Double
maxTime :: Maybe Double
    }


lazy :: LazyBestFirstConfiguration -> Expr
lazy :: LazyBestFirstConfiguration -> Expr
lazy LazyBestFirstConfiguration{ OpenList
open :: OpenList
$sel:open:LazyBestFirstConfiguration :: LazyBestFirstConfiguration -> OpenList
open, Bool
reopenClosed :: Bool
$sel:reopenClosed:LazyBestFirstConfiguration :: LazyBestFirstConfiguration -> Bool
reopenClosed, [Evaluator]
preferred :: [Evaluator]
$sel:preferred:LazyBestFirstConfiguration :: LazyBestFirstConfiguration -> [Evaluator]
preferred, Bool
randomizeSuccessors :: Bool
$sel:randomizeSuccessors:LazyBestFirstConfiguration :: LazyBestFirstConfiguration -> Bool
randomizeSuccessors, Bool
preferredSuccessorsFirst :: Bool
$sel:preferredSuccessorsFirst:LazyBestFirstConfiguration :: LazyBestFirstConfiguration -> Bool
preferredSuccessorsFirst, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:LazyBestFirstConfiguration :: LazyBestFirstConfiguration -> Maybe Int
randomSeed, CostType
costType :: CostType
$sel:costType:LazyBestFirstConfiguration :: LazyBestFirstConfiguration -> CostType
costType, Maybe Int
bound :: Maybe Int
$sel:bound:LazyBestFirstConfiguration :: LazyBestFirstConfiguration -> Maybe Int
bound, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:LazyBestFirstConfiguration :: LazyBestFirstConfiguration -> Maybe Double
maxTime } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lazy"
    [ OpenList -> Expr
openListToExpr OpenList
open ]
    [ ( String
"reopen_closed", Bool -> Expr
boolToExpr Bool
reopenClosed )
    , ( String
"preferred", [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
preferred ) )
    , ( String
"randomize_successors", Bool -> Expr
boolToExpr Bool
randomizeSuccessors )
    , ( String
"preferred_successors_first", Bool -> Expr
boolToExpr Bool
preferredSuccessorsFirst )
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    , ( String
"cost_type", CostType -> Expr
costTypeToExpr CostType
costType )
    , ( String
"bound", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
bound )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    ]


-- | See <http://www.fast-downward.org/Doc/SearchEngine#Greedy_search_.28lazy.29>
data LazyGreedyConfiguration =
  LazyGreedyConfiguration
    { LazyGreedyConfiguration -> [Evaluator]
evaluators :: [ Evaluator ]
    , LazyGreedyConfiguration -> [Evaluator]
preferred :: [ Evaluator ]
    , LazyGreedyConfiguration -> Bool
reopenClosed :: Bool
    , LazyGreedyConfiguration -> Int
boost :: Int
    , LazyGreedyConfiguration -> Bool
randomizeSuccessors :: Bool
    , LazyGreedyConfiguration -> Bool
preferredSuccessorsFirst :: Bool
    , LazyGreedyConfiguration -> Maybe Int
randomSeed :: Maybe Int
    , LazyGreedyConfiguration -> CostType
costType :: CostType
    , LazyGreedyConfiguration -> Maybe Int
bound :: Maybe Int
    , LazyGreedyConfiguration -> Maybe Double
maxTime :: Maybe Double
    }


lazyGreedy :: LazyGreedyConfiguration -> Expr
lazyGreedy :: LazyGreedyConfiguration -> Expr
lazyGreedy LazyGreedyConfiguration{ [Evaluator]
evaluators :: [Evaluator]
$sel:evaluators:LazyGreedyConfiguration :: LazyGreedyConfiguration -> [Evaluator]
evaluators, [Evaluator]
preferred :: [Evaluator]
$sel:preferred:LazyGreedyConfiguration :: LazyGreedyConfiguration -> [Evaluator]
preferred, Bool
reopenClosed :: Bool
$sel:reopenClosed:LazyGreedyConfiguration :: LazyGreedyConfiguration -> Bool
reopenClosed, Int
boost :: Int
$sel:boost:LazyGreedyConfiguration :: LazyGreedyConfiguration -> Int
boost, Bool
randomizeSuccessors :: Bool
$sel:randomizeSuccessors:LazyGreedyConfiguration :: LazyGreedyConfiguration -> Bool
randomizeSuccessors, Bool
preferredSuccessorsFirst :: Bool
$sel:preferredSuccessorsFirst:LazyGreedyConfiguration :: LazyGreedyConfiguration -> Bool
preferredSuccessorsFirst, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:LazyGreedyConfiguration :: LazyGreedyConfiguration -> Maybe Int
randomSeed, CostType
costType :: CostType
$sel:costType:LazyGreedyConfiguration :: LazyGreedyConfiguration -> CostType
costType, Maybe Int
bound :: Maybe Int
$sel:bound:LazyGreedyConfiguration :: LazyGreedyConfiguration -> Maybe Int
bound, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:LazyGreedyConfiguration :: LazyGreedyConfiguration -> Maybe Double
maxTime } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lazy_greedy"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
evaluators ) ]
    [ ( String
"reopen_closed", Bool -> Expr
boolToExpr Bool
reopenClosed )
    , ( String
"preferred", [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
preferred ) )
    , ( String
"boost", Int -> Expr
intToExpr Int
boost )
    , ( String
"randomize_successors", Bool -> Expr
boolToExpr Bool
randomizeSuccessors )
    , ( String
"preferred_successors_first", Bool -> Expr
boolToExpr Bool
preferredSuccessorsFirst )
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    , ( String
"cost_type", CostType -> Expr
costTypeToExpr CostType
costType )
    , ( String
"bound", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
bound )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    ]


-- | See <http://www.fast-downward.org/Doc/SearchEngine#A.28Weighted.29_A.2A_search_.28lazy.29>
data LazyWeightedAStarConfiguration =
  LazyWeightedAStarConfiguration
    { LazyWeightedAStarConfiguration -> [Evaluator]
evaluators :: [ Evaluator ]
    , LazyWeightedAStarConfiguration -> [Evaluator]
preferred :: [ Evaluator ]
    , LazyWeightedAStarConfiguration -> Bool
reopenClosed :: Bool
    , LazyWeightedAStarConfiguration -> Int
boost :: Int
    , LazyWeightedAStarConfiguration -> Int
w :: Int
    , LazyWeightedAStarConfiguration -> Bool
randomizeSuccessors :: Bool
    , LazyWeightedAStarConfiguration -> Bool
preferredSuccessorsFirst :: Bool
    , LazyWeightedAStarConfiguration -> Maybe Int
randomSeed :: Maybe Int
    , LazyWeightedAStarConfiguration -> CostType
costType :: CostType
    , LazyWeightedAStarConfiguration -> Maybe Int
bound :: Maybe Int
    , LazyWeightedAStarConfiguration -> Maybe Double
maxTime :: Maybe Double
    }


lazyWAStar :: LazyWeightedAStarConfiguration -> Expr
lazyWAStar :: LazyWeightedAStarConfiguration -> Expr
lazyWAStar LazyWeightedAStarConfiguration{ [Evaluator]
evaluators :: [Evaluator]
$sel:evaluators:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> [Evaluator]
evaluators, [Evaluator]
preferred :: [Evaluator]
$sel:preferred:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> [Evaluator]
preferred, Bool
reopenClosed :: Bool
$sel:reopenClosed:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> Bool
reopenClosed, Int
boost :: Int
$sel:boost:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> Int
boost, Int
w :: Int
$sel:w:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> Int
w, Bool
randomizeSuccessors :: Bool
$sel:randomizeSuccessors:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> Bool
randomizeSuccessors, Bool
preferredSuccessorsFirst :: Bool
$sel:preferredSuccessorsFirst:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> Bool
preferredSuccessorsFirst, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> Maybe Int
randomSeed, CostType
costType :: CostType
$sel:costType:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> CostType
costType, Maybe Int
bound :: Maybe Int
$sel:bound:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> Maybe Int
bound, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:LazyWeightedAStarConfiguration :: LazyWeightedAStarConfiguration -> Maybe Double
maxTime } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lazy_wastar"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
evaluators ) ]
    [ ( String
"reopen_closed", Bool -> Expr
boolToExpr Bool
reopenClosed )
    , ( String
"preferred", [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
preferred ) )
    , ( String
"boost", Int -> Expr
intToExpr Int
boost )
    , ( String
"w", Int -> Expr
intToExpr Int
w )
    , ( String
"randomize_successors", Bool -> Expr
boolToExpr Bool
randomizeSuccessors )
    , ( String
"preferred_successors_first", Bool -> Expr
boolToExpr Bool
preferredSuccessorsFirst )
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    , ( String
"cost_type", CostType -> Expr
costTypeToExpr CostType
costType )
    , ( String
"bound", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
bound )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator>
data Evaluator
  = Predefined String
  | Add AddConfiguration
  | AllStatesPotential AllStatesPotentialConfiguration
  | Blind BlindConfiguration
  | CEA CEAConfiguration
  | CEGAR CEGARConfiguration
  | CG CGConfiguration
  | DiversePotentials DiversePotentialsConfiguration
  | FF FFConfiguration
  | GoalCount GoalCountConfiguration
  | HM HMConfiguration
  | HMax HMaxConfiguration
  | InitialStatePotential InitialStatePotentialConfiguration
  | LMCount LMCountConfiguration
  | LMCut LMCutConfiguration
  | Max [ Evaluator ]
  | MergeAndShrink MergeAndShrinkConfiguration
  | OperatorCounting OperatorCountingConfiguration
  | SampleBasedPotentials SampleBasedPotentialsConfiguration
  | ConstantEvaluator Int
  | G
  | Pref
  | Sum [ Evaluator ]
  | Weighted Evaluator Int
  | CanonicalPDB CanonicalPDBConfiguration
  | IPDB IPDBConfiguration
  | ZeroOnePDB ZeroOnePDBConfiguration


evaluatorToExpr :: Evaluator -> Expr
evaluatorToExpr :: Evaluator -> Expr
evaluatorToExpr =
  \case
    Predefined String
varName ->
      String -> Expr
Lit String
varName

    Add AddConfiguration
cfg ->
      AddConfiguration -> Expr
add AddConfiguration
cfg

    AllStatesPotential AllStatesPotentialConfiguration
cfg ->
      AllStatesPotentialConfiguration -> Expr
allStatesPotential AllStatesPotentialConfiguration
cfg

    Blind BlindConfiguration
cfg ->
      BlindConfiguration -> Expr
blind BlindConfiguration
cfg

    CEA CEAConfiguration
cfg ->
      CEAConfiguration -> Expr
cea CEAConfiguration
cfg

    CEGAR CEGARConfiguration
cfg ->
      CEGARConfiguration -> Expr
cegar CEGARConfiguration
cfg

    CG CGConfiguration
cfg ->
      CGConfiguration -> Expr
cg CGConfiguration
cfg

    DiversePotentials DiversePotentialsConfiguration
cfg ->
      DiversePotentialsConfiguration -> Expr
diversePotentials DiversePotentialsConfiguration
cfg

    FF FFConfiguration
cfg ->
      FFConfiguration -> Expr
ff FFConfiguration
cfg

    GoalCount GoalCountConfiguration
cfg ->
      GoalCountConfiguration -> Expr
goalCount GoalCountConfiguration
cfg

    HM HMConfiguration
cfg ->
      HMConfiguration -> Expr
hm HMConfiguration
cfg

    HMax HMaxConfiguration
cfg ->
      HMaxConfiguration -> Expr
hmax HMaxConfiguration
cfg

    InitialStatePotential InitialStatePotentialConfiguration
cfg ->
      InitialStatePotentialConfiguration -> Expr
initialStatePotential InitialStatePotentialConfiguration
cfg

    LMCount LMCountConfiguration
cfg ->
      LMCountConfiguration -> Expr
lmcount LMCountConfiguration
cfg

    LMCut LMCutConfiguration
cfg ->
      LMCutConfiguration -> Expr
lmcut LMCutConfiguration
cfg

    Max [Evaluator]
evals ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"max" [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
evals ) ] []

    MergeAndShrink MergeAndShrinkConfiguration
cfg ->
      MergeAndShrinkConfiguration -> Expr
mergeAndShrink MergeAndShrinkConfiguration
cfg

    OperatorCounting OperatorCountingConfiguration
cfg ->
      OperatorCountingConfiguration -> Expr
operatorCounting OperatorCountingConfiguration
cfg

    ConstantEvaluator Int
cfg ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"const" [] [ ( String
"vale", Int -> Expr
intToExpr Int
cfg ) ]

    Evaluator
G ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"g" [] []

    Evaluator
Pref ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"pref" [] []

    Sum [Evaluator]
evals ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"sum" [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
evals ) ] []

    Weighted Evaluator
eval Int
weight ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"weight" [ Evaluator -> Expr
evaluatorToExpr Evaluator
eval, Int -> Expr
intToExpr Int
weight ] []

    CanonicalPDB CanonicalPDBConfiguration
cfg ->
      CanonicalPDBConfiguration -> Expr
cpdbs CanonicalPDBConfiguration
cfg

    SampleBasedPotentials SampleBasedPotentialsConfiguration
cfg ->
      SampleBasedPotentialsConfiguration -> Expr
sampleBasedPotentials SampleBasedPotentialsConfiguration
cfg

    IPDB IPDBConfiguration
cfg ->
      IPDBConfiguration -> Expr
ipdb IPDBConfiguration
cfg

    ZeroOnePDB ZeroOnePDBConfiguration
cfg ->
      ZeroOnePDBConfiguration -> Expr
zopdbs ZeroOnePDBConfiguration
cfg


-- | See <http://www.fast-downward.org/Doc/PruningMethod>
data PruningMethod
  = Null
  | StubbornSetsEC StubbornSetsConfiguration
  | StubbornSetsSimple StubbornSetsConfiguration


pruningMethodToExpr :: PruningMethod -> Expr
pruningMethodToExpr :: PruningMethod -> Expr
pruningMethodToExpr =
  \case
    PruningMethod
Null ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"null" [] []

    StubbornSetsEC StubbornSetsConfiguration
cfg ->
      StubbornSetsConfiguration -> Expr
stubbornSetsEc StubbornSetsConfiguration
cfg

    StubbornSetsSimple StubbornSetsConfiguration
cfg ->
      StubbornSetsConfiguration -> Expr
stubbornSetsSimple StubbornSetsConfiguration
cfg


data CostType
  = Normal
    -- ^ All actions are accounted for with their real cost.
  | One
    -- ^ All actions are accounted for as unit cost.
  | PlusOne
    -- ^ All actions are accounted for as their real cost + 1 (except if all
    -- actions have original cost 1, in which case cost 1 is used). This is the
    -- behaviour known for the heuristics of the LAMA planner. This is intended
    -- to be used by the heuristics, not search engines, but is supported for
    -- both.
  deriving
    ( Int -> CostType -> ShowS
[CostType] -> ShowS
CostType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CostType] -> ShowS
$cshowList :: [CostType] -> ShowS
show :: CostType -> String
$cshow :: CostType -> String
showsPrec :: Int -> CostType -> ShowS
$cshowsPrec :: Int -> CostType -> ShowS
Show )


costTypeToExpr :: CostType -> Expr
costTypeToExpr :: CostType -> Expr
costTypeToExpr =
  String -> Expr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


-- | See <http://www.fast-downward.org/Doc/OpenList>
data OpenList
  = Alt AltConfiguration
  | EpsilonGreedy EpsilonGreedyConfiguration
  | Pareto ParetoConfiguration
  | Single SingleConfiguration
  | Tiebreaking TiebreakingConfiguration
  | TypeBased TypeBasedConfiguration


openListToExpr :: OpenList -> Expr
openListToExpr :: OpenList -> Expr
openListToExpr =
  \case
    Alt AltConfiguration
cfg ->
      AltConfiguration -> Expr
alt AltConfiguration
cfg

    EpsilonGreedy EpsilonGreedyConfiguration
cfg ->
      EpsilonGreedyConfiguration -> Expr
epsilonGreedy EpsilonGreedyConfiguration
cfg

    Pareto ParetoConfiguration
cfg ->
      ParetoConfiguration -> Expr
pareto ParetoConfiguration
cfg

    Single SingleConfiguration
cfg ->
      SingleConfiguration -> Expr
single SingleConfiguration
cfg

    Tiebreaking TiebreakingConfiguration
cfg ->
      TiebreakingConfiguration -> Expr
tiebreaking TiebreakingConfiguration
cfg

    TypeBased TypeBasedConfiguration
cfg ->
      TypeBasedConfiguration -> Expr
typeBased TypeBasedConfiguration
cfg


data PreferredOperatorUsage =
  PruneByPreferred | RankPreferredFirst


preferredUsageToExpr :: PreferredOperatorUsage -> Expr
preferredUsageToExpr :: PreferredOperatorUsage -> Expr
preferredUsageToExpr =
  \case
    PreferredOperatorUsage
PruneByPreferred ->
      String -> Expr
Lit String
"PRUNE_BY_PREFERRED"

    PreferredOperatorUsage
RankPreferredFirst ->
      String -> Expr
Lit String
"RANK_PREFERRED_FIRST"


-- | See <http://www.fast-downward.org/Doc/Evaluator#Additive_heuristic>
data AddConfiguration =
  AddConfiguration
    { AddConfiguration -> AbstractTask
transform :: AbstractTask
    , AddConfiguration -> Bool
cacheEstimates :: Bool
    }


add :: AddConfiguration -> Expr
add :: AddConfiguration -> Expr
add AddConfiguration{ AbstractTask
transform :: AbstractTask
$sel:transform:AddConfiguration :: AddConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:AddConfiguration :: AddConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"add"
    []
    [ AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Potential_heuristic_optimized_for_all_states>
data AllStatesPotentialConfiguration =
  AllStatesPotentialConfiguration
    { AllStatesPotentialConfiguration -> Maybe Double
maxPotential :: Maybe Double
    , AllStatesPotentialConfiguration -> LPSolver
lpSolver :: LPSolver
    , AllStatesPotentialConfiguration -> AbstractTask
transform :: AbstractTask
    , AllStatesPotentialConfiguration -> Bool
cacheEstimates :: Bool
    }


allStatesPotential :: AllStatesPotentialConfiguration -> Expr
allStatesPotential :: AllStatesPotentialConfiguration -> Expr
allStatesPotential AllStatesPotentialConfiguration{ Maybe Double
maxPotential :: Maybe Double
$sel:maxPotential:AllStatesPotentialConfiguration :: AllStatesPotentialConfiguration -> Maybe Double
maxPotential, LPSolver
lpSolver :: LPSolver
$sel:lpSolver:AllStatesPotentialConfiguration :: AllStatesPotentialConfiguration -> LPSolver
lpSolver, AbstractTask
transform :: AbstractTask
$sel:transform:AllStatesPotentialConfiguration :: AllStatesPotentialConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:AllStatesPotentialConfiguration :: AllStatesPotentialConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"all_states_potential"
    []
    [ Maybe Double -> (String, Expr)
maxPotentialOption Maybe Double
maxPotential
    , LPSolver -> (String, Expr)
lpSolverOption LPSolver
lpSolver
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Blind_heuristic>
data BlindConfiguration =
  BlindConfiguration
    { BlindConfiguration -> AbstractTask
transform :: AbstractTask
    , BlindConfiguration -> Bool
cacheEstimates :: Bool
    }


blind :: BlindConfiguration -> Expr
blind :: BlindConfiguration -> Expr
blind BlindConfiguration{ AbstractTask
transform :: AbstractTask
$sel:transform:BlindConfiguration :: BlindConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:BlindConfiguration :: BlindConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"blind"
    []
    [ AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Context-enhanced_additive_heuristic>
data CEAConfiguration =
  CEAConfiguration
    { CEAConfiguration -> AbstractTask
transform :: AbstractTask
    , CEAConfiguration -> Bool
cacheEstimates :: Bool
    }


cea :: CEAConfiguration -> Expr
cea :: CEAConfiguration -> Expr
cea CEAConfiguration{ AbstractTask
transform :: AbstractTask
$sel:transform:CEAConfiguration :: CEAConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:CEAConfiguration :: CEAConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"cea"
    []
    [ AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Additive_CEGAR_heuristic>
data CEGARConfiguration =
  CEGARConfiguration
    { CEGARConfiguration -> [SubtaskGenerator]
subtasks :: [ SubtaskGenerator ]
    , CEGARConfiguration -> Maybe Int
maxStates :: Maybe Int
    , CEGARConfiguration -> Maybe Int
maxTransitions :: Maybe Int
    , CEGARConfiguration -> Maybe Double
maxTime :: Maybe Double
    , CEGARConfiguration -> CEGARPick
pick :: CEGARPick
    , CEGARConfiguration -> Bool
useGeneralCosts :: Bool
    , CEGARConfiguration -> AbstractTask
transform :: AbstractTask
    , CEGARConfiguration -> Bool
cacheEstimates :: Bool
    , CEGARConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


cegar :: CEGARConfiguration -> Expr
cegar :: CEGARConfiguration -> Expr
cegar CEGARConfiguration{ [SubtaskGenerator]
subtasks :: [SubtaskGenerator]
$sel:subtasks:CEGARConfiguration :: CEGARConfiguration -> [SubtaskGenerator]
subtasks, Maybe Int
maxStates :: Maybe Int
$sel:maxStates:CEGARConfiguration :: CEGARConfiguration -> Maybe Int
maxStates, Maybe Int
maxTransitions :: Maybe Int
$sel:maxTransitions:CEGARConfiguration :: CEGARConfiguration -> Maybe Int
maxTransitions, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:CEGARConfiguration :: CEGARConfiguration -> Maybe Double
maxTime, CEGARPick
pick :: CEGARPick
$sel:pick:CEGARConfiguration :: CEGARConfiguration -> CEGARPick
pick, Bool
useGeneralCosts :: Bool
$sel:useGeneralCosts:CEGARConfiguration :: CEGARConfiguration -> Bool
useGeneralCosts, AbstractTask
transform :: AbstractTask
$sel:transform:CEGARConfiguration :: CEGARConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:CEGARConfiguration :: CEGARConfiguration -> Bool
cacheEstimates, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:CEGARConfiguration :: CEGARConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"cegar"
    []
    [ ( String
"subtasks", [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map SubtaskGenerator -> Expr
subtaskToExpr [SubtaskGenerator]
subtasks ) )
    , Maybe Int -> (String, Expr)
maxStatesOption Maybe Int
maxStates
    , ( String
"max_transitions", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
maxTransitions )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    , ( String
"pick", CEGARPick -> Expr
cegarPickToExpr CEGARPick
pick )
    , ( String
"use_general_costs", Bool -> Expr
boolToExpr Bool
useGeneralCosts )
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Causal_graph_heuristic>
data CGConfiguration =
  CGConfiguration
    { CGConfiguration -> AbstractTask
transform :: AbstractTask
    , CGConfiguration -> Bool
cacheEstimates :: Bool
    }


cg :: CGConfiguration -> Expr
cg :: CGConfiguration -> Expr
cg CGConfiguration{ AbstractTask
transform :: AbstractTask
$sel:transform:CGConfiguration :: CGConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:CGConfiguration :: CGConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"cg"
    []
    [ AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Diverse_potential_heuristics>
data DiversePotentialsConfiguration =
  DiversePotentialsConfiguration
    { DiversePotentialsConfiguration -> Maybe Int
numSamples :: Maybe Int
    , DiversePotentialsConfiguration -> Maybe Int
maxNumHeuristics :: Maybe Int
    , DiversePotentialsConfiguration -> Maybe Double
maxPotential :: Maybe Double
    , DiversePotentialsConfiguration -> LPSolver
lpSolver :: LPSolver
    , DiversePotentialsConfiguration -> AbstractTask
transform :: AbstractTask
    , DiversePotentialsConfiguration -> Bool
cacheEstimates :: Bool
    , DiversePotentialsConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


diversePotentials :: DiversePotentialsConfiguration -> Expr
diversePotentials :: DiversePotentialsConfiguration -> Expr
diversePotentials DiversePotentialsConfiguration{ Maybe Int
numSamples :: Maybe Int
$sel:numSamples:DiversePotentialsConfiguration :: DiversePotentialsConfiguration -> Maybe Int
numSamples, Maybe Int
maxNumHeuristics :: Maybe Int
$sel:maxNumHeuristics:DiversePotentialsConfiguration :: DiversePotentialsConfiguration -> Maybe Int
maxNumHeuristics, Maybe Double
maxPotential :: Maybe Double
$sel:maxPotential:DiversePotentialsConfiguration :: DiversePotentialsConfiguration -> Maybe Double
maxPotential, LPSolver
lpSolver :: LPSolver
$sel:lpSolver:DiversePotentialsConfiguration :: DiversePotentialsConfiguration -> LPSolver
lpSolver, AbstractTask
transform :: AbstractTask
$sel:transform:DiversePotentialsConfiguration :: DiversePotentialsConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:DiversePotentialsConfiguration :: DiversePotentialsConfiguration -> Bool
cacheEstimates, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:DiversePotentialsConfiguration :: DiversePotentialsConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"diverse_potentials"
    []
    [ ( String
"num_samples", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
numSamples )
    , ( String
"max_num_heuristics", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
maxNumHeuristics )
    , ( String
"max_potential", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Double -> Expr
doubleToExpr Maybe Double
maxPotential )
    , LPSolver -> (String, Expr)
lpSolverOption LPSolver
lpSolver
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#FF_heuristic>
data FFConfiguration =
  FFConfiguration
    { FFConfiguration -> AbstractTask
transform :: AbstractTask
    , FFConfiguration -> Bool
cacheEstimates :: Bool
    }


ff :: FFConfiguration -> Expr
ff :: FFConfiguration -> Expr
ff FFConfiguration{ AbstractTask
transform :: AbstractTask
$sel:transform:FFConfiguration :: FFConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:FFConfiguration :: FFConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"ff"
    []
    [ AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Goal_count_heuristic>
data GoalCountConfiguration =
  GoalCountConfiguration
    { GoalCountConfiguration -> AbstractTask
transform :: AbstractTask
    , GoalCountConfiguration -> Bool
cacheEstimates :: Bool
    }


goalCount :: GoalCountConfiguration -> Expr
goalCount :: GoalCountConfiguration -> Expr
goalCount GoalCountConfiguration{ AbstractTask
transform :: AbstractTask
$sel:transform:GoalCountConfiguration :: GoalCountConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:GoalCountConfiguration :: GoalCountConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"goalcount"
    []
    [ AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#h.5Em_heuristic>
data HMConfiguration =
  HMConfiguration
    { HMConfiguration -> Int
m :: Int
    , HMConfiguration -> AbstractTask
transform :: AbstractTask
    , HMConfiguration -> Bool
cacheEstimates :: Bool
    }


hm :: HMConfiguration -> Expr
hm :: HMConfiguration -> Expr
hm HMConfiguration{ Int
m :: Int
$sel:m:HMConfiguration :: HMConfiguration -> Int
m, AbstractTask
transform :: AbstractTask
$sel:transform:HMConfiguration :: HMConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:HMConfiguration :: HMConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"hm"
    []
    [ ( String
"m", Int -> Expr
intToExpr Int
m )
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Max_heuristic>
data HMaxConfiguration =
  HMaxConfiguration
    { HMaxConfiguration -> AbstractTask
transform :: AbstractTask
    , HMaxConfiguration -> Bool
cacheEstimates :: Bool
    }


hmax :: HMaxConfiguration -> Expr
hmax :: HMaxConfiguration -> Expr
hmax HMaxConfiguration{ AbstractTask
transform :: AbstractTask
$sel:transform:HMaxConfiguration :: HMaxConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:HMaxConfiguration :: HMaxConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"hmax"
    []
    [ AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Potential_heuristic_optimized_for_initial_state>
data InitialStatePotentialConfiguration =
  InitialStatePotentialConfiguration
    { InitialStatePotentialConfiguration -> Maybe Double
maxPotential :: Maybe Double
    , InitialStatePotentialConfiguration -> LPSolver
lpSolver :: LPSolver
    , InitialStatePotentialConfiguration -> AbstractTask
transform :: AbstractTask
    , InitialStatePotentialConfiguration -> Bool
cacheEstimates :: Bool
    }


initialStatePotential :: InitialStatePotentialConfiguration -> Expr
initialStatePotential :: InitialStatePotentialConfiguration -> Expr
initialStatePotential InitialStatePotentialConfiguration{ Maybe Double
maxPotential :: Maybe Double
$sel:maxPotential:InitialStatePotentialConfiguration :: InitialStatePotentialConfiguration -> Maybe Double
maxPotential, LPSolver
lpSolver :: LPSolver
$sel:lpSolver:InitialStatePotentialConfiguration :: InitialStatePotentialConfiguration -> LPSolver
lpSolver, AbstractTask
transform :: AbstractTask
$sel:transform:InitialStatePotentialConfiguration :: InitialStatePotentialConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:InitialStatePotentialConfiguration :: InitialStatePotentialConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"initial_state_potential"
    []
    [ Maybe Double -> (String, Expr)
maxPotentialOption Maybe Double
maxPotential
    , LPSolver -> (String, Expr)
lpSolverOption LPSolver
lpSolver
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Landmark-count_heuristic>
data LMCountConfiguration =
  LMCountConfiguration
    { LMCountConfiguration -> LandmarkFactory
lmFactory :: LandmarkFactory
    , LMCountConfiguration -> Bool
admissible :: Bool
    , LMCountConfiguration -> Bool
optimal :: Bool
    , LMCountConfiguration -> Bool
pref :: Bool
    , LMCountConfiguration -> Bool
alm :: Bool
    , LMCountConfiguration -> LPSolver
lpSolver :: LPSolver
    , LMCountConfiguration -> AbstractTask
transform :: AbstractTask
    , LMCountConfiguration -> Bool
cacheEstimates :: Bool
    }


lmcount :: LMCountConfiguration -> Expr
lmcount :: LMCountConfiguration -> Expr
lmcount LMCountConfiguration{ LandmarkFactory
lmFactory :: LandmarkFactory
$sel:lmFactory:LMCountConfiguration :: LMCountConfiguration -> LandmarkFactory
lmFactory, Bool
admissible :: Bool
$sel:admissible:LMCountConfiguration :: LMCountConfiguration -> Bool
admissible, Bool
optimal :: Bool
$sel:optimal:LMCountConfiguration :: LMCountConfiguration -> Bool
optimal, Bool
pref :: Bool
$sel:pref:LMCountConfiguration :: LMCountConfiguration -> Bool
pref, Bool
alm :: Bool
$sel:alm:LMCountConfiguration :: LMCountConfiguration -> Bool
alm, LPSolver
lpSolver :: LPSolver
$sel:lpSolver:LMCountConfiguration :: LMCountConfiguration -> LPSolver
lpSolver, AbstractTask
transform :: AbstractTask
$sel:transform:LMCountConfiguration :: LMCountConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:LMCountConfiguration :: LMCountConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lmcount"
    [ LandmarkFactory -> Expr
landmarkFactoryToExpr LandmarkFactory
lmFactory ]
    [ ( String
"admissible", Bool -> Expr
boolToExpr Bool
admissible )
    , ( String
"optimal", Bool -> Expr
boolToExpr Bool
optimal )
    , ( String
"pref", Bool -> Expr
boolToExpr Bool
pref )
    , ( String
"alm", Bool -> Expr
boolToExpr Bool
alm )
    , LPSolver -> (String, Expr)
lpSolverOption LPSolver
lpSolver
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Landmark-cut_heuristic>
data LMCutConfiguration =
  LMCutConfiguration
    { LMCutConfiguration -> AbstractTask
transform :: AbstractTask
    , LMCutConfiguration -> Bool
cacheEstimates :: Bool
    }


lmcut :: LMCutConfiguration -> Expr
lmcut :: LMCutConfiguration -> Expr
lmcut LMCutConfiguration{ AbstractTask
transform :: AbstractTask
$sel:transform:LMCutConfiguration :: LMCutConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:LMCutConfiguration :: LMCutConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lmcut"
    []
    [ AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Merge-and-shrink_heuristic>
data MergeAndShrinkConfiguration =
  MergeAndShrinkConfiguration
    { MergeAndShrinkConfiguration -> AbstractTask
transform :: AbstractTask
    , MergeAndShrinkConfiguration -> Bool
cacheEstimates :: Bool
    , MergeAndShrinkConfiguration -> MergeStrategy
mergeStrategy :: MergeStrategy
    , MergeAndShrinkConfiguration -> ShrinkStrategy
shrinkStrategy :: ShrinkStrategy
    , MergeAndShrinkConfiguration -> LabelReduction
labelReduction :: LabelReduction
    , MergeAndShrinkConfiguration -> Bool
pruneUnreachableStates :: Bool
    , MergeAndShrinkConfiguration -> Bool
pruneIrrelevantStates :: Bool
    , MergeAndShrinkConfiguration -> Maybe Int
maxStates :: Maybe Int
    , MergeAndShrinkConfiguration -> Maybe Int
maxStatesBeforeMerge :: Maybe Int
    , MergeAndShrinkConfiguration -> Maybe Int
thresholdBeforeMerge :: Maybe Int
    , MergeAndShrinkConfiguration -> Verbosity
verbosity :: Verbosity
    }


mergeAndShrink :: MergeAndShrinkConfiguration -> Expr
mergeAndShrink :: MergeAndShrinkConfiguration -> Expr
mergeAndShrink MergeAndShrinkConfiguration{ AbstractTask
transform :: AbstractTask
$sel:transform:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> Bool
cacheEstimates, MergeStrategy
mergeStrategy :: MergeStrategy
$sel:mergeStrategy:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> MergeStrategy
mergeStrategy, ShrinkStrategy
shrinkStrategy :: ShrinkStrategy
$sel:shrinkStrategy:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> ShrinkStrategy
shrinkStrategy, LabelReduction
labelReduction :: LabelReduction
$sel:labelReduction:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> LabelReduction
labelReduction, Bool
pruneUnreachableStates :: Bool
$sel:pruneUnreachableStates:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> Bool
pruneUnreachableStates, Bool
pruneIrrelevantStates :: Bool
$sel:pruneIrrelevantStates:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> Bool
pruneIrrelevantStates, Maybe Int
maxStates :: Maybe Int
$sel:maxStates:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> Maybe Int
maxStates, Maybe Int
maxStatesBeforeMerge :: Maybe Int
$sel:maxStatesBeforeMerge:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> Maybe Int
maxStatesBeforeMerge, Maybe Int
thresholdBeforeMerge :: Maybe Int
$sel:thresholdBeforeMerge:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> Maybe Int
thresholdBeforeMerge, Verbosity
verbosity :: Verbosity
$sel:verbosity:MergeAndShrinkConfiguration :: MergeAndShrinkConfiguration -> Verbosity
verbosity } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"merge_and_shrink"
    []
    [ AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    , ( String
"merge_strategy", MergeStrategy -> Expr
mergeStrategyToExpr MergeStrategy
mergeStrategy )
    , ( String
"shrink_strategy", ShrinkStrategy -> Expr
shrinkStrategyToExpr ShrinkStrategy
shrinkStrategy )
    , ( String
"label_reduction", LabelReduction -> Expr
labelReductionToExpr LabelReduction
labelReduction )
    , ( String
"prune_unreachable_states", Bool -> Expr
boolToExpr Bool
pruneUnreachableStates )
    , ( String
"prune_irrelevant_states", Bool -> Expr
boolToExpr Bool
pruneIrrelevantStates )
    , Maybe Int -> (String, Expr)
maxStatesOption Maybe Int
maxStates
    , Maybe Int -> (String, Expr)
maxStatesBeforeMergeOption Maybe Int
maxStatesBeforeMerge
    , Maybe Int -> (String, Expr)
thresholdBeforeMergeOption Maybe Int
thresholdBeforeMerge
    , ( String
"verbosity", Verbosity -> Expr
verbosityToExpr Verbosity
verbosity )
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Operator_counting_heuristic>
data OperatorCountingConfiguration =
  OperatorCountingConfiguration
    { OperatorCountingConfiguration -> [ConstraintGenerator]
constraintGenerators :: [ ConstraintGenerator ]
    , OperatorCountingConfiguration -> LPSolver
lpSolver :: LPSolver
    , OperatorCountingConfiguration -> AbstractTask
transform :: AbstractTask
    , OperatorCountingConfiguration -> Bool
cacheEstimates :: Bool
    }


operatorCounting :: OperatorCountingConfiguration -> Expr
operatorCounting :: OperatorCountingConfiguration -> Expr
operatorCounting OperatorCountingConfiguration{ [ConstraintGenerator]
constraintGenerators :: [ConstraintGenerator]
$sel:constraintGenerators:OperatorCountingConfiguration :: OperatorCountingConfiguration -> [ConstraintGenerator]
constraintGenerators, LPSolver
lpSolver :: LPSolver
$sel:lpSolver:OperatorCountingConfiguration :: OperatorCountingConfiguration -> LPSolver
lpSolver, AbstractTask
transform :: AbstractTask
$sel:transform:OperatorCountingConfiguration :: OperatorCountingConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:OperatorCountingConfiguration :: OperatorCountingConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"operatorcounting"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map ConstraintGenerator -> Expr
constraintGeneratorToExpr [ConstraintGenerator]
constraintGenerators ) ]
    [ LPSolver -> (String, Expr)
lpSolverOption LPSolver
lpSolver
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Sample-based_potential_heuristics>
data SampleBasedPotentialsConfiguration =
  SampleBasedPotentialsConfiguration
    { SampleBasedPotentialsConfiguration -> Maybe Int
numHeuristics :: Maybe Int
    , SampleBasedPotentialsConfiguration -> Maybe Int
numSamples :: Maybe Int
    , SampleBasedPotentialsConfiguration -> Maybe Double
maxPotential :: Maybe Double
    , SampleBasedPotentialsConfiguration -> LPSolver
lpSolver :: LPSolver
    , SampleBasedPotentialsConfiguration -> AbstractTask
transform :: AbstractTask
    , SampleBasedPotentialsConfiguration -> Bool
cacheEstimates :: Bool
    , SampleBasedPotentialsConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


sampleBasedPotentials :: SampleBasedPotentialsConfiguration -> Expr
sampleBasedPotentials :: SampleBasedPotentialsConfiguration -> Expr
sampleBasedPotentials SampleBasedPotentialsConfiguration{ Maybe Int
numHeuristics :: Maybe Int
$sel:numHeuristics:SampleBasedPotentialsConfiguration :: SampleBasedPotentialsConfiguration -> Maybe Int
numHeuristics, Maybe Int
numSamples :: Maybe Int
$sel:numSamples:SampleBasedPotentialsConfiguration :: SampleBasedPotentialsConfiguration -> Maybe Int
numSamples, Maybe Double
maxPotential :: Maybe Double
$sel:maxPotential:SampleBasedPotentialsConfiguration :: SampleBasedPotentialsConfiguration -> Maybe Double
maxPotential, LPSolver
lpSolver :: LPSolver
$sel:lpSolver:SampleBasedPotentialsConfiguration :: SampleBasedPotentialsConfiguration -> LPSolver
lpSolver, AbstractTask
transform :: AbstractTask
$sel:transform:SampleBasedPotentialsConfiguration :: SampleBasedPotentialsConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:SampleBasedPotentialsConfiguration :: SampleBasedPotentialsConfiguration -> Bool
cacheEstimates, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:SampleBasedPotentialsConfiguration :: SampleBasedPotentialsConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"sample_based_potentials"
    []
    [ ( String
"num_heuristics", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
numHeuristics )
    , ( String
"num_samples", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
numSamples )
    , ( String
"max_potential", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Double -> Expr
doubleToExpr Maybe Double
maxPotential )
    , LPSolver -> (String, Expr)
lpSolverOption LPSolver
lpSolver
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Canonical_PDB>
data CanonicalPDBConfiguration =
  CanonicalPDBConfiguration
    { CanonicalPDBConfiguration -> PatternCollectionGenerator
patterns :: PatternCollectionGenerator
    , CanonicalPDBConfiguration -> Maybe Double
maxTimeDominancePruning :: Maybe Double
    , CanonicalPDBConfiguration -> AbstractTask
transform :: AbstractTask
    , CanonicalPDBConfiguration -> Bool
cacheEstimates :: Bool
    }


cpdbs :: CanonicalPDBConfiguration -> Expr
cpdbs :: CanonicalPDBConfiguration -> Expr
cpdbs CanonicalPDBConfiguration{ PatternCollectionGenerator
patterns :: PatternCollectionGenerator
$sel:patterns:CanonicalPDBConfiguration :: CanonicalPDBConfiguration -> PatternCollectionGenerator
patterns, Maybe Double
maxTimeDominancePruning :: Maybe Double
$sel:maxTimeDominancePruning:CanonicalPDBConfiguration :: CanonicalPDBConfiguration -> Maybe Double
maxTimeDominancePruning, AbstractTask
transform :: AbstractTask
$sel:transform:CanonicalPDBConfiguration :: CanonicalPDBConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:CanonicalPDBConfiguration :: CanonicalPDBConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"cpdbs"
    []
    [ ( String
"patterns", PatternCollectionGenerator -> Expr
patternCollectionGeneratorToExpr PatternCollectionGenerator
patterns )
    , ( String
"max_time_dominance_pruning", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Double -> Expr
doubleToExpr Maybe Double
maxTimeDominancePruning )
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#iPDB>
data IPDBConfiguration =
  IPDBConfiguration
    { IPDBConfiguration -> Maybe Int
pdbMaxSize :: Maybe Int
    , IPDBConfiguration -> Maybe Int
collectionMaxSize :: Maybe Int
    , IPDBConfiguration -> Maybe Int
numSamples :: Maybe Int
    , IPDBConfiguration -> Maybe Int
minImprovement :: Maybe Int
    , IPDBConfiguration -> Maybe Double
maxTime :: Maybe Double
    , IPDBConfiguration -> Maybe Int
randomSeed :: Maybe Int
    , IPDBConfiguration -> Maybe Double
maxTimeDominancePruning :: Maybe Double
    , IPDBConfiguration -> AbstractTask
transform :: AbstractTask
    , IPDBConfiguration -> Bool
cacheEstimates :: Bool
    }


ipdb :: IPDBConfiguration -> Expr
ipdb :: IPDBConfiguration -> Expr
ipdb IPDBConfiguration{ Maybe Int
pdbMaxSize :: Maybe Int
$sel:pdbMaxSize:IPDBConfiguration :: IPDBConfiguration -> Maybe Int
pdbMaxSize, Maybe Int
collectionMaxSize :: Maybe Int
$sel:collectionMaxSize:IPDBConfiguration :: IPDBConfiguration -> Maybe Int
collectionMaxSize, Maybe Int
numSamples :: Maybe Int
$sel:numSamples:IPDBConfiguration :: IPDBConfiguration -> Maybe Int
numSamples, Maybe Int
minImprovement :: Maybe Int
$sel:minImprovement:IPDBConfiguration :: IPDBConfiguration -> Maybe Int
minImprovement, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:IPDBConfiguration :: IPDBConfiguration -> Maybe Double
maxTime, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:IPDBConfiguration :: IPDBConfiguration -> Maybe Int
randomSeed, Maybe Double
maxTimeDominancePruning :: Maybe Double
$sel:maxTimeDominancePruning:IPDBConfiguration :: IPDBConfiguration -> Maybe Double
maxTimeDominancePruning, AbstractTask
transform :: AbstractTask
$sel:transform:IPDBConfiguration :: IPDBConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:IPDBConfiguration :: IPDBConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"ipdb"
    []
    [ Maybe Int -> (String, Expr)
pdbMaxSizeOption Maybe Int
pdbMaxSize
    , ( String
"collection_max_size", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
collectionMaxSize )
    , ( String
"num_samples", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
numSamples )
    , ( String
"min_improvement", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
minImprovement )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    , ( String
"max_time_dominance_pruning", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Double -> Expr
doubleToExpr Maybe Double
maxTimeDominancePruning )
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/Evaluator#Zero-One_PDB>
data ZeroOnePDBConfiguration =
  ZeroOnePDBConfiguration
    { ZeroOnePDBConfiguration -> PatternCollectionGenerator
patterns :: PatternCollectionGenerator
    , ZeroOnePDBConfiguration -> AbstractTask
transform :: AbstractTask
    , ZeroOnePDBConfiguration -> Bool
cacheEstimates :: Bool
    }


zopdbs :: ZeroOnePDBConfiguration -> Expr
zopdbs :: ZeroOnePDBConfiguration -> Expr
zopdbs ZeroOnePDBConfiguration{ PatternCollectionGenerator
patterns :: PatternCollectionGenerator
$sel:patterns:ZeroOnePDBConfiguration :: ZeroOnePDBConfiguration -> PatternCollectionGenerator
patterns, AbstractTask
transform :: AbstractTask
$sel:transform:ZeroOnePDBConfiguration :: ZeroOnePDBConfiguration -> AbstractTask
transform, Bool
cacheEstimates :: Bool
$sel:cacheEstimates:ZeroOnePDBConfiguration :: ZeroOnePDBConfiguration -> Bool
cacheEstimates } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"zopdbs"
    []
    [ ( String
"patterns", PatternCollectionGenerator -> Expr
patternCollectionGeneratorToExpr PatternCollectionGenerator
patterns )
    , AbstractTask -> (String, Expr)
transformExpr AbstractTask
transform
    , Bool -> (String, Expr)
cacheEstimatesExpr Bool
cacheEstimates
    ]


-- | See <http://www.fast-downward.org/Doc/PruningMethod#StubbornSetsEC>
data StubbornSetsConfiguration =
  StubbornSetsConfiguration
    { StubbornSetsConfiguration -> Ratio Int
minRequiredPruningRatio :: Ratio Int
    , StubbornSetsConfiguration -> Maybe Int
expansionsBeforeCheckingPruningRatio :: Maybe Int
    }


stubbornSetsOptions :: StubbornSetsConfiguration -> [ ( String, Expr ) ]
stubbornSetsOptions :: StubbornSetsConfiguration -> [(String, Expr)]
stubbornSetsOptions StubbornSetsConfiguration{ Ratio Int
minRequiredPruningRatio :: Ratio Int
$sel:minRequiredPruningRatio:StubbornSetsConfiguration :: StubbornSetsConfiguration -> Ratio Int
minRequiredPruningRatio, Maybe Int
expansionsBeforeCheckingPruningRatio :: Maybe Int
$sel:expansionsBeforeCheckingPruningRatio:StubbornSetsConfiguration :: StubbornSetsConfiguration -> Maybe Int
expansionsBeforeCheckingPruningRatio } =
  [ ( String
"min_required_pruning_ratio", Double -> Expr
doubleToExpr ( forall a b. (Real a, Fractional b) => a -> b
realToFrac Ratio Int
minRequiredPruningRatio ) )
  , ( String
"expansions_before_checking_pruning_ratio", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
expansionsBeforeCheckingPruningRatio )
  ]


stubbornSetsEc :: StubbornSetsConfiguration -> Expr
stubbornSetsEc :: StubbornSetsConfiguration -> Expr
stubbornSetsEc =
  String -> [Expr] -> [(String, Expr)] -> Expr
App String
"stubborn_sets_ec" [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. StubbornSetsConfiguration -> [(String, Expr)]
stubbornSetsOptions


stubbornSetsSimple :: StubbornSetsConfiguration -> Expr
stubbornSetsSimple :: StubbornSetsConfiguration -> Expr
stubbornSetsSimple =
  String -> [Expr] -> [(String, Expr)] -> Expr
App String
"stubborn_sets_simple" [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. StubbornSetsConfiguration -> [(String, Expr)]
stubbornSetsOptions


-- | See <http://www.fast-downward.org/Doc/OpenList#Alternation_open_list>
data AltConfiguration =
  AltConfiguration
    { AltConfiguration -> [OpenList]
sublists :: [ OpenList ]
    , AltConfiguration -> Int
boost :: Int
    }


alt :: AltConfiguration -> Expr
alt :: AltConfiguration -> Expr
alt AltConfiguration{ [OpenList]
sublists :: [OpenList]
$sel:sublists:AltConfiguration :: AltConfiguration -> [OpenList]
sublists, Int
boost :: Int
$sel:boost:AltConfiguration :: AltConfiguration -> Int
boost } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"alt"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map OpenList -> Expr
openListToExpr [OpenList]
sublists ) ]
    [ ( String
"boost", Int -> Expr
intToExpr Int
boost ) ]


-- | See <http://www.fast-downward.org/Doc/OpenList#Epsilon-greedy_open_list>
data EpsilonGreedyConfiguration =
  EpsilonGreedyConfiguration
    { EpsilonGreedyConfiguration -> Evaluator
eval :: Evaluator
    , EpsilonGreedyConfiguration -> Bool
prefOnly :: Bool
    , EpsilonGreedyConfiguration -> Ratio Int
epsilon :: Ratio Int
    , EpsilonGreedyConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


epsilonGreedy :: EpsilonGreedyConfiguration -> Expr
epsilonGreedy :: EpsilonGreedyConfiguration -> Expr
epsilonGreedy EpsilonGreedyConfiguration{ Evaluator
eval :: Evaluator
$sel:eval:EpsilonGreedyConfiguration :: EpsilonGreedyConfiguration -> Evaluator
eval, Bool
prefOnly :: Bool
$sel:prefOnly:EpsilonGreedyConfiguration :: EpsilonGreedyConfiguration -> Bool
prefOnly, Ratio Int
epsilon :: Ratio Int
$sel:epsilon:EpsilonGreedyConfiguration :: EpsilonGreedyConfiguration -> Ratio Int
epsilon, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:EpsilonGreedyConfiguration :: EpsilonGreedyConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"epsilon_greedy"
    [ Evaluator -> Expr
evaluatorToExpr Evaluator
eval ]
    [ Bool -> (String, Expr)
prefOnlyExpr Bool
prefOnly
    , ( String
"epsilon", Double -> Expr
doubleToExpr ( forall a b. (Real a, Fractional b) => a -> b
realToFrac Ratio Int
epsilon ) )
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


-- | See <http://www.fast-downward.org/Doc/OpenList#Pareto_open_list>
data ParetoConfiguration =
  ParetoConfiguration
    { ParetoConfiguration -> [Evaluator]
evals :: [ Evaluator ]
    , ParetoConfiguration -> Bool
prefOnly :: Bool
    , ParetoConfiguration -> Bool
stateUniformSelection :: Bool
    , ParetoConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


pareto :: ParetoConfiguration -> Expr
pareto :: ParetoConfiguration -> Expr
pareto ParetoConfiguration{ [Evaluator]
evals :: [Evaluator]
$sel:evals:ParetoConfiguration :: ParetoConfiguration -> [Evaluator]
evals, Bool
prefOnly :: Bool
$sel:prefOnly:ParetoConfiguration :: ParetoConfiguration -> Bool
prefOnly, Bool
stateUniformSelection :: Bool
$sel:stateUniformSelection:ParetoConfiguration :: ParetoConfiguration -> Bool
stateUniformSelection, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:ParetoConfiguration :: ParetoConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"pareto_configuration"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
evals ) ]
    [ Bool -> (String, Expr)
prefOnlyExpr Bool
prefOnly
    , ( String
"state_uniform_selection", Bool -> Expr
boolToExpr Bool
stateUniformSelection )
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


-- | See <http://www.fast-downward.org/Doc/OpenList#Standard_open_list>
data SingleConfiguration =
  SingleConfiguration
    { SingleConfiguration -> Evaluator
eval :: Evaluator
    , SingleConfiguration -> Bool
prefOnly :: Bool
    }


single :: SingleConfiguration -> Expr
single :: SingleConfiguration -> Expr
single SingleConfiguration{ Evaluator
eval :: Evaluator
$sel:eval:SingleConfiguration :: SingleConfiguration -> Evaluator
eval, Bool
prefOnly :: Bool
$sel:prefOnly:SingleConfiguration :: SingleConfiguration -> Bool
prefOnly } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App String
"single" [ Evaluator -> Expr
evaluatorToExpr Evaluator
eval ] [ Bool -> (String, Expr)
prefOnlyExpr Bool
prefOnly ]


-- | See <http://www.fast-downward.org/Doc/OpenList#Tie-breaking_open_list>
data TiebreakingConfiguration =
  TiebreakingConfiguration
    { TiebreakingConfiguration -> [Evaluator]
evals :: [ Evaluator ]
    , TiebreakingConfiguration -> Bool
prefOnly :: Bool
    , TiebreakingConfiguration -> Bool
unsafePruning :: Bool
    }


tiebreaking :: TiebreakingConfiguration -> Expr
tiebreaking :: TiebreakingConfiguration -> Expr
tiebreaking TiebreakingConfiguration{ [Evaluator]
evals :: [Evaluator]
$sel:evals:TiebreakingConfiguration :: TiebreakingConfiguration -> [Evaluator]
evals, Bool
prefOnly :: Bool
$sel:prefOnly:TiebreakingConfiguration :: TiebreakingConfiguration -> Bool
prefOnly, Bool
unsafePruning :: Bool
$sel:unsafePruning:TiebreakingConfiguration :: TiebreakingConfiguration -> Bool
unsafePruning } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"tiebreaking"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
evals ) ]
    [ Bool -> (String, Expr)
prefOnlyExpr Bool
prefOnly
    , ( String
"unsafe_pruning", Bool -> Expr
boolToExpr Bool
unsafePruning )
    ]


-- | See <http://www.fast-downward.org/Doc/OpenList#Type-based_open_list>
data TypeBasedConfiguration =
  TypeBasedConfiguration
    { TypeBasedConfiguration -> [Evaluator]
evaluators :: [ Evaluator ]
    , TypeBasedConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


typeBased :: TypeBasedConfiguration -> Expr
typeBased :: TypeBasedConfiguration -> Expr
typeBased TypeBasedConfiguration{ [Evaluator]
evaluators :: [Evaluator]
$sel:evaluators:TypeBasedConfiguration :: TypeBasedConfiguration -> [Evaluator]
evaluators, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:TypeBasedConfiguration :: TypeBasedConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"type_based"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map Evaluator -> Expr
evaluatorToExpr [Evaluator]
evaluators ) ]
    [ Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed ]


-- | See <http://www.fast-downward.org/Doc/AbstractTask>
data AbstractTask
  = AdaptCost CostType
  | NoTransform


abstractTaskToExpr :: AbstractTask -> Expr
abstractTaskToExpr :: AbstractTask -> Expr
abstractTaskToExpr =
  \case
    AbstractTask
NoTransform ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"no_transform" [] []

    AdaptCost CostType
ct ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"adapt_cost" [] [ ( String
"cost_type", CostType -> Expr
costTypeToExpr CostType
ct ) ]


data LPSolver
  = CLP
  | CPLEX
  | GUROBI
  deriving
    ( Int -> LPSolver -> ShowS
[LPSolver] -> ShowS
LPSolver -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LPSolver] -> ShowS
$cshowList :: [LPSolver] -> ShowS
show :: LPSolver -> String
$cshow :: LPSolver -> String
showsPrec :: Int -> LPSolver -> ShowS
$cshowsPrec :: Int -> LPSolver -> ShowS
Show )


lpSolverToExpr :: LPSolver -> Expr
lpSolverToExpr :: LPSolver -> Expr
lpSolverToExpr =
  String -> Expr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


-- | See <http://www.fast-downward.org/Doc/SubtaskGenerator>
data SubtaskGenerator
  = Goals GoalsConfiguration
  | Landmarks LandmarksConfiguration
  | Original OriginalConfiguration


subtaskToExpr :: SubtaskGenerator -> Expr
subtaskToExpr :: SubtaskGenerator -> Expr
subtaskToExpr =
  \case
    Goals GoalsConfiguration
cfg ->
      GoalsConfiguration -> Expr
goals GoalsConfiguration
cfg

    Landmarks LandmarksConfiguration
cfg ->
      LandmarksConfiguration -> Expr
landmarks LandmarksConfiguration
cfg

    Original OriginalConfiguration
cfg ->
      OriginalConfiguration -> Expr
original OriginalConfiguration
cfg


data CEGARPick
  = Random
  | MinUnwanted
  | MaxUnwanted
  | MinRefined
  | MaxRefined
  | MinHAdd
  | MaxHAdd


cegarPickToExpr :: CEGARPick -> Expr
cegarPickToExpr :: CEGARPick -> Expr
cegarPickToExpr =
  \case
    CEGARPick
Random ->
      String -> Expr
Lit String
"RANDOM"

    CEGARPick
MinUnwanted ->
      String -> Expr
Lit String
"MIN_UNWANTED"

    CEGARPick
MaxUnwanted ->
      String -> Expr
Lit String
"MAX_UNWANTED"

    CEGARPick
MinRefined ->
      String -> Expr
Lit String
"MIN_REFINED"

    CEGARPick
MaxRefined ->
      String -> Expr
Lit String
"MX_REFINED"

    CEGARPick
MinHAdd ->
      String -> Expr
Lit String
"MIN_HADD"

    CEGARPick
MaxHAdd ->
      String -> Expr
Lit String
"MAX_HADD"


-- | See <http://www.fast-downward.org/Doc/LandmarkFactory>
data LandmarkFactory
  = LMExhaust LMExhaustConfiguration
  | LMHM LMHMConfiguration
  | LMMerged LMMergedConfiguration
  | LMRHW LMRHWConfiguration
  | LMZG LMZGConfiguration


landmarkFactoryToExpr :: LandmarkFactory -> Expr
landmarkFactoryToExpr :: LandmarkFactory -> Expr
landmarkFactoryToExpr =
  \case
    LMExhaust LMExhaustConfiguration
cfg ->
      LMExhaustConfiguration -> Expr
lmexhaust LMExhaustConfiguration
cfg

    LMHM LMHMConfiguration
cfg ->
      LMHMConfiguration -> Expr
lmhm LMHMConfiguration
cfg

    LMMerged LMMergedConfiguration
cfg ->
      LMMergedConfiguration -> Expr
lmMerged LMMergedConfiguration
cfg

    LMRHW LMRHWConfiguration
cfg ->
      LMRHWConfiguration -> Expr
lmRHW LMRHWConfiguration
cfg

    LMZG LMZGConfiguration
cfg ->
      LMZGConfiguration -> Expr
lmzg LMZGConfiguration
cfg


-- | See <http://www.fast-downward.org/Doc/MergeStrategy>
data MergeStrategy
  = MergePrecomputed MergeTree
  | MergeSCCs MergeSCCsConfiguration
  | MergeStateless MergeSelector


mergeStrategyToExpr :: MergeStrategy -> Expr
mergeStrategyToExpr :: MergeStrategy -> Expr
mergeStrategyToExpr =
  \case
    MergePrecomputed MergeTree
cfg ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"merge_precomputed" [ MergeTree -> Expr
mergeTreeToExpr MergeTree
cfg ] []

    MergeSCCs MergeSCCsConfiguration
cfg ->
      MergeSCCsConfiguration -> Expr
mergeSCCs MergeSCCsConfiguration
cfg

    MergeStateless MergeSelector
cfg ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"merge_stateless" [ MergeSelector -> Expr
mergeSelectorToExpr MergeSelector
cfg ] []


-- | See <http://www.fast-downward.org/Doc/ShrinkStrategy>
data ShrinkStrategy
  = Bisimulation BisimulationConfiguration
  | FPreserving FPreservingConfiguration
  | RandomShrink ( Maybe Int )


shrinkStrategyToExpr :: ShrinkStrategy -> Expr
shrinkStrategyToExpr :: ShrinkStrategy -> Expr
shrinkStrategyToExpr =
  \case
    Bisimulation BisimulationConfiguration
cfg ->
      BisimulationConfiguration -> Expr
bisimulation BisimulationConfiguration
cfg

    FPreserving FPreservingConfiguration
cfg ->
      FPreservingConfiguration -> Expr
fPreserving FPreservingConfiguration
cfg

    RandomShrink Maybe Int
randomSeed ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"shrink_random" [] [ Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed ]


newtype LabelReduction
  = ExactGeneralizedLabelReduction ExactGeneralizedLabelReductionConfiguration


labelReductionToExpr :: LabelReduction -> Expr
labelReductionToExpr :: LabelReduction -> Expr
labelReductionToExpr ( ExactGeneralizedLabelReduction ExactGeneralizedLabelReductionConfiguration
cfg ) =
  ExactGeneralizedLabelReductionConfiguration -> Expr
exact ExactGeneralizedLabelReductionConfiguration
cfg


data Verbosity =
  Silent | Basic | Verbose
  deriving
    ( Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show )


verbosityToExpr :: Verbosity -> Expr
verbosityToExpr :: Verbosity -> Expr
verbosityToExpr =
  String -> Expr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


data ConstraintGenerator
  = LMCutConstraints
  | PosthocOptimizationConstraints PatternCollectionGenerator
  | StateEquationConstraints


constraintGeneratorToExpr :: ConstraintGenerator -> Expr
constraintGeneratorToExpr :: ConstraintGenerator -> Expr
constraintGeneratorToExpr =
  \case
    ConstraintGenerator
LMCutConstraints ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"lmcut_constraints" [] []

    PosthocOptimizationConstraints PatternCollectionGenerator
cfg ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"pho_constraints" [] [ ( String
"patterns", PatternCollectionGenerator -> Expr
patternCollectionGeneratorToExpr PatternCollectionGenerator
cfg ) ]

    ConstraintGenerator
StateEquationConstraints ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"state_equation_constraints" [] []


-- | See <http://www.fast-downward.org/Doc/PatternCollectionGenerator>
data PatternCollectionGenerator
  = Combo ( Maybe Int )
  | Genetic GeneticConfiguration
  | Hillclimbing HillclimbingConfiguration
  | ManualPattern [ [ Int ] ]
  | Systematic SystematicConfiguration


patternCollectionGeneratorToExpr :: PatternCollectionGenerator -> Expr
patternCollectionGeneratorToExpr :: PatternCollectionGenerator -> Expr
patternCollectionGeneratorToExpr =
  \case
    Combo Maybe Int
maxStates ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"combo" [] [ Maybe Int -> (String, Expr)
maxStatesOption Maybe Int
maxStates ]

    Genetic GeneticConfiguration
cfg ->
      GeneticConfiguration -> Expr
genetic GeneticConfiguration
cfg

    Hillclimbing HillclimbingConfiguration
cfg ->
      HillclimbingConfiguration -> Expr
hillclimbing HillclimbingConfiguration
cfg

    ManualPattern [[Int]]
cfg ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App
        String
"manual_patterns"
        [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map ( [Expr] -> Expr
List forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Int -> Expr
intToExpr ) [[Int]]
cfg ) ]
        []

    Systematic SystematicConfiguration
cfg ->
      SystematicConfiguration -> Expr
systematic SystematicConfiguration
cfg


-- | See <http://www.fast-downward.org/Doc/SubtaskGenerator#goals>
data GoalsConfiguration =
  GoalsConfiguration
    { GoalsConfiguration -> GoalsOrder
order :: GoalsOrder
    , GoalsConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


goals :: GoalsConfiguration -> Expr
goals :: GoalsConfiguration -> Expr
goals GoalsConfiguration{ GoalsOrder
order :: GoalsOrder
$sel:order:GoalsConfiguration :: GoalsConfiguration -> GoalsOrder
order, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:GoalsConfiguration :: GoalsConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"goals"
    []
    [ GoalsOrder -> (String, Expr)
orderExpr GoalsOrder
order
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


-- | See <http://www.fast-downward.org/Doc/SubtaskGenerator#landmarks>
data LandmarksConfiguration =
  LandmarksConfiguration
    { LandmarksConfiguration -> GoalsOrder
order :: GoalsOrder
    , LandmarksConfiguration -> Maybe Int
randomSeed :: Maybe Int
    , LandmarksConfiguration -> Bool
combineFacts :: Bool
    }


landmarks :: LandmarksConfiguration -> Expr
landmarks :: LandmarksConfiguration -> Expr
landmarks LandmarksConfiguration{ GoalsOrder
order :: GoalsOrder
$sel:order:LandmarksConfiguration :: LandmarksConfiguration -> GoalsOrder
order, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:LandmarksConfiguration :: LandmarksConfiguration -> Maybe Int
randomSeed, Bool
combineFacts :: Bool
$sel:combineFacts:LandmarksConfiguration :: LandmarksConfiguration -> Bool
combineFacts } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"landmarks"
    []
    [ GoalsOrder -> (String, Expr)
orderExpr GoalsOrder
order
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    , ( String
"combine_facts", Bool -> Expr
boolToExpr Bool
combineFacts )
    ]


newtype OriginalConfiguration =
  OriginalConfiguration
    { OriginalConfiguration -> Maybe Int
copies :: Maybe Int }


original :: OriginalConfiguration -> Expr
original :: OriginalConfiguration -> Expr
original OriginalConfiguration{ Maybe Int
copies :: Maybe Int
$sel:copies:OriginalConfiguration :: OriginalConfiguration -> Maybe Int
copies } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App String
"original" [] [ ( String
"copies", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
copies ) ]


-- | See <http://www.fast-downward.org/Doc/LandmarkFactory#Exhaustive_Landmarks>
data LMExhaustConfiguration =
  LMExhaustConfiguration
    { LMExhaustConfiguration -> Bool
reasonableOrders :: Bool
    , LMExhaustConfiguration -> Bool
onlyCausalLandmarks :: Bool
    , LMExhaustConfiguration -> Bool
disjunctiveLandmarks :: Bool
    , LMExhaustConfiguration -> Bool
conjunctiveLandmarks :: Bool
    , LMExhaustConfiguration -> Bool
noOrders :: Bool
    }


lmexhaust :: LMExhaustConfiguration -> Expr
lmexhaust :: LMExhaustConfiguration -> Expr
lmexhaust LMExhaustConfiguration{ Bool
reasonableOrders :: Bool
$sel:reasonableOrders:LMExhaustConfiguration :: LMExhaustConfiguration -> Bool
reasonableOrders, Bool
onlyCausalLandmarks :: Bool
$sel:onlyCausalLandmarks:LMExhaustConfiguration :: LMExhaustConfiguration -> Bool
onlyCausalLandmarks, Bool
disjunctiveLandmarks :: Bool
$sel:disjunctiveLandmarks:LMExhaustConfiguration :: LMExhaustConfiguration -> Bool
disjunctiveLandmarks, Bool
conjunctiveLandmarks :: Bool
$sel:conjunctiveLandmarks:LMExhaustConfiguration :: LMExhaustConfiguration -> Bool
conjunctiveLandmarks, Bool
noOrders :: Bool
$sel:noOrders:LMExhaustConfiguration :: LMExhaustConfiguration -> Bool
noOrders } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lm_exhaust"
    []
    [ ( String
"reasonable_orders", Bool -> Expr
boolToExpr Bool
reasonableOrders )
    , ( String
"only_causal_landmarks", Bool -> Expr
boolToExpr Bool
onlyCausalLandmarks )
    , ( String
"disjunctive_landmarks", Bool -> Expr
boolToExpr Bool
disjunctiveLandmarks )
    , ( String
"conjunctive_landmarks", Bool -> Expr
boolToExpr Bool
conjunctiveLandmarks )
    , ( String
"no_orders", Bool -> Expr
boolToExpr Bool
noOrders )
    ]


-- | See <http://www.fast-downward.org/Doc/LandmarkFactory#h.5Em_Landmarks>
data LMHMConfiguration =
  LMHMConfiguration
    { LMHMConfiguration -> Int
m :: Int
    , LMHMConfiguration -> Bool
reasonableOrders :: Bool
    , LMHMConfiguration -> Bool
onlyCausalLandmarks :: Bool
    , LMHMConfiguration -> Bool
disjunctiveLandmarks :: Bool
    , LMHMConfiguration -> Bool
conjunctiveLandmarks :: Bool
    , LMHMConfiguration -> Bool
noOrders :: Bool
    }


lmhm :: LMHMConfiguration -> Expr
lmhm :: LMHMConfiguration -> Expr
lmhm LMHMConfiguration{ Int
m :: Int
$sel:m:LMHMConfiguration :: LMHMConfiguration -> Int
m, Bool
reasonableOrders :: Bool
$sel:reasonableOrders:LMHMConfiguration :: LMHMConfiguration -> Bool
reasonableOrders, Bool
onlyCausalLandmarks :: Bool
$sel:onlyCausalLandmarks:LMHMConfiguration :: LMHMConfiguration -> Bool
onlyCausalLandmarks, Bool
disjunctiveLandmarks :: Bool
$sel:disjunctiveLandmarks:LMHMConfiguration :: LMHMConfiguration -> Bool
disjunctiveLandmarks, Bool
conjunctiveLandmarks :: Bool
$sel:conjunctiveLandmarks:LMHMConfiguration :: LMHMConfiguration -> Bool
conjunctiveLandmarks, Bool
noOrders :: Bool
$sel:noOrders:LMHMConfiguration :: LMHMConfiguration -> Bool
noOrders } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lm_hm"
    []
    [ ( String
"m", Int -> Expr
intToExpr Int
m )
    , ( String
"reasonable_orders", Bool -> Expr
boolToExpr Bool
reasonableOrders )
    , ( String
"only_causal_landmarks", Bool -> Expr
boolToExpr Bool
onlyCausalLandmarks )
    , ( String
"disjunctive_landmarks", Bool -> Expr
boolToExpr Bool
disjunctiveLandmarks )
    , ( String
"conjunctive_landmarks", Bool -> Expr
boolToExpr Bool
conjunctiveLandmarks )
    , ( String
"no_orders", Bool -> Expr
boolToExpr Bool
noOrders )
    ]


-- | See <http://www.fast-downward.org/Doc/LandmarkFactory#Merged_Landmarks>
data LMMergedConfiguration =
  LMMergedConfiguration
    { LMMergedConfiguration -> [LandmarkFactory]
factories :: [ LandmarkFactory ]
    , LMMergedConfiguration -> Bool
reasonableOrders :: Bool
    , LMMergedConfiguration -> Bool
onlyCausalLandmarks :: Bool
    , LMMergedConfiguration -> Bool
disjunctiveLandmarks :: Bool
    , LMMergedConfiguration -> Bool
conjunctiveLandmarks :: Bool
    , LMMergedConfiguration -> Bool
noOrders :: Bool
    }


lmMerged :: LMMergedConfiguration -> Expr
lmMerged :: LMMergedConfiguration -> Expr
lmMerged LMMergedConfiguration{ [LandmarkFactory]
factories :: [LandmarkFactory]
$sel:factories:LMMergedConfiguration :: LMMergedConfiguration -> [LandmarkFactory]
factories, Bool
reasonableOrders :: Bool
$sel:reasonableOrders:LMMergedConfiguration :: LMMergedConfiguration -> Bool
reasonableOrders, Bool
onlyCausalLandmarks :: Bool
$sel:onlyCausalLandmarks:LMMergedConfiguration :: LMMergedConfiguration -> Bool
onlyCausalLandmarks, Bool
disjunctiveLandmarks :: Bool
$sel:disjunctiveLandmarks:LMMergedConfiguration :: LMMergedConfiguration -> Bool
disjunctiveLandmarks, Bool
conjunctiveLandmarks :: Bool
$sel:conjunctiveLandmarks:LMMergedConfiguration :: LMMergedConfiguration -> Bool
conjunctiveLandmarks, Bool
noOrders :: Bool
$sel:noOrders:LMMergedConfiguration :: LMMergedConfiguration -> Bool
noOrders } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lm_merged"
    [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map LandmarkFactory -> Expr
landmarkFactoryToExpr [LandmarkFactory]
factories ) ]
    [ ( String
"reasonable_orders", Bool -> Expr
boolToExpr Bool
reasonableOrders )
    , ( String
"only_causal_landmarks", Bool -> Expr
boolToExpr Bool
onlyCausalLandmarks )
    , ( String
"disjunctive_landmarks", Bool -> Expr
boolToExpr Bool
disjunctiveLandmarks )
    , ( String
"conjunctive_landmarks", Bool -> Expr
boolToExpr Bool
conjunctiveLandmarks )
    , ( String
"no_orders", Bool -> Expr
boolToExpr Bool
noOrders )
    ]


-- | See <http://www.fast-downward.org/Doc/LandmarkFactory#RHW_Landmarks>.
data LMRHWConfiguration =
  LMRHWConfiguration
    { LMRHWConfiguration -> Bool
reasonableOrders :: Bool
    , LMRHWConfiguration -> Bool
onlyCausalLandmarks :: Bool
    , LMRHWConfiguration -> Bool
disjunctiveLandmarks :: Bool
    , LMRHWConfiguration -> Bool
conjunctiveLandmarks :: Bool
    , LMRHWConfiguration -> Bool
noOrders :: Bool
    }


lmRHW :: LMRHWConfiguration -> Expr
lmRHW :: LMRHWConfiguration -> Expr
lmRHW LMRHWConfiguration{ Bool
reasonableOrders :: Bool
$sel:reasonableOrders:LMRHWConfiguration :: LMRHWConfiguration -> Bool
reasonableOrders, Bool
onlyCausalLandmarks :: Bool
$sel:onlyCausalLandmarks:LMRHWConfiguration :: LMRHWConfiguration -> Bool
onlyCausalLandmarks, Bool
disjunctiveLandmarks :: Bool
$sel:disjunctiveLandmarks:LMRHWConfiguration :: LMRHWConfiguration -> Bool
disjunctiveLandmarks, Bool
conjunctiveLandmarks :: Bool
$sel:conjunctiveLandmarks:LMRHWConfiguration :: LMRHWConfiguration -> Bool
conjunctiveLandmarks, Bool
noOrders :: Bool
$sel:noOrders:LMRHWConfiguration :: LMRHWConfiguration -> Bool
noOrders } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lm_rhw"
    []
    [ ( String
"reasonable_orders", Bool -> Expr
boolToExpr Bool
reasonableOrders )
    , ( String
"only_causal_landmarks", Bool -> Expr
boolToExpr Bool
onlyCausalLandmarks )
    , ( String
"disjunctive_landmarks", Bool -> Expr
boolToExpr Bool
disjunctiveLandmarks )
    , ( String
"conjunctive_landmarks", Bool -> Expr
boolToExpr Bool
conjunctiveLandmarks )
    , ( String
"no_orders", Bool -> Expr
boolToExpr Bool
noOrders )
    ]


-- | See <http://www.fast-downward.org/Doc/LandmarkFactory#Zhu.2FGivan_Landmarks>
data LMZGConfiguration =
  LMZGConfiguration
    { LMZGConfiguration -> Bool
reasonableOrders :: Bool
    , LMZGConfiguration -> Bool
onlyCausalLandmarks :: Bool
    , LMZGConfiguration -> Bool
disjunctiveLandmarks :: Bool
    , LMZGConfiguration -> Bool
conjunctiveLandmarks :: Bool
    , LMZGConfiguration -> Bool
noOrders :: Bool
    }


lmzg :: LMZGConfiguration -> Expr
lmzg :: LMZGConfiguration -> Expr
lmzg LMZGConfiguration{ Bool
reasonableOrders :: Bool
$sel:reasonableOrders:LMZGConfiguration :: LMZGConfiguration -> Bool
reasonableOrders, Bool
onlyCausalLandmarks :: Bool
$sel:onlyCausalLandmarks:LMZGConfiguration :: LMZGConfiguration -> Bool
onlyCausalLandmarks, Bool
disjunctiveLandmarks :: Bool
$sel:disjunctiveLandmarks:LMZGConfiguration :: LMZGConfiguration -> Bool
disjunctiveLandmarks, Bool
conjunctiveLandmarks :: Bool
$sel:conjunctiveLandmarks:LMZGConfiguration :: LMZGConfiguration -> Bool
conjunctiveLandmarks, Bool
noOrders :: Bool
$sel:noOrders:LMZGConfiguration :: LMZGConfiguration -> Bool
noOrders } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"lm_zg"
    []
    [ ( String
"reasonable_orders", Bool -> Expr
boolToExpr Bool
reasonableOrders )
    , ( String
"only_causal_landmarks", Bool -> Expr
boolToExpr Bool
onlyCausalLandmarks )
    , ( String
"disjunctive_landmarks", Bool -> Expr
boolToExpr Bool
disjunctiveLandmarks )
    , ( String
"conjunctive_landmarks", Bool -> Expr
boolToExpr Bool
conjunctiveLandmarks )
    , ( String
"no_orders", Bool -> Expr
boolToExpr Bool
noOrders )
    ]


newtype MergeTree
  = LinearMergeTree LinearMergeTreeConfiguration


mergeTreeToExpr :: MergeTree -> Expr
mergeTreeToExpr :: MergeTree -> Expr
mergeTreeToExpr ( LinearMergeTree LinearMergeTreeConfiguration
cfg ) =
  LinearMergeTreeConfiguration -> Expr
linear LinearMergeTreeConfiguration
cfg


-- | See <http://www.fast-downward.org/Doc/MergeStrategy#Merge_strategy_SSCs>
data MergeSCCsConfiguration =
  MergeSCCsConfiguration
    { MergeSCCsConfiguration -> OrderOfSCCs
orderOfSCCs :: OrderOfSCCs
    , MergeSCCsConfiguration -> Maybe MergeTree
mergeTree :: Maybe MergeTree
    , MergeSCCsConfiguration -> Maybe MergeSelector
mergeSelector :: Maybe MergeSelector
    }


mergeSCCs :: MergeSCCsConfiguration -> Expr
mergeSCCs :: MergeSCCsConfiguration -> Expr
mergeSCCs MergeSCCsConfiguration{ OrderOfSCCs
orderOfSCCs :: OrderOfSCCs
$sel:orderOfSCCs:MergeSCCsConfiguration :: MergeSCCsConfiguration -> OrderOfSCCs
orderOfSCCs, Maybe MergeTree
mergeTree :: Maybe MergeTree
$sel:mergeTree:MergeSCCsConfiguration :: MergeSCCsConfiguration -> Maybe MergeTree
mergeTree, Maybe MergeSelector
mergeSelector :: Maybe MergeSelector
$sel:mergeSelector:MergeSCCsConfiguration :: MergeSCCsConfiguration -> Maybe MergeSelector
mergeSelector } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"merge_sccs"
    []
    [ ( String
"order_of_sccs", OrderOfSCCs -> Expr
orderOfSCCsToExpr OrderOfSCCs
orderOfSCCs )
    , ( String
"merge_tree", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
none MergeTree -> Expr
mergeTreeToExpr Maybe MergeTree
mergeTree )
    , ( String
"merge_selector", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
none MergeSelector -> Expr
mergeSelectorToExpr Maybe MergeSelector
mergeSelector )
    ]


newtype MergeSelector
  = ScoreBasedFiltering [ MergeScoringFunction ]


mergeSelectorToExpr :: MergeSelector -> Expr
mergeSelectorToExpr :: MergeSelector -> Expr
mergeSelectorToExpr ( ScoreBasedFiltering [MergeScoringFunction]
scoringFunctions ) =
  String -> [Expr] -> [(String, Expr)] -> Expr
App String
"score_based_filtering" [ [Expr] -> Expr
List ( forall a b. (a -> b) -> [a] -> [b]
map MergeScoringFunction -> Expr
mergeScoringFunctionToExpr [MergeScoringFunction]
scoringFunctions ) ] []


-- | See <http://www.fast-downward.org/Doc/ShrinkStrategy#Bismulation_based_shrink_strategy>
data BisimulationConfiguration =
  BisimulationConfiguration
    { BisimulationConfiguration -> Bool
greedy :: Bool
    , BisimulationConfiguration -> BisimulationLimitStrategy
atLimit :: BisimulationLimitStrategy
    }


bisimulation :: BisimulationConfiguration -> Expr
bisimulation :: BisimulationConfiguration -> Expr
bisimulation BisimulationConfiguration{ Bool
greedy :: Bool
$sel:greedy:BisimulationConfiguration :: BisimulationConfiguration -> Bool
greedy, BisimulationLimitStrategy
atLimit :: BisimulationLimitStrategy
$sel:atLimit:BisimulationConfiguration :: BisimulationConfiguration -> BisimulationLimitStrategy
atLimit } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"shrink_bisimulation"
    []
    [ ( String
"greedy", Bool -> Expr
boolToExpr Bool
greedy )
    , ( String
"at_limit", BisimulationLimitStrategy -> Expr
bisimulationLimitStrategyToExpr BisimulationLimitStrategy
atLimit )
    ]


-- | See <http://www.fast-downward.org/Doc/ShrinkStrategy#f-preserving_shrink_strategy>
data FPreservingConfiguration =
  FPreservingConfiguration
    { FPreservingConfiguration -> Maybe Int
randomSeed :: Maybe Int
    , FPreservingConfiguration -> HighLow
shrinkF :: HighLow
    , FPreservingConfiguration -> HighLow
shrinkH :: HighLow
    }


fPreserving :: FPreservingConfiguration -> Expr
fPreserving :: FPreservingConfiguration -> Expr
fPreserving FPreservingConfiguration{ Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:FPreservingConfiguration :: FPreservingConfiguration -> Maybe Int
randomSeed, HighLow
shrinkF :: HighLow
$sel:shrinkF:FPreservingConfiguration :: FPreservingConfiguration -> HighLow
shrinkF, HighLow
shrinkH :: HighLow
$sel:shrinkH:FPreservingConfiguration :: FPreservingConfiguration -> HighLow
shrinkH } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"shrink_fh"
    []
    [ Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    , ( String
"shrink_f", HighLow -> Expr
highLowToExpr HighLow
shrinkF )
    , ( String
"shrink_h", HighLow -> Expr
highLowToExpr HighLow
shrinkH )
    ]


-- | See <http://www.fast-downward.org/Doc/LabelReduction#Exact_generalized_label_reduction>
data ExactGeneralizedLabelReductionConfiguration =
  ExactGeneralizedLabelReductionConfiguration
    { ExactGeneralizedLabelReductionConfiguration -> Bool
beforeShrinking :: Bool
    , ExactGeneralizedLabelReductionConfiguration -> Bool
beforeMerging :: Bool
    , ExactGeneralizedLabelReductionConfiguration -> LabelReductionMethod
method :: LabelReductionMethod
    , ExactGeneralizedLabelReductionConfiguration -> SystemOrder
systemOrder :: SystemOrder
    , ExactGeneralizedLabelReductionConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


exact :: ExactGeneralizedLabelReductionConfiguration -> Expr
exact :: ExactGeneralizedLabelReductionConfiguration -> Expr
exact ExactGeneralizedLabelReductionConfiguration{ Bool
beforeShrinking :: Bool
$sel:beforeShrinking:ExactGeneralizedLabelReductionConfiguration :: ExactGeneralizedLabelReductionConfiguration -> Bool
beforeShrinking, Bool
beforeMerging :: Bool
$sel:beforeMerging:ExactGeneralizedLabelReductionConfiguration :: ExactGeneralizedLabelReductionConfiguration -> Bool
beforeMerging, LabelReductionMethod
method :: LabelReductionMethod
$sel:method:ExactGeneralizedLabelReductionConfiguration :: ExactGeneralizedLabelReductionConfiguration -> LabelReductionMethod
method, SystemOrder
systemOrder :: SystemOrder
$sel:systemOrder:ExactGeneralizedLabelReductionConfiguration :: ExactGeneralizedLabelReductionConfiguration -> SystemOrder
systemOrder, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:ExactGeneralizedLabelReductionConfiguration :: ExactGeneralizedLabelReductionConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"exact"
    [ Bool -> Expr
boolToExpr Bool
beforeShrinking
    , Bool -> Expr
boolToExpr Bool
beforeMerging
    ]
    [ ( String
"method", LabelReductionMethod -> Expr
labelReductionMethodToExpr LabelReductionMethod
method )
    , ( String
"system_order", SystemOrder -> Expr
systemOrderToExpr SystemOrder
systemOrder )
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


-- | See <http://www.fast-downward.org/Doc/PatternCollectionGenerator#Genetic_Algorithm_Patterns>
data GeneticConfiguration =
  GeneticConfiguration
    { GeneticConfiguration -> Maybe Int
pdbMaxSize :: Maybe Int
    , GeneticConfiguration -> Maybe Int
numCollections :: Maybe Int
    , GeneticConfiguration -> Maybe Int
numEpisodes :: Maybe Int
    , GeneticConfiguration -> Ratio Int
mutationProbability :: Ratio Int
    , GeneticConfiguration -> Bool
disjoint :: Bool
    , GeneticConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


genetic :: GeneticConfiguration -> Expr
genetic :: GeneticConfiguration -> Expr
genetic GeneticConfiguration{ Maybe Int
pdbMaxSize :: Maybe Int
$sel:pdbMaxSize:GeneticConfiguration :: GeneticConfiguration -> Maybe Int
pdbMaxSize, Maybe Int
numCollections :: Maybe Int
$sel:numCollections:GeneticConfiguration :: GeneticConfiguration -> Maybe Int
numCollections, Maybe Int
numEpisodes :: Maybe Int
$sel:numEpisodes:GeneticConfiguration :: GeneticConfiguration -> Maybe Int
numEpisodes, Ratio Int
mutationProbability :: Ratio Int
$sel:mutationProbability:GeneticConfiguration :: GeneticConfiguration -> Ratio Int
mutationProbability, Bool
disjoint :: Bool
$sel:disjoint:GeneticConfiguration :: GeneticConfiguration -> Bool
disjoint, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:GeneticConfiguration :: GeneticConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"genetic"
    []
    [ Maybe Int -> (String, Expr)
pdbMaxSizeOption Maybe Int
pdbMaxSize
    , ( String
"num_collections", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
numCollections )
    , ( String
"num_episodes", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
numEpisodes )
    , ( String
"mutation_probability", Double -> Expr
doubleToExpr ( forall a b. (Real a, Fractional b) => a -> b
realToFrac Ratio Int
mutationProbability ) )
    , ( String
"disjoint", Bool -> Expr
boolToExpr Bool
disjoint )
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


-- | See <http://www.fast-downward.org/Doc/PatternCollectionGenerator#hillclimbing>
data HillclimbingConfiguration =
  HillclimbingConfiguration
    { HillclimbingConfiguration -> Maybe Int
pdbMaxSize :: Maybe Int
    , HillclimbingConfiguration -> Maybe Int
collectionMaxSize :: Maybe Int
    , HillclimbingConfiguration -> Maybe Int
numSamples :: Maybe Int
    , HillclimbingConfiguration -> Maybe Int
minImprovement :: Maybe Int
    , HillclimbingConfiguration -> Maybe Double
maxTime :: Maybe Double
    , HillclimbingConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


hillclimbing :: HillclimbingConfiguration -> Expr
hillclimbing :: HillclimbingConfiguration -> Expr
hillclimbing HillclimbingConfiguration{ Maybe Int
pdbMaxSize :: Maybe Int
$sel:pdbMaxSize:HillclimbingConfiguration :: HillclimbingConfiguration -> Maybe Int
pdbMaxSize, Maybe Int
collectionMaxSize :: Maybe Int
$sel:collectionMaxSize:HillclimbingConfiguration :: HillclimbingConfiguration -> Maybe Int
collectionMaxSize, Maybe Int
numSamples :: Maybe Int
$sel:numSamples:HillclimbingConfiguration :: HillclimbingConfiguration -> Maybe Int
numSamples, Maybe Int
minImprovement :: Maybe Int
$sel:minImprovement:HillclimbingConfiguration :: HillclimbingConfiguration -> Maybe Int
minImprovement, Maybe Double
maxTime :: Maybe Double
$sel:maxTime:HillclimbingConfiguration :: HillclimbingConfiguration -> Maybe Double
maxTime, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:HillclimbingConfiguration :: HillclimbingConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"hillclimbing"
    []
    [ Maybe Int -> (String, Expr)
pdbMaxSizeOption Maybe Int
pdbMaxSize
    , ( String
"collection_max_size", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
collectionMaxSize )
    , ( String
"num_samples", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
numSamples )
    , ( String
"min_improvement", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
minImprovement )
    , Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
maxTime
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


-- | See <http://www.fast-downward.org/Doc/PatternCollectionGenerator#Systematically_generated_patterns>
data SystematicConfiguration =
  SystematicConfiguration
    { SystematicConfiguration -> Maybe Int
patternMaxSize :: Maybe Int
    , SystematicConfiguration -> Bool
onlyInterestingPatterns :: Bool
    }


systematic :: SystematicConfiguration -> Expr
systematic :: SystematicConfiguration -> Expr
systematic SystematicConfiguration{ Maybe Int
patternMaxSize :: Maybe Int
$sel:patternMaxSize:SystematicConfiguration :: SystematicConfiguration -> Maybe Int
patternMaxSize, Bool
onlyInterestingPatterns :: Bool
$sel:onlyInterestingPatterns:SystematicConfiguration :: SystematicConfiguration -> Bool
onlyInterestingPatterns } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"systematic"
    []
    [ ( String
"pattern_max_size", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
patternMaxSize )
    , ( String
"only_interesting_patterns", Bool -> Expr
boolToExpr Bool
onlyInterestingPatterns )
    ]


data GoalsOrder =
  OriginalOrder | RandomOrder | HAddUp | HAddDown


goalsOrderToExpr :: GoalsOrder -> Expr
goalsOrderToExpr :: GoalsOrder -> Expr
goalsOrderToExpr =
  \case
    GoalsOrder
OriginalOrder ->
      String -> Expr
Lit String
"ORIGINAL"

    GoalsOrder
RandomOrder ->
      String -> Expr
Lit String
"RANDOM"

    GoalsOrder
HAddUp ->
      String -> Expr
Lit String
"HADD_UP"

    GoalsOrder
HAddDown ->
      String -> Expr
Lit String
"HADD_DOWN"


-- | See <http://www.fast-downward.org/Doc/MergeTree#Linear_merge_trees>
data LinearMergeTreeConfiguration =
  LinearMergeTreeConfiguration
    { LinearMergeTreeConfiguration -> Maybe Int
randomSeed :: Maybe Int
    , LinearMergeTreeConfiguration -> UpdateOption
updateOption :: UpdateOption
    , LinearMergeTreeConfiguration -> VariableOrder
variableOrder :: VariableOrder
    }


linear :: LinearMergeTreeConfiguration -> Expr
linear :: LinearMergeTreeConfiguration -> Expr
linear LinearMergeTreeConfiguration { Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:LinearMergeTreeConfiguration :: LinearMergeTreeConfiguration -> Maybe Int
randomSeed, UpdateOption
updateOption :: UpdateOption
$sel:updateOption:LinearMergeTreeConfiguration :: LinearMergeTreeConfiguration -> UpdateOption
updateOption, VariableOrder
variableOrder :: VariableOrder
$sel:variableOrder:LinearMergeTreeConfiguration :: LinearMergeTreeConfiguration -> VariableOrder
variableOrder } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"linear"
    []
    [ Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    , ( String
"update_option", UpdateOption -> Expr
updateOptionToExpr UpdateOption
updateOption )
    , ( String
"variable_order", VariableOrder -> Expr
variableOrderToExpr VariableOrder
variableOrder )
    ]


data OrderOfSCCs =
  Topological | ReverseTopological | Decreasing | Increasing


orderOfSCCsToExpr :: OrderOfSCCs -> Expr
orderOfSCCsToExpr :: OrderOfSCCs -> Expr
orderOfSCCsToExpr =
  \case
    OrderOfSCCs
Topological ->
      String -> Expr
Lit String
"topological"

    OrderOfSCCs
ReverseTopological ->
      String -> Expr
Lit String
"reverse_topological"

    OrderOfSCCs
Decreasing ->
      String -> Expr
Lit String
"decreasing"

    OrderOfSCCs
Increasing ->
      String -> Expr
Lit String
"increasing"


-- | See <http://www.fast-downward.org/Doc/MergeScoringFunction>
data MergeScoringFunction
  = DFP
  | GoalRelevance
  | MIASM MIASMConfiguration
  | SingleRandom ( Maybe Int )
  | TotalOrder TotalOrderConfiguration


mergeScoringFunctionToExpr :: MergeScoringFunction -> Expr
mergeScoringFunctionToExpr :: MergeScoringFunction -> Expr
mergeScoringFunctionToExpr =
  \case
    MergeScoringFunction
DFP ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"dfp" [] []

    MergeScoringFunction
GoalRelevance ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"goal_relevance" [] []

    MIASM MIASMConfiguration
cfg ->
      MIASMConfiguration -> Expr
miasm MIASMConfiguration
cfg

    SingleRandom Maybe Int
cfg ->
      String -> [Expr] -> [(String, Expr)] -> Expr
App String
"single_random" [] [ Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
cfg ]

    TotalOrder TotalOrderConfiguration
cfg ->
      TotalOrderConfiguration -> Expr
totalOrder TotalOrderConfiguration
cfg


data BisimulationLimitStrategy =
  Return | UseUp


bisimulationLimitStrategyToExpr :: BisimulationLimitStrategy -> Expr
bisimulationLimitStrategyToExpr :: BisimulationLimitStrategy -> Expr
bisimulationLimitStrategyToExpr =
  \case
    BisimulationLimitStrategy
Return ->
      String -> Expr
Lit String
"RETURN"

    BisimulationLimitStrategy
UseUp ->
      String -> Expr
Lit String
"USE_UP"


data HighLow =
  High | Low
  deriving
    ( Int -> HighLow -> ShowS
[HighLow] -> ShowS
HighLow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HighLow] -> ShowS
$cshowList :: [HighLow] -> ShowS
show :: HighLow -> String
$cshow :: HighLow -> String
showsPrec :: Int -> HighLow -> ShowS
$cshowsPrec :: Int -> HighLow -> ShowS
Show )


highLowToExpr :: HighLow -> Expr
highLowToExpr :: HighLow -> Expr
highLowToExpr =
  String -> Expr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


data LabelReductionMethod =
  TwoTransitionSystems | AllTransitionSystems | AllTransitionSystemsWithFixpoint


labelReductionMethodToExpr :: LabelReductionMethod -> Expr
labelReductionMethodToExpr :: LabelReductionMethod -> Expr
labelReductionMethodToExpr =
  \case
    LabelReductionMethod
TwoTransitionSystems ->
      String -> Expr
Lit String
"TWO_TRANSITION_SYSTEMS"

    LabelReductionMethod
AllTransitionSystems ->
      String -> Expr
Lit  String
"ALL_TRANSITION_SYSTEMS"

    LabelReductionMethod
AllTransitionSystemsWithFixpoint ->
      String -> Expr
Lit  String
"ALL_TRANSITION_SYSTEMS_WITH_FIXPOINT"


data SystemOrder =
  RegularSystemOrder | ReverseSystemOrder | RandomSystemOrder


systemOrderToExpr :: SystemOrder -> Expr
systemOrderToExpr :: SystemOrder -> Expr
systemOrderToExpr =
  \case
    SystemOrder
RegularSystemOrder ->
      String -> Expr
Lit String
"REGULAR"

    SystemOrder
ReverseSystemOrder ->
      String -> Expr
Lit String
"REVERSE"

    SystemOrder
RandomSystemOrder ->
      String -> Expr
Lit String
"RANDOM"


data UpdateOption =
  UseFirst | UseSecond | UseRandom


updateOptionToExpr :: UpdateOption -> Expr
updateOptionToExpr :: UpdateOption -> Expr
updateOptionToExpr =
  \case
    UpdateOption
UseFirst ->
      String -> Expr
Lit String
"use_first"

    UpdateOption
UseSecond ->
      String -> Expr
Lit String
"use_second"

    UpdateOption
UseRandom ->
      String -> Expr
Lit String
"use_random"


data VariableOrder =
  CGGoalLevel | CGGoalRandom | GoalCGLevel | RandomVariableOrder | LevelOrder | ReverseLevelOrder


variableOrderToExpr :: VariableOrder -> Expr
variableOrderToExpr :: VariableOrder -> Expr
variableOrderToExpr =
  \case
    VariableOrder
CGGoalLevel ->
      String -> Expr
Lit String
"CG_GOAL_LEVEL"

    VariableOrder
CGGoalRandom ->
      String -> Expr
Lit String
"CG_GOAL_RANDOM"

    VariableOrder
GoalCGLevel ->
      String -> Expr
Lit String
"GOAL_CG_LEVEL"

    VariableOrder
RandomVariableOrder ->
      String -> Expr
Lit String
"RANDOM"

    VariableOrder
LevelOrder ->
      String -> Expr
Lit String
"LEVEL"

    VariableOrder
ReverseLevelOrder ->
      String -> Expr
Lit String
"REVERSE_LEVEL"


data MIASMConfiguration =
  MIASMConfiguration
    { MIASMConfiguration -> ShrinkStrategy
shrinkStrategy :: ShrinkStrategy
    , MIASMConfiguration -> Maybe Int
maxStates :: Maybe Int
    , MIASMConfiguration -> Maybe Int
maxStatesBeforeMerge :: Maybe Int
    , MIASMConfiguration -> Maybe Int
thresholdBeforeMerge :: Maybe Int
    }


miasm :: MIASMConfiguration -> Expr
miasm :: MIASMConfiguration -> Expr
miasm MIASMConfiguration{ ShrinkStrategy
shrinkStrategy :: ShrinkStrategy
$sel:shrinkStrategy:MIASMConfiguration :: MIASMConfiguration -> ShrinkStrategy
shrinkStrategy, Maybe Int
maxStates :: Maybe Int
$sel:maxStates:MIASMConfiguration :: MIASMConfiguration -> Maybe Int
maxStates, Maybe Int
maxStatesBeforeMerge :: Maybe Int
$sel:maxStatesBeforeMerge:MIASMConfiguration :: MIASMConfiguration -> Maybe Int
maxStatesBeforeMerge, Maybe Int
thresholdBeforeMerge :: Maybe Int
$sel:thresholdBeforeMerge:MIASMConfiguration :: MIASMConfiguration -> Maybe Int
thresholdBeforeMerge } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"sf_miasm"
    [ ShrinkStrategy -> Expr
shrinkStrategyToExpr ShrinkStrategy
shrinkStrategy ]
    [ Maybe Int -> (String, Expr)
maxStatesOption Maybe Int
maxStates
    , Maybe Int -> (String, Expr)
maxStatesBeforeMergeOption Maybe Int
maxStatesBeforeMerge
    , ( String
"threshold_before_merge", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
thresholdBeforeMerge )
    ]


data TotalOrderConfiguration =
  TotalOrderConfiguration
    { TotalOrderConfiguration -> AtomicTsOrder
atomicTsOrder :: AtomicTsOrder
    , TotalOrderConfiguration -> ProductTsOrder
productTsOrder :: ProductTsOrder
    , TotalOrderConfiguration -> Bool
atomicBeforeProduct :: Bool
    , TotalOrderConfiguration -> Maybe Int
randomSeed :: Maybe Int
    }


totalOrder :: TotalOrderConfiguration -> Expr
totalOrder :: TotalOrderConfiguration -> Expr
totalOrder TotalOrderConfiguration{ AtomicTsOrder
atomicTsOrder :: AtomicTsOrder
$sel:atomicTsOrder:TotalOrderConfiguration :: TotalOrderConfiguration -> AtomicTsOrder
atomicTsOrder, ProductTsOrder
productTsOrder :: ProductTsOrder
$sel:productTsOrder:TotalOrderConfiguration :: TotalOrderConfiguration -> ProductTsOrder
productTsOrder, Bool
atomicBeforeProduct :: Bool
$sel:atomicBeforeProduct:TotalOrderConfiguration :: TotalOrderConfiguration -> Bool
atomicBeforeProduct, Maybe Int
randomSeed :: Maybe Int
$sel:randomSeed:TotalOrderConfiguration :: TotalOrderConfiguration -> Maybe Int
randomSeed } =
  String -> [Expr] -> [(String, Expr)] -> Expr
App
    String
"total_order"
    []
    [ ( String
"atomic_ts_order", AtomicTsOrder -> Expr
atomicTsOrderToExpr AtomicTsOrder
atomicTsOrder )
    , ( String
"product_ts_order", ProductTsOrder -> Expr
productTsOrderToExpr ProductTsOrder
productTsOrder )
    , ( String
"atomic_before_product", Bool -> Expr
boolToExpr Bool
atomicBeforeProduct )
    , Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
randomSeed
    ]


data AtomicTsOrder =
  ReverseLevelAtomicTs | LevelAtomicTs | RandomAtomicTs


atomicTsOrderToExpr :: AtomicTsOrder -> Expr
atomicTsOrderToExpr :: AtomicTsOrder -> Expr
atomicTsOrderToExpr =
  \case
    AtomicTsOrder
ReverseLevelAtomicTs ->
      String -> Expr
Lit String
"reverse_level"

    AtomicTsOrder
LevelAtomicTs ->
      String -> Expr
Lit String
"level"

    AtomicTsOrder
RandomAtomicTs ->
      String -> Expr
Lit String
"random"


data ProductTsOrder =
  OldToNew | NewToOld | RandomProductTsOrder


productTsOrderToExpr :: ProductTsOrder -> Expr
productTsOrderToExpr :: ProductTsOrder -> Expr
productTsOrderToExpr =
  \case
    ProductTsOrder
OldToNew ->
      String -> Expr
Lit String
"old_to_new"

    ProductTsOrder
NewToOld ->
      String -> Expr
Lit String
"new_to_old"

    ProductTsOrder
RandomProductTsOrder ->
      String -> Expr
Lit String
"random"


randomSeedExpr :: Maybe Int -> ( String, Expr )
randomSeedExpr :: Maybe Int -> (String, Expr)
randomSeedExpr Maybe Int
r =
  ( String
"random_seed", Int -> Expr
intToExpr ( forall a. a -> Maybe a -> a
fromMaybe (-Int
1) Maybe Int
r ) )


prefOnlyExpr :: Bool -> ( String, Expr )
prefOnlyExpr :: Bool -> (String, Expr)
prefOnlyExpr Bool
b =
  ( String
"pref_only", Bool -> Expr
boolToExpr Bool
b )


transformExpr :: AbstractTask -> ( String, Expr )
transformExpr :: AbstractTask -> (String, Expr)
transformExpr AbstractTask
t =
  ( String
"transform", AbstractTask -> Expr
abstractTaskToExpr AbstractTask
t )


cacheEstimatesExpr :: Bool -> ( String, Expr )
cacheEstimatesExpr :: Bool -> (String, Expr)
cacheEstimatesExpr Bool
b =
  ( String
"cache_estimates", Bool -> Expr
boolToExpr Bool
b )


maxTimeExpr :: Maybe Double -> ( String, Expr )
maxTimeExpr :: Maybe Double -> (String, Expr)
maxTimeExpr Maybe Double
t =
  ( String
"max_time", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Double -> Expr
doubleToExpr Maybe Double
t )


orderExpr :: GoalsOrder -> ( String, Expr )
orderExpr :: GoalsOrder -> (String, Expr)
orderExpr GoalsOrder
g =
  ( String
"order", GoalsOrder -> Expr
goalsOrderToExpr GoalsOrder
g )


lpSolverOption :: LPSolver -> ( String, Expr )
lpSolverOption :: LPSolver -> (String, Expr)
lpSolverOption LPSolver
a =
  ( String
"lpsolver", LPSolver -> Expr
lpSolverToExpr LPSolver
a )


maxPotentialOption :: Maybe Double -> ( String, Expr )
maxPotentialOption :: Maybe Double -> (String, Expr)
maxPotentialOption Maybe Double
a =
  ( String
"max_potential", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Double -> Expr
doubleToExpr Maybe Double
a )


maxStatesOption :: Maybe Int -> ( String, Expr )
maxStatesOption :: Maybe Int -> (String, Expr)
maxStatesOption Maybe Int
a =
  ( String
"max_states", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
a )


maxStatesBeforeMergeOption :: Maybe Int -> ( String, Expr )
maxStatesBeforeMergeOption :: Maybe Int -> (String, Expr)
maxStatesBeforeMergeOption Maybe Int
a =
  ( String
"max_states_before_merge", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
a )


thresholdBeforeMergeOption :: Maybe Int -> ( String, Expr )
thresholdBeforeMergeOption :: Maybe Int -> (String, Expr)
thresholdBeforeMergeOption Maybe Int
a =
  ( String
"threshold_before_merge", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
a )


pdbMaxSizeOption :: Maybe Int -> ( String, Expr )
pdbMaxSizeOption :: Maybe Int -> (String, Expr)
pdbMaxSizeOption Maybe Int
a =
  ( String
"pdb_max_size", forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
infinity Int -> Expr
intToExpr Maybe Int
a )