{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE FunctionalDependencies     #-}

-- | The Search monad and SearchT monad transformer allow computations
-- to be associated with costs and cost estimates, and explore
-- possible solutions in order of overall cost.  The solution space is
-- explored using the A* algorithm, or Dijkstra's if estimates are
-- omitted.  The order of exploring computations with equal cost is
-- not defined.
--
-- Costs must be monotonic (i.e. positive) and underestimated.  If the
-- cost of a computation is overestimated or a negative cost is
-- applied, sub-optimal solutions may be produced first.
--
-- Note that while 'runSearchT' will produce a lazy list of results
-- and the computation space is only explored as far as the list is
-- forced, using 'runSearchT' with e.g. the 'IO' base monad will not.
-- You need to use 'collapse' or 'abandon' to prune the search space
-- within the monadic computation.
--
-- Example:
--
-- > import Control.Monad.Search
-- > import Data.Monoid (Sum(..))
-- >
-- > -- All naturals, weighted by the size of the number
-- > naturals :: Search (Sum Integer) Integer
-- > naturals = return 0 <|> (cost' (Sum 1) >> ((+ 1) <$> naturals))
-- >   -- [ 0, 1, 2, 3, 4, 5, ... ]
-- >
-- > -- All pairs of naturals
-- > pairs :: Search (Sum Integer) (Integer, Integer)
-- > pairs = (,) <$> naturals <*> naturals
-- >   --    [ (0, 0), (1, 0), (0, 1), (1, 1), (2, 0), ... ]
-- >   -- or [ (0, 0), (0, 1), (1, 0), (2, 0), (1, 1), ... ]
-- >   -- or ...
module Control.Monad.Search
    ( -- * The Search monad
      Search
    , runSearch
    , runSearchBest
      -- * The SearchT monad transformer
    , SearchT
    , runSearchT
    , runSearchBestT
      -- * MonadClass and search monad operations
    , MonadSearch
    , cost
    , cost'
    , junction
    , abandon
    , seal
    , collapse
    , winner
    ) where

import           Control.Applicative             ( Alternative(..) )
import           Control.Monad                   ( MonadPlus(..) )

import           Control.Monad.Cont              ( MonadCont )
import           Control.Monad.Except            ( ExceptT(..), MonadError
                                                 , runExceptT )
import           Control.Monad.IO.Class          ( MonadIO )

import qualified Control.Monad.RWS.Lazy          as Lazy ( MonadRWS, RWST(..)
                                                         , runRWST )
import qualified Control.Monad.RWS.Strict        as Strict ( RWST(..), runRWST )
import           Control.Monad.Reader            ( MonadReader, ReaderT(..)
                                                 , runReaderT )

import qualified Control.Monad.State.Lazy        as Lazy ( MonadState
                                                         , StateT(..)
                                                         , runStateT )
import qualified Control.Monad.State.Strict      as Strict ( StateT(..)
                                                           , runStateT )
import           Control.Monad.Trans.Class       ( MonadTrans, lift )
import           Control.Monad.Trans.Free        ( FreeF(Free, Pure), FreeT
                                                 , runFreeT, wrap )
import           Control.Monad.Trans.Free.Church ( FT, fromFT )
import           Control.Monad.Trans.State       ( evalStateT, gets, modify )

import qualified Control.Monad.Writer.Lazy       as Lazy ( MonadWriter
                                                         , WriterT(..)
                                                         , runWriterT )
import qualified Control.Monad.Writer.Strict     as Strict ( WriterT(..)
                                                           , runWriterT )

import           Data.Functor.Identity           ( Identity, runIdentity )
import qualified Data.IntPSQ                     as PSQ
import qualified Data.IntMap.Strict              as Map
import           Data.Maybe                      ( catMaybes, listToMaybe )
import qualified Data.IntSet                     as Set

newtype Scopemap = Scopemap { Scopemap -> IntMap IntSet
unScopemap :: Map.IntMap Set.IntSet }

singleton  :: Int -> Int -> Scopemap
singleton :: Int -> Int -> Scopemap
singleton Int
k = IntMap IntSet -> Scopemap
Scopemap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> IntMap a
Map.singleton Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntSet
Set.singleton

insert :: Int -> Int -> Scopemap -> Scopemap
insert :: Int -> Int -> Scopemap -> Scopemap
insert Int
k Int
v = IntMap IntSet -> Scopemap
Scopemap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
Map.alter Maybe IntSet -> Maybe IntSet
fn Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopemap -> IntMap IntSet
unScopemap
  where
    fn :: Maybe IntSet -> Maybe IntSet
fn = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> IntSet
Set.singleton Int
v) (Int -> IntSet -> IntSet
Set.insert Int
v)

delete :: Int -> Int -> Scopemap -> Scopemap
delete :: Int -> Int -> Scopemap -> Scopemap
delete Int
k Int
v = IntMap IntSet -> Scopemap
Scopemap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Maybe a) -> Int -> IntMap a -> IntMap a
Map.update IntSet -> Maybe IntSet
fn Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopemap -> IntMap IntSet
unScopemap
  where
    fn :: IntSet -> Maybe IntSet
fn = (\IntSet
s -> if IntSet -> Bool
Set.null IntSet
s then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just IntSet
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntSet -> IntSet
Set.delete Int
v

list :: Int -> Scopemap -> [Int]
list :: Int -> Scopemap -> [Int]
list Int
k = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] IntSet -> [Int]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopemap -> IntMap IntSet
unScopemap

listAll :: Scopemap -> [Int]
listAll :: Scopemap -> [Int]
listAll = IntSet -> [Int]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (IntSet -> IntSet -> IntSet
Set.union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) IntSet
Set.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopemap -> IntMap IntSet
unScopemap

-- | The Search monad
type Search c = SearchT c Identity

-- | Generate all solutions in order of increasing cost.
runSearch :: (Ord c, Monoid c) => Search c a -> [(c, a)]
runSearch :: forall c a. (Ord c, Monoid c) => Search c a -> [(c, a)]
runSearch = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (m :: * -> *) a.
(Ord c, Monoid c, Monad m) =>
SearchT c m a -> m [(c, a)]
runSearchT

-- | Generate only the best solution.
runSearchBest :: (Ord c, Monoid c) => Search c a -> Maybe (c, a)
runSearchBest :: forall c a. (Ord c, Monoid c) => Search c a -> Maybe (c, a)
runSearchBest = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (m :: * -> *) a.
(Ord c, Monoid c, Monad m) =>
SearchT c m a -> m (Maybe (c, a))
runSearchBestT

-- | Functor for the Free monad SearchT
data SearchF c a = Cost c c a
                 | Alt a a
                 | Enter a
                 | Exit a
                 | Collapse a
                 | Abandon
    deriving forall a b. a -> SearchF c b -> SearchF c a
forall a b. (a -> b) -> SearchF c a -> SearchF c b
forall c a b. a -> SearchF c b -> SearchF c a
forall c a b. (a -> b) -> SearchF c a -> SearchF c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SearchF c b -> SearchF c a
$c<$ :: forall c a b. a -> SearchF c b -> SearchF c a
fmap :: forall a b. (a -> b) -> SearchF c a -> SearchF c b
$cfmap :: forall c a b. (a -> b) -> SearchF c a -> SearchF c b
Functor

-- | The SearchT monad transformer
newtype SearchT c m a = SearchT { forall c (m :: * -> *) a. SearchT c m a -> FT (SearchF c) m a
unSearchT :: FT (SearchF c) m a }
    deriving (forall a b. a -> SearchT c m b -> SearchT c m a
forall a b. (a -> b) -> SearchT c m a -> SearchT c m b
forall c (m :: * -> *) a b. a -> SearchT c m b -> SearchT c m a
forall c (m :: * -> *) a b.
(a -> b) -> SearchT c m a -> SearchT c m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SearchT c m b -> SearchT c m a
$c<$ :: forall c (m :: * -> *) a b. a -> SearchT c m b -> SearchT c m a
fmap :: forall a b. (a -> b) -> SearchT c m a -> SearchT c m b
$cfmap :: forall c (m :: * -> *) a b.
(a -> b) -> SearchT c m a -> SearchT c m b
Functor, forall a. a -> SearchT c m a
forall a b. SearchT c m a -> SearchT c m b -> SearchT c m a
forall a b. SearchT c m a -> SearchT c m b -> SearchT c m b
forall a b. SearchT c m (a -> b) -> SearchT c m a -> SearchT c m b
forall a b c.
(a -> b -> c) -> SearchT c m a -> SearchT c m b -> SearchT c m c
forall c (m :: * -> *). Functor (SearchT c m)
forall c (m :: * -> *) a. a -> SearchT c m a
forall c (m :: * -> *) a b.
SearchT c m a -> SearchT c m b -> SearchT c m a
forall c (m :: * -> *) a b.
SearchT c m a -> SearchT c m b -> SearchT c m b
forall c (m :: * -> *) a b.
SearchT c m (a -> b) -> SearchT c m a -> SearchT c m b
forall c (m :: * -> *) a b c.
(a -> b -> c) -> SearchT c m a -> SearchT c m b -> SearchT c m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. SearchT c m a -> SearchT c m b -> SearchT c m a
$c<* :: forall c (m :: * -> *) a b.
SearchT c m a -> SearchT c m b -> SearchT c m a
*> :: forall a b. SearchT c m a -> SearchT c m b -> SearchT c m b
$c*> :: forall c (m :: * -> *) a b.
SearchT c m a -> SearchT c m b -> SearchT c m b
liftA2 :: forall a b c.
(a -> b -> c) -> SearchT c m a -> SearchT c m b -> SearchT c m c
$cliftA2 :: forall c (m :: * -> *) a b c.
(a -> b -> c) -> SearchT c m a -> SearchT c m b -> SearchT c m c
<*> :: forall a b. SearchT c m (a -> b) -> SearchT c m a -> SearchT c m b
$c<*> :: forall c (m :: * -> *) a b.
SearchT c m (a -> b) -> SearchT c m a -> SearchT c m b
pure :: forall a. a -> SearchT c m a
$cpure :: forall c (m :: * -> *) a. a -> SearchT c m a
Applicative, forall a. a -> SearchT c m a
forall a b. SearchT c m a -> SearchT c m b -> SearchT c m b
forall a b. SearchT c m a -> (a -> SearchT c m b) -> SearchT c m b
forall c (m :: * -> *). Applicative (SearchT c m)
forall c (m :: * -> *) a. a -> SearchT c m a
forall c (m :: * -> *) a b.
SearchT c m a -> SearchT c m b -> SearchT c m b
forall c (m :: * -> *) a b.
SearchT c m a -> (a -> SearchT c m b) -> SearchT c m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> SearchT c m a
$creturn :: forall c (m :: * -> *) a. a -> SearchT c m a
>> :: forall a b. SearchT c m a -> SearchT c m b -> SearchT c m b
$c>> :: forall c (m :: * -> *) a b.
SearchT c m a -> SearchT c m b -> SearchT c m b
>>= :: forall a b. SearchT c m a -> (a -> SearchT c m b) -> SearchT c m b
$c>>= :: forall c (m :: * -> *) a b.
SearchT c m a -> (a -> SearchT c m b) -> SearchT c m b
Monad, forall c (m :: * -> *) a. Monad m => m a -> SearchT c m a
forall (m :: * -> *) a. Monad m => m a -> SearchT c m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> SearchT c m a
$clift :: forall c (m :: * -> *) a. Monad m => m a -> SearchT c m a
MonadTrans, forall a. IO a -> SearchT c m a
forall {c} {m :: * -> *}. MonadIO m => Monad (SearchT c m)
forall c (m :: * -> *) a. MonadIO m => IO a -> SearchT c m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> SearchT c m a
$cliftIO :: forall c (m :: * -> *) a. MonadIO m => IO a -> SearchT c m a
MonadIO, MonadReader r, Lazy.MonadWriter w, Lazy.MonadState s, MonadError e, forall a b.
((a -> SearchT c m b) -> SearchT c m a) -> SearchT c m a
forall {c} {m :: * -> *}. MonadCont m => Monad (SearchT c m)
forall c (m :: * -> *) a b.
MonadCont m =>
((a -> SearchT c m b) -> SearchT c m a) -> SearchT c m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
callCC :: forall a b.
((a -> SearchT c m b) -> SearchT c m a) -> SearchT c m a
$ccallCC :: forall c (m :: * -> *) a b.
MonadCont m =>
((a -> SearchT c m b) -> SearchT c m a) -> SearchT c m a
MonadCont)

instance (Ord c, Monoid c, Monad m) => Alternative (SearchT c m) where
    empty :: forall a. SearchT c m a
empty = forall c (m :: * -> *) a. MonadSearch c m => m a
abandon
    <|> :: forall a. SearchT c m a -> SearchT c m a -> SearchT c m a
(<|>) = forall c (m :: * -> *) a. MonadSearch c m => m a -> m a -> m a
junction

instance (Ord c, Monoid c, Monad m) => MonadPlus (SearchT c m)

deriving instance Lazy.MonadRWS r w s m => Lazy.MonadRWS r w s (SearchT c m)

-- | Value type for A*/Dijkstra priority queue
data Cand c m a = Cand { forall c (m :: * -> *) a. Cand c m a -> c
candCost  :: !c
                       , forall c (m :: * -> *) a. Cand c m a -> [Int]
candScope :: ![Int]
                       , forall c (m :: * -> *) a. Cand c m a -> FreeT (SearchF c) m a
candPath  :: FreeT (SearchF c) m a
                       }

-- | State used during evaluation of SearchT
data St c m a = St { forall c (m :: * -> *) a. St c m a -> Int
stNum    :: !Int
                   , forall c (m :: * -> *) a. St c m a -> Int
stScope  :: !Int
                   , forall c (m :: * -> *) a. St c m a -> Scopemap
stActive :: !Scopemap
                   , forall c (m :: * -> *) a. St c m a -> IntPSQ c (Cand c m a)
stQueue  :: !(PSQ.IntPSQ c (Cand c m a))
                   }

-- | Generate all solutions in order of increasing cost.
runSearchT :: (Ord c, Monoid c, Monad m) => SearchT c m a -> m [(c, a)]
runSearchT :: forall c (m :: * -> *) a.
(Ord c, Monoid c, Monad m) =>
SearchT c m a -> m [(c, a)]
runSearchT SearchT c m a
m = forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall {a}. StateT (St c m a) m [Maybe (c, a)]
go St c m a
state
  where
    go :: StateT (St c m a) m [Maybe (c, a)]
go = do
        Maybe (Int, c, Cand c m a, IntPSQ c (Cand c m a))
mmin <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
PSQ.minView forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (m :: * -> *) a. St c m a -> IntPSQ c (Cand c m a)
stQueue)
        case Maybe (Int, c, Cand c m a, IntPSQ c (Cand c m a))
mmin of
            Maybe (Int, c, Cand c m a, IntPSQ c (Cand c m a))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just (Int
num, c
prio, Cand c m a
cand, IntPSQ c (Cand c m a)
q) -> do
                forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
(IntPSQ c (Cand c m a) -> IntPSQ c (Cand c m a))
-> StateT (St c m a) m ()
updateQueue forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const IntPSQ c (Cand c m a)
q
                (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {c} {a}.
(Ord c, Monoid c) =>
Int -> c -> Cand c m a -> StateT (St c m a) m (Maybe (c, a))
step Int
num c
prio Cand c m a
cand forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT (St c m a) m [Maybe (c, a)]
go

    step :: Int -> c -> Cand c m a -> StateT (St c m a) m (Maybe (c, a))
step Int
num c
prio cand :: Cand c m a
cand@Cand{c
[Int]
FreeT (SearchF c) m a
candPath :: FreeT (SearchF c) m a
candScope :: [Int]
candCost :: c
candPath :: forall c (m :: * -> *) a. Cand c m a -> FreeT (SearchF c) m a
candScope :: forall c (m :: * -> *) a. Cand c m a -> [Int]
candCost :: forall c (m :: * -> *) a. Cand c m a -> c
..} = do
        FreeF (SearchF c) a (FreeT (SearchF c) m a)
path' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT FreeT (SearchF c) m a
candPath
        case FreeF (SearchF c) a (FreeT (SearchF c) m a)
path' of
            Pure a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (c
candCost, a
a)
            Free SearchF c (FreeT (SearchF c) m a)
Abandon -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            Free (Cost c
c c
e FreeT (SearchF c) m a
p) ->
                let newCost :: c
newCost = c
candCost forall a. Monoid a => a -> a -> a
`mappend` c
c
                    newPriority :: c
newPriority = forall a. Ord a => a -> a -> a
max c
prio forall a b. (a -> b) -> a -> b
$ c
newCost forall a. Monoid a => a -> a -> a
`mappend` c
e
                in do
                    Bool
reschedule <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False
                                              (\(Int
_, c
x, Cand c m a
_) -> c
x forall a. Ord a => a -> a -> Bool
<= c
newPriority) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v)
PSQ.findMin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (m :: * -> *) a. St c m a -> IntPSQ c (Cand c m a)
stQueue)
                    let cand' :: Cand c m a
cand' = Cand c m a
cand { candCost :: c
candCost = c
newCost, candPath :: FreeT (SearchF c) m a
candPath = FreeT (SearchF c) m a
p }
                    if Bool
reschedule
                        then do
                            forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
(IntPSQ c (Cand c m a) -> IntPSQ c (Cand c m a))
-> StateT (St c m a) m ()
updateQueue forall a b. (a -> b) -> a -> b
$ forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
PSQ.insert Int
num c
newPriority Cand c m a
cand'
                            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                        else Int -> c -> Cand c m a -> StateT (St c m a) m (Maybe (c, a))
step Int
num c
newPriority Cand c m a
cand'
            Free (Alt FreeT (SearchF c) m a
lhs FreeT (SearchF c) m a
rhs) -> do
                Int
num' <- forall {c} {m :: * -> *} {a}. StateT (St c m a) m Int
nextNum
                forall {m :: * -> *} {t :: * -> *} {c} {m :: * -> *} {a}.
(Monad m, Foldable t) =>
t Int -> Int -> StateT (St c m a) m ()
addScopes [Int]
candScope Int
num'
                forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
(IntPSQ c (Cand c m a) -> IntPSQ c (Cand c m a))
-> StateT (St c m a) m ()
updateQueue forall a b. (a -> b) -> a -> b
$ forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
PSQ.insert Int
num' c
prio Cand c m a
cand { candPath :: FreeT (SearchF c) m a
candPath = FreeT (SearchF c) m a
rhs }
                Int -> c -> Cand c m a -> StateT (St c m a) m (Maybe (c, a))
step Int
num c
prio Cand c m a
cand { candPath :: FreeT (SearchF c) m a
candPath = FreeT (SearchF c) m a
lhs }
            Free (Enter FreeT (SearchF c) m a
p) -> do
                Int
scope <- forall {c} {m :: * -> *} {a}. StateT (St c m a) m Int
nextScope
                forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
Int -> Int -> StateT (St c m a) m ()
addScope Int
scope Int
num
                Int -> c -> Cand c m a -> StateT (St c m a) m (Maybe (c, a))
step Int
num
                     c
prio
                     Cand c m a
cand { candScope :: [Int]
candScope = Int
scope forall a. a -> [a] -> [a]
: [Int]
candScope, candPath :: FreeT (SearchF c) m a
candPath = FreeT (SearchF c) m a
p }
            Free (Exit FreeT (SearchF c) m a
p) -> do
                forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
Int -> Int -> StateT (St c m a) m ()
delScope (forall a. [a] -> a
head [Int]
candScope) Int
num
                Int -> c -> Cand c m a -> StateT (St c m a) m (Maybe (c, a))
step Int
num c
prio Cand c m a
cand { candScope :: [Int]
candScope = forall a. [a] -> [a]
tail [Int]
candScope, candPath :: FreeT (SearchF c) m a
candPath = FreeT (SearchF c) m a
p }
            Free (Collapse FreeT (SearchF c) m a
p) -> do
                [Int]
cs <- forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
Maybe Int -> StateT (St c m a) m [Int]
listScope forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe [Int]
candScope
                forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
(IntPSQ c (Cand c m a) -> IntPSQ c (Cand c m a))
-> StateT (St c m a) m ()
updateQueue forall a b. (a -> b) -> a -> b
$ \IntPSQ c (Cand c m a)
q -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v
PSQ.delete IntPSQ c (Cand c m a)
q [Int]
cs
                Int -> c -> Cand c m a -> StateT (St c m a) m (Maybe (c, a))
step Int
num c
prio Cand c m a
cand { candPath :: FreeT (SearchF c) m a
candPath = FreeT (SearchF c) m a
p }

    nextNum :: StateT (St c m a) m Int
nextNum = do
        forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \St c m a
s -> St c m a
s { stNum :: Int
stNum = forall c (m :: * -> *) a. St c m a -> Int
stNum St c m a
s forall a. Num a => a -> a -> a
+ Int
1 }
        forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets forall c (m :: * -> *) a. St c m a -> Int
stNum

    nextScope :: StateT (St c m a) m Int
nextScope = do
        forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \St c m a
s -> St c m a
s { stScope :: Int
stScope = forall c (m :: * -> *) a. St c m a -> Int
stScope St c m a
s forall a. Num a => a -> a -> a
+ Int
1 }
        forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets forall c (m :: * -> *) a. St c m a -> Int
stScope

    addScope :: Int -> Int -> StateT (St c m a) m ()
addScope Int
scope Int
c = forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
(Scopemap -> Scopemap) -> StateT (St c m a) m ()
updateActive forall a b. (a -> b) -> a -> b
$ Int -> Int -> Scopemap -> Scopemap
insert Int
scope Int
c

    addScopes :: t Int -> Int -> StateT (St c m a) m ()
addScopes t Int
scopes Int
c = forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
(Scopemap -> Scopemap) -> StateT (St c m a) m ()
updateActive forall a b. (a -> b) -> a -> b
$ \Scopemap
sm -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Scopemap -> Scopemap
`insert` Int
c) Scopemap
sm t Int
scopes

    delScope :: Int -> Int -> StateT (St c m a) m ()
delScope Int
scope Int
c = forall {m :: * -> *} {c} {m :: * -> *} {a}.
Monad m =>
(Scopemap -> Scopemap) -> StateT (St c m a) m ()
updateActive forall a b. (a -> b) -> a -> b
$ Int -> Int -> Scopemap -> Scopemap
delete Int
scope Int
c

    listScope :: Maybe Int -> StateT (St c m a) m [Int]
listScope Maybe Int
scope = forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Scopemap -> [Int]
listAll Int -> Scopemap -> [Int]
list Maybe Int
scope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (m :: * -> *) a. St c m a -> Scopemap
stActive

    updateQueue :: (IntPSQ c (Cand c m a) -> IntPSQ c (Cand c m a))
-> StateT (St c m a) m ()
updateQueue IntPSQ c (Cand c m a) -> IntPSQ c (Cand c m a)
f = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \St c m a
s -> St c m a
s { stQueue :: IntPSQ c (Cand c m a)
stQueue = IntPSQ c (Cand c m a) -> IntPSQ c (Cand c m a)
f (forall c (m :: * -> *) a. St c m a -> IntPSQ c (Cand c m a)
stQueue St c m a
s) }

    updateActive :: (Scopemap -> Scopemap) -> StateT (St c m a) m ()
updateActive Scopemap -> Scopemap
f = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \St c m a
s -> St c m a
s { stActive :: Scopemap
stActive = Scopemap -> Scopemap
f (forall c (m :: * -> *) a. St c m a -> Scopemap
stActive St c m a
s) }

    state :: St c m a
state = forall c (m :: * -> *) a.
Int -> Int -> Scopemap -> IntPSQ c (Cand c m a) -> St c m a
St Int
0 Int
0 (Int -> Int -> Scopemap
singleton Int
0 Int
0) IntPSQ c (Cand c m a)
queue

    queue :: IntPSQ c (Cand c m a)
queue = forall p v. Ord p => Int -> p -> v -> IntPSQ p v
PSQ.singleton Int
0 forall a. Monoid a => a
mempty (forall c (m :: * -> *) a.
c -> [Int] -> FreeT (SearchF c) m a -> Cand c m a
Cand forall a. Monoid a => a
mempty [ Int
0 ] (forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *) a. SearchT c m a -> FT (SearchF c) m a
unSearchT SearchT c m a
m))

-- | Generate only the best solutions.
runSearchBestT :: (Ord c, Monoid c, Monad m) => SearchT c m a -> m (Maybe (c, a))
runSearchBestT :: forall c (m :: * -> *) a.
(Ord c, Monoid c, Monad m) =>
SearchT c m a -> m (Maybe (c, a))
runSearchBestT SearchT c m a
m = forall a. [a] -> Maybe a
listToMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) a.
(Ord c, Monoid c, Monad m) =>
SearchT c m a -> m [(c, a)]
runSearchT (SearchT c m a
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall c (m :: * -> *). MonadSearch c m => m ()
collapse)

-- | Minimal definition is @cost@, @junction@, and @abandon@.
class (Ord c, Monoid c, Monad m) => MonadSearch c m | m -> c where
    -- | Mark a computation with a definitive cost and additional
    -- estimated cost.  Definitive costs are accumulated and reported,
    -- while the estimate is reset with every call to `cost` and will
    -- not be included in the final result.
    cost :: c -> c -> m ()

    -- | Introduce an alternative computational path to be evaluated
    -- concurrently.
    junction :: m a -> m a -> m a

    -- | Abandon a computation.
    abandon :: m a

    -- | Limit the effect of `collapse` to alternatives within the
    -- sealed scope.
    seal :: m a -> m a

    -- | Abandon all other computations within the current sealed
    -- scope.
    collapse :: m ()

instance (Ord c, Monoid c, Monad m) => MonadSearch c (SearchT c m) where
    cost :: c -> c -> SearchT c m ()
cost c
c c
e = forall c (m :: * -> *) a. FT (SearchF c) m a -> SearchT c m a
SearchT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall a b. (a -> b) -> a -> b
$ forall c a. c -> c -> a -> SearchF c a
Cost c
c c
e (forall (m :: * -> *) a. Monad m => a -> m a
return ())
    junction :: forall a. SearchT c m a -> SearchT c m a -> SearchT c m a
junction SearchT c m a
lhs SearchT c m a
rhs = forall c (m :: * -> *) a. FT (SearchF c) m a -> SearchT c m a
SearchT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall a b. (a -> b) -> a -> b
$ forall c a. a -> a -> SearchF c a
Alt (forall c (m :: * -> *) a. SearchT c m a -> FT (SearchF c) m a
unSearchT SearchT c m a
lhs) (forall c (m :: * -> *) a. SearchT c m a -> FT (SearchF c) m a
unSearchT SearchT c m a
rhs)
    abandon :: forall a. SearchT c m a
abandon = forall c (m :: * -> *) a. FT (SearchF c) m a -> SearchT c m a
SearchT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall a b. (a -> b) -> a -> b
$ forall c a. SearchF c a
Abandon
    seal :: forall a. SearchT c m a -> SearchT c m a
seal SearchT c m a
m = forall c (m :: * -> *) a. FT (SearchF c) m a -> SearchT c m a
SearchT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall a b. (a -> b) -> a -> b
$ forall c a. a -> SearchF c a
Enter (forall c (m :: * -> *) a. SearchT c m a -> FT (SearchF c) m a
unSearchT SearchT c m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. a -> SearchF c a
Exit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return)
    collapse :: SearchT c m ()
collapse = forall c (m :: * -> *) a. FT (SearchF c) m a -> SearchT c m a
SearchT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall a b. (a -> b) -> a -> b
$ forall c a. a -> SearchF c a
Collapse (forall (m :: * -> *) a. Monad m => a -> m a
return ())

instance MonadSearch c m => MonadSearch c (ReaderT r m) where
    cost :: c -> c -> ReaderT r m ()
cost c
c c
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost c
c c
e
    junction :: forall a. ReaderT r m a -> ReaderT r m a -> ReaderT r m a
junction ReaderT r m a
lhs ReaderT r m a
rhs = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$
        \r
r -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a -> m a
junction (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
lhs r
r) (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
rhs r
r)
    abandon :: forall a. ReaderT r m a
abandon = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *) a. MonadSearch c m => m a
abandon
    seal :: forall a. ReaderT r m a -> ReaderT r m a
seal ReaderT r m a
m = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
seal (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r)
    collapse :: ReaderT r m ()
collapse = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *). MonadSearch c m => m ()
collapse

instance (Monoid w, MonadSearch c m) => MonadSearch c (Lazy.WriterT w m) where
    cost :: c -> c -> WriterT w m ()
cost c
c c
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost c
c c
e
    junction :: forall a. WriterT w m a -> WriterT w m a -> WriterT w m a
junction WriterT w m a
lhs WriterT w m a
rhs = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$
        forall c (m :: * -> *) a. MonadSearch c m => m a -> m a -> m a
junction (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
lhs) (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
rhs)
    abandon :: forall a. WriterT w m a
abandon = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *) a. MonadSearch c m => m a
abandon
    seal :: forall a. WriterT w m a -> WriterT w m a
seal WriterT w m a
m = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
seal (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
m)
    collapse :: WriterT w m ()
collapse = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *). MonadSearch c m => m ()
collapse

instance (Monoid w, MonadSearch c m) => MonadSearch c (Strict.WriterT w m) where
    cost :: c -> c -> WriterT w m ()
cost c
c c
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost c
c c
e
    junction :: forall a. WriterT w m a -> WriterT w m a -> WriterT w m a
junction WriterT w m a
lhs WriterT w m a
rhs = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$
        forall c (m :: * -> *) a. MonadSearch c m => m a -> m a -> m a
junction (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
lhs) (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
rhs)
    abandon :: forall a. WriterT w m a
abandon = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *) a. MonadSearch c m => m a
abandon
    seal :: forall a. WriterT w m a -> WriterT w m a
seal WriterT w m a
m = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
seal (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
m)
    collapse :: WriterT w m ()
collapse = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *). MonadSearch c m => m ()
collapse

instance MonadSearch c m => MonadSearch c (Lazy.StateT s m) where
    cost :: c -> c -> StateT s m ()
cost c
c c
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost c
c c
e
    junction :: forall a. StateT s m a -> StateT s m a -> StateT s m a
junction StateT s m a
lhs StateT s m a
rhs = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$
        \s
s -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a -> m a
junction (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
lhs s
s) (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
rhs s
s)
    abandon :: forall a. StateT s m a
abandon = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *) a. MonadSearch c m => m a
abandon
    seal :: forall a. StateT s m a -> StateT s m a
seal StateT s m a
m = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
seal (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
m s
s)
    collapse :: StateT s m ()
collapse = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *). MonadSearch c m => m ()
collapse

instance MonadSearch c m => MonadSearch c (Strict.StateT s m) where
    cost :: c -> c -> StateT s m ()
cost c
c c
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost c
c c
e
    junction :: forall a. StateT s m a -> StateT s m a -> StateT s m a
junction StateT s m a
lhs StateT s m a
rhs = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$
        \s
s -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a -> m a
junction (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
lhs s
s) (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
rhs s
s)
    abandon :: forall a. StateT s m a
abandon = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *) a. MonadSearch c m => m a
abandon
    seal :: forall a. StateT s m a -> StateT s m a
seal StateT s m a
m = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
seal (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
m s
s)
    collapse :: StateT s m ()
collapse = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *). MonadSearch c m => m ()
collapse

instance (Monoid w, MonadSearch c m) => MonadSearch c (Lazy.RWST r w s m) where
    cost :: c -> c -> RWST r w s m ()
cost c
c c
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost c
c c
e
    junction :: forall a. RWST r w s m a -> RWST r w s m a -> RWST r w s m a
junction RWST r w s m a
lhs RWST r w s m a
rhs = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$
        \r
r s
s -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a -> m a
junction (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST RWST r w s m a
lhs r
r s
s) (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST RWST r w s m a
rhs r
r s
s)
    abandon :: forall a. RWST r w s m a
abandon = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *) a. MonadSearch c m => m a
abandon
    seal :: forall a. RWST r w s m a -> RWST r w s m a
seal RWST r w s m a
m = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
seal (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST RWST r w s m a
m r
r s
s)
    collapse :: RWST r w s m ()
collapse = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *). MonadSearch c m => m ()
collapse

instance (Monoid w, MonadSearch c m) => MonadSearch c (Strict.RWST r w s m) where
    cost :: c -> c -> RWST r w s m ()
cost c
c c
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost c
c c
e
    junction :: forall a. RWST r w s m a -> RWST r w s m a -> RWST r w s m a
junction RWST r w s m a
lhs RWST r w s m a
rhs = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$
        \r
r s
s -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a -> m a
junction (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s m a
lhs r
r s
s) (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s m a
rhs r
r s
s)
    abandon :: forall a. RWST r w s m a
abandon = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *) a. MonadSearch c m => m a
abandon
    seal :: forall a. RWST r w s m a -> RWST r w s m a
seal RWST r w s m a
m = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
seal (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s m a
m r
r s
s)
    collapse :: RWST r w s m ()
collapse = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *). MonadSearch c m => m ()
collapse

instance MonadSearch c m => MonadSearch c (ExceptT e m) where
    cost :: c -> c -> ExceptT e m ()
cost c
c c
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost c
c c
e
    junction :: forall a. ExceptT e m a -> ExceptT e m a -> ExceptT e m a
junction ExceptT e m a
lhs ExceptT e m a
rhs = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *) a. MonadSearch c m => m a -> m a -> m a
junction (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
lhs) (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
rhs)
    abandon :: forall a. ExceptT e m a
abandon = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *) a. MonadSearch c m => m a
abandon
    seal :: forall a. ExceptT e m a -> ExceptT e m a
seal ExceptT e m a
m = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
seal (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
m)
    collapse :: ExceptT e m ()
collapse = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c (m :: * -> *). MonadSearch c m => m ()
collapse

-- | Mark an operation with a cost.
--
-- > cost' c = cost c mempty
cost' :: MonadSearch c m => c -> m ()
cost' :: forall c (m :: * -> *). MonadSearch c m => c -> m ()
cost' c
c = forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost c
c forall a. Monoid a => a
mempty

-- | Limit a given computation to the first successful return.
--
-- > winner m = seal (m <* collapse)
winner :: MonadSearch c m => m a -> m a
winner :: forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
winner m a
m = forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
seal forall a b. (a -> b) -> a -> b
$ m a
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall c (m :: * -> *). MonadSearch c m => m ()
collapse