{-
    Copyright (C) Stilo International plc, 2019

    This source code is unpublished proprietary information of Stilo
    Corporation.  The copyright notice above does not evidence any
    actual or intended publication of such source code.

    This file may not be redistributed as source, either by itself,
    or as part of software derived from this file.
-}

{-# LANGUAGE GADTs, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-}

module Data.PriorityQueue (PQueue, Branching, Pruned,
                           branchable, prune, pruneAbove, pruneAlternativesAbove, mapWithCost, filter, mapMaybe, foldPeers,
                           canonical, pruneSubsets, strip, stripCommon, stripCost,
                           cost, leastCost, withCost) where

import Control.Applicative (Applicative(..), Alternative(..))
import Data.Coerce (coerce)
import Data.Foldable (Foldable(fold))
import Data.Monoid (Monoid(mempty, mappend), Alt(Alt, getAlt))
import Data.Semigroup (Semigroup((<>)))

import Prelude hiding (filter)

data Branching
data Pruned

data PQueue t c a = Costly !c (PQueue t c a)
                  | Free !(Ground a) (PQueue t c a)
                  | Empty String
                  deriving Int -> PQueue t c a -> ShowS
[PQueue t c a] -> ShowS
PQueue t c a -> String
(Int -> PQueue t c a -> ShowS)
-> (PQueue t c a -> String)
-> ([PQueue t c a] -> ShowS)
-> Show (PQueue t c a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t c a. (Show c, Show a) => Int -> PQueue t c a -> ShowS
forall t c a. (Show c, Show a) => [PQueue t c a] -> ShowS
forall t c a. (Show c, Show a) => PQueue t c a -> String
showList :: [PQueue t c a] -> ShowS
$cshowList :: forall t c a. (Show c, Show a) => [PQueue t c a] -> ShowS
show :: PQueue t c a -> String
$cshow :: forall t c a. (Show c, Show a) => PQueue t c a -> String
showsPrec :: Int -> PQueue t c a -> ShowS
$cshowsPrec :: forall t c a. (Show c, Show a) => Int -> PQueue t c a -> ShowS
Show

data Ground a = Leaf a
              | Peer !(Ground a) !(Ground a)
              deriving Int -> Ground a -> ShowS
[Ground a] -> ShowS
Ground a -> String
(Int -> Ground a -> ShowS)
-> (Ground a -> String) -> ([Ground a] -> ShowS) -> Show (Ground a)
forall a. Show a => Int -> Ground a -> ShowS
forall a. Show a => [Ground a] -> ShowS
forall a. Show a => Ground a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ground a] -> ShowS
$cshowList :: forall a. Show a => [Ground a] -> ShowS
show :: Ground a -> String
$cshow :: forall a. Show a => Ground a -> String
showsPrec :: Int -> Ground a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Ground a -> ShowS
Show

instance Foldable Ground where
   foldMap :: (a -> m) -> Ground a -> m
foldMap a -> m
f (Leaf a
a) = a -> m
f a
a
   foldMap a -> m
f (Peer Ground a
g Ground a
h) = (a -> m) -> Ground a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Ground a
g m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Ground a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Ground a
h

instance Functor Ground where
   fmap :: (a -> b) -> Ground a -> Ground b
fmap a -> b
f (Leaf a
a) = b -> Ground b
forall a. a -> Ground a
Leaf (a -> b
f a
a)
   fmap a -> b
f (Peer Ground a
g Ground a
h) = Ground b -> Ground b -> Ground b
forall a. Ground a -> Ground a -> Ground a
Peer ((a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Ground a
g) ((a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Ground a
h)

instance Applicative Ground where
   Leaf a -> b
f <*> :: Ground (a -> b) -> Ground a -> Ground b
<*> Ground a
g = a -> b
f (a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ground a
g
   Peer Ground (a -> b)
g1 Ground (a -> b)
g2 <*> Ground a
h = Ground b -> Ground b -> Ground b
forall a. Ground a -> Ground a -> Ground a
Peer (Ground (a -> b)
g1 Ground (a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ground a
h) (Ground (a -> b)
g2 Ground (a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ground a
h)
   pure :: a -> Ground a
pure = a -> Ground a
forall a. a -> Ground a
Leaf

instance Foldable (PQueue t c) where
   foldMap :: (a -> m) -> PQueue t c a -> m
foldMap a -> m
f (Costly c
_ PQueue t c a
q) = (a -> m) -> PQueue t c a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f PQueue t c a
q
   foldMap a -> m
f (Free Ground a
a PQueue t c a
q) = (a -> m) -> Ground a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Ground a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> PQueue t c a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f PQueue t c a
q
   foldMap a -> m
f Empty{} = m
forall a. Monoid a => a
mempty

instance Functor (PQueue t c) where
   fmap :: (a -> b) -> PQueue t c a -> PQueue t c b
fmap a -> b
f (Costly c
c PQueue t c a
q) = c -> PQueue t c b -> PQueue t c b
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c ((a -> b) -> PQueue t c a -> PQueue t c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PQueue t c a
q)
   fmap a -> b
f (Free Ground a
a PQueue t c a
q) = Ground b -> PQueue t c b -> PQueue t c b
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free ((a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Ground a
a) ((a -> b) -> PQueue t c a -> PQueue t c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PQueue t c a
q)
   fmap a -> b
_ (Empty String
msg) = String -> PQueue t c b
forall t c a. String -> PQueue t c a
Empty String
msg

instance (Alternative (PQueue t c), Semigroup c) => Applicative (PQueue t c) where
   Costly c
c1 PQueue t c (a -> b)
q1 <*> :: PQueue t c (a -> b) -> PQueue t c a -> PQueue t c b
<*> Costly c
c2 PQueue t c a
q2 = c -> PQueue t c b -> PQueue t c b
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly (c
c1 c -> c -> c
forall a. Semigroup a => a -> a -> a
<> c
c2) (PQueue t c (a -> b)
q1 PQueue t c (a -> b) -> PQueue t c a -> PQueue t c b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PQueue t c a
q2)
   Costly c
c PQueue t c (a -> b)
q1 <*> PQueue t c a
q2 = c -> PQueue t c b -> PQueue t c b
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c (PQueue t c (a -> b)
q1 PQueue t c (a -> b) -> PQueue t c a -> PQueue t c b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PQueue t c a
q2)
   PQueue t c (a -> b)
q1 <*> Costly c
c PQueue t c a
q2 = c -> PQueue t c b -> PQueue t c b
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c (PQueue t c (a -> b)
q1 PQueue t c (a -> b) -> PQueue t c a -> PQueue t c b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PQueue t c a
q2)
   Free Ground (a -> b)
f PQueue t c (a -> b)
q1 <*> Free Ground a
a PQueue t c a
q2 = Ground b -> PQueue t c b -> PQueue t c b
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free (Ground (a -> b)
f Ground (a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ground a
a) ((Ground a -> Ground b) -> PQueue t c a -> PQueue t c b
forall a a t c t.
(Ground a -> Ground a) -> PQueue t c a -> PQueue t c a
mapPeers (Ground (a -> b)
f Ground (a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) PQueue t c a
q2 PQueue t c b -> PQueue t c b -> PQueue t c b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Ground (a -> b) -> Ground b)
-> PQueue t c (a -> b) -> PQueue t c b
forall a a t c t.
(Ground a -> Ground a) -> PQueue t c a -> PQueue t c a
mapPeers (Ground (a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ground a
a) PQueue t c (a -> b)
q1 PQueue t c b -> PQueue t c b -> PQueue t c b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQueue t c (a -> b)
q1 PQueue t c (a -> b) -> PQueue t c a -> PQueue t c b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PQueue t c a
q2)
      where mapPeers :: (Ground a -> Ground a) -> PQueue t c a -> PQueue t c a
mapPeers Ground a -> Ground a
f (Free Ground a
g PQueue t c a
q) = Ground a -> PQueue t c a -> PQueue t c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free (Ground a -> Ground a
f Ground a
g) ((Ground a -> Ground a) -> PQueue t c a -> PQueue t c a
mapPeers Ground a -> Ground a
f PQueue t c a
q)
            mapPeers Ground a -> Ground a
f (Costly c
c PQueue t c a
q) = c -> PQueue t c a -> PQueue t c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c ((Ground a -> Ground a) -> PQueue t c a -> PQueue t c a
mapPeers Ground a -> Ground a
f PQueue t c a
q)
            mapPeers Ground a -> Ground a
_ (Empty String
msg) = String -> PQueue t c a
forall t c a. String -> PQueue t c a
Empty String
msg
   Empty String
msg <*> PQueue t c a
_ = String -> PQueue t c b
forall t c a. String -> PQueue t c a
Empty String
msg
   PQueue t c (a -> b)
_ <*> Empty String
msg = String -> PQueue t c b
forall t c a. String -> PQueue t c a
Empty String
msg
   pure :: a -> PQueue t c a
pure a
a = Ground a -> PQueue t c a -> PQueue t c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free (a -> Ground a
forall a. a -> Ground a
Leaf a
a) (String -> PQueue t c a
forall t c a. String -> PQueue t c a
Empty String
"")
   {-# INLINABLE (<*>) #-}

instance (Num c, Ord c, Semigroup c) => Alternative (PQueue Branching c) where
   Costly c
c1 PQueue Branching c a
q1 <|> :: PQueue Branching c a
-> PQueue Branching c a -> PQueue Branching c a
<|> Costly c
c2 PQueue Branching c a
q2 = {-# SCC "AltB.compare" #-}
      case c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare c
c1 c
c2
      of Ordering
LT -> c -> PQueue Branching c a -> PQueue Branching c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c1 (PQueue Branching c a
q1 PQueue Branching c a
-> PQueue Branching c a -> PQueue Branching c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> c -> PQueue Branching c a -> PQueue Branching c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly (c
c2 c -> c -> c
forall a. Num a => a -> a -> a
- c
c1) PQueue Branching c a
q2)
         Ordering
GT -> c -> PQueue Branching c a -> PQueue Branching c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c2 (c -> PQueue Branching c a -> PQueue Branching c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly (c
c1 c -> c -> c
forall a. Num a => a -> a -> a
- c
c2) PQueue Branching c a
q1 PQueue Branching c a
-> PQueue Branching c a -> PQueue Branching c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQueue Branching c a
q2)
         Ordering
EQ -> c -> PQueue Branching c a -> PQueue Branching c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c1 (PQueue Branching c a
q1 PQueue Branching c a
-> PQueue Branching c a -> PQueue Branching c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQueue Branching c a
q2)
   Free Ground a
a PQueue Branching c a
q1 <|> Free Ground a
b PQueue Branching c a
q2 = Ground a -> PQueue Branching c a -> PQueue Branching c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free (Ground a -> Ground a -> Ground a
forall a. Ground a -> Ground a -> Ground a
Peer Ground a
a Ground a
b) (PQueue Branching c a
q1 PQueue Branching c a
-> PQueue Branching c a -> PQueue Branching c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQueue Branching c a
q2)
   Free Ground a
a PQueue Branching c a
q1 <|> PQueue Branching c a
q2 = Ground a -> PQueue Branching c a -> PQueue Branching c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free Ground a
a (PQueue Branching c a
q1 PQueue Branching c a
-> PQueue Branching c a -> PQueue Branching c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQueue Branching c a
q2)
   PQueue Branching c a
q1 <|> Free Ground a
a PQueue Branching c a
q2 = Ground a -> PQueue Branching c a -> PQueue Branching c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free Ground a
a (PQueue Branching c a
q1 PQueue Branching c a
-> PQueue Branching c a -> PQueue Branching c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQueue Branching c a
q2)
   Empty{} <|> PQueue Branching c a
pq = PQueue Branching c a
pq
   PQueue Branching c a
pq <|> Empty{} = PQueue Branching c a
pq
   empty :: PQueue Branching c a
empty = String -> PQueue Branching c a
forall t c a. String -> PQueue t c a
Empty String
"empty"
   {-# INLINABLE (<|>) #-}

instance (Num c, Ord c, Semigroup c) => Alternative (PQueue Pruned c) where
   Costly c
c1 PQueue Pruned c a
q1 <|> :: PQueue Pruned c a -> PQueue Pruned c a -> PQueue Pruned c a
<|> Costly c
c2 PQueue Pruned c a
q2 = {-# SCC "AltP.compare" #-}
      case c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare c
c1 c
c2
      of Ordering
LT -> c -> PQueue Pruned c a -> PQueue Pruned c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c1 (PQueue Pruned c a
q1 PQueue Pruned c a -> PQueue Pruned c a -> PQueue Pruned c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> c -> PQueue Pruned c a -> PQueue Pruned c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly (c
c2 c -> c -> c
forall a. Num a => a -> a -> a
- c
c1) PQueue Pruned c a
q2)
         Ordering
GT -> c -> PQueue Pruned c a -> PQueue Pruned c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c2 (c -> PQueue Pruned c a -> PQueue Pruned c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly (c
c1 c -> c -> c
forall a. Num a => a -> a -> a
- c
c2) PQueue Pruned c a
q1 PQueue Pruned c a -> PQueue Pruned c a -> PQueue Pruned c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQueue Pruned c a
q2)
         Ordering
EQ -> c -> PQueue Pruned c a -> PQueue Pruned c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c1 (PQueue Pruned c a
q1 PQueue Pruned c a -> PQueue Pruned c a -> PQueue Pruned c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQueue Pruned c a
q2)
   Free Ground a
a PQueue Pruned c a
_ <|> PQueue Pruned c a
_ = Ground a -> PQueue Pruned c a -> PQueue Pruned c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free Ground a
a (String -> PQueue Pruned c a
forall t c a. String -> PQueue t c a
Empty String
"")
   PQueue Pruned c a
_ <|> Free Ground a
a PQueue Pruned c a
_ = Ground a -> PQueue Pruned c a -> PQueue Pruned c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free Ground a
a (String -> PQueue Pruned c a
forall t c a. String -> PQueue t c a
Empty String
"")
   Empty{} <|> PQueue Pruned c a
pq = PQueue Pruned c a
pq
   PQueue Pruned c a
pq <|> Empty{} = PQueue Pruned c a
pq
   empty :: PQueue Pruned c a
empty = String -> PQueue Pruned c a
forall t c a. String -> PQueue t c a
Empty String
"empty"
   {-# INLINABLE (<|>) #-}

instance (Semigroup c, Alternative (PQueue t c)) => Monad (PQueue t c) where
   Costly c
c PQueue t c a
q >>= :: PQueue t c a -> (a -> PQueue t c b) -> PQueue t c b
>>= a -> PQueue t c b
f = c -> PQueue t c b -> PQueue t c b
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c (PQueue t c a
q PQueue t c a -> (a -> PQueue t c b) -> PQueue t c b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> PQueue t c b
f)
   Free Ground a
a PQueue t c a
q >>= a -> PQueue t c b
f = Alt (PQueue t c) b -> PQueue t c b
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt ((a -> Alt (PQueue t c) b) -> Ground a -> Alt (PQueue t c) b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PQueue t c b -> Alt (PQueue t c) b
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (PQueue t c b -> Alt (PQueue t c) b)
-> (a -> PQueue t c b) -> a -> Alt (PQueue t c) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PQueue t c b
f) Ground a
a) PQueue t c b -> PQueue t c b -> PQueue t c b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PQueue t c a
q PQueue t c a -> (a -> PQueue t c b) -> PQueue t c b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> PQueue t c b
f)
   Empty String
msg >>= a -> PQueue t c b
_ = String -> PQueue t c b
forall t c a. String -> PQueue t c a
Empty String
msg
   {-# INLINABLE (>>=) #-}

instance (Semigroup c, Alternative (PQueue t c)) => MonadFail (PQueue t c) where
   fail :: String -> PQueue t c a
fail = String -> PQueue t c a
forall t c a. String -> PQueue t c a
Empty

-- | @withCost k@ adds a penalty of k to each value in the queue.
withCost :: (Semigroup c, Num c, Ord c) => c -> PQueue t c a -> PQueue t c a
withCost :: c -> PQueue t c a -> PQueue t c a
withCost c
0 PQueue t c a
q = PQueue t c a
q
withCost c
c PQueue t c a
q | c
c c -> c -> Bool
forall a. Ord a => a -> a -> Bool
<= c
0 = String -> PQueue t c a
forall a. HasCallStack => String -> a
error String
"The cost must be non-negative!"
             | Bool
otherwise = c -> PQueue t c a -> PQueue t c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c PQueue t c a
q
{-# INLINE withCost #-}

-- | Fold together all stored values that share the same priority.
foldPeers :: (a -> a -> a) -> PQueue t c a -> PQueue t c a
foldPeers :: (a -> a -> a) -> PQueue t c a -> PQueue t c a
foldPeers a -> a -> a
_ q :: PQueue t c a
q@Empty{} = PQueue t c a
q
foldPeers a -> a -> a
f (Costly c
c PQueue t c a
q) = c -> PQueue t c a -> PQueue t c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c ((a -> a -> a) -> PQueue t c a -> PQueue t c a
forall a t c. (a -> a -> a) -> PQueue t c a -> PQueue t c a
foldPeers a -> a -> a
f PQueue t c a
q)
foldPeers a -> a -> a
f (Free Ground a
g PQueue t c a
q) = Ground a -> PQueue t c a -> PQueue t c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free (a -> Ground a
forall a. a -> Ground a
Leaf a
a'') PQueue t c a
q''
   where (a
a'', PQueue t c a
q'') = case (a -> a -> a) -> PQueue t c a -> PQueue t c a
forall a t c. (a -> a -> a) -> PQueue t c a -> PQueue t c a
foldPeers a -> a -> a
f PQueue t c a
q
                      of Free (Leaf a
b) PQueue t c a
q' -> (a -> a -> a
f a
a' a
b, PQueue t c a
q')
                         PQueue t c a
q' -> (a
a', PQueue t c a
q')
         a' :: a
a' = (a -> a -> a) -> Ground a -> a
forall a. (a -> a -> a) -> Ground a -> a
foldGroundPeers a -> a -> a
f Ground a
g

foldGroundPeers :: (a -> a -> a) -> Ground a -> a
foldGroundPeers :: (a -> a -> a) -> Ground a -> a
foldGroundPeers a -> a -> a
_ (Leaf a
a) = a
a
foldGroundPeers a -> a -> a
f (Peer Ground a
l Ground a
r) = a -> a -> a
f ((a -> a -> a) -> Ground a -> a
forall a. (a -> a -> a) -> Ground a -> a
foldGroundPeers a -> a -> a
f Ground a
l) ((a -> a -> a) -> Ground a -> a
forall a. (a -> a -> a) -> Ground a -> a
foldGroundPeers a -> a -> a
f Ground a
r)

-- | Imposes the given cost on the current computation branch.
-- > cost k = withCost k (pure ())
cost :: (Semigroup c, Num c, Ord c) => c -> PQueue Branching c ()
cost :: c -> PQueue Branching c ()
cost c
0 = () -> PQueue Branching c ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
cost c
k | c
k c -> c -> Bool
forall a. Ord a => a -> a -> Bool
> c
0 = c -> PQueue Branching c () -> PQueue Branching c ()
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
k (() -> PQueue Branching c ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Relax the 'Pruned' phantom constraint, allowing the queue to become 'Branching'.
branchable :: PQueue Pruned c a -> PQueue t c a
branchable :: PQueue Pruned c a -> PQueue t c a
branchable = PQueue Pruned c a -> PQueue t c a
coerce

-- | Prune away all stored values more expensive than the given cost.
pruneAbove :: (Semigroup c, Num c, Ord c) => c -> PQueue t c a -> PQueue t c a
pruneAbove :: c -> PQueue t c a -> PQueue t c a
pruneAbove c
k PQueue t c a
_
   | c
k c -> c -> Bool
forall a. Ord a => a -> a -> Bool
< c
0 = String -> PQueue t c a
forall t c a. String -> PQueue t c a
Empty String
"pruned"
pruneAbove c
k (Costly c
c PQueue t c a
q)
   | c
k' c -> c -> Bool
forall a. Ord a => a -> a -> Bool
< c
0 = String -> PQueue t c a
forall t c a. String -> PQueue t c a
Empty String
"pruned"
   | Bool
otherwise = c -> PQueue t c a -> PQueue t c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c (c -> PQueue t c a -> PQueue t c a
forall c t a.
(Semigroup c, Num c, Ord c) =>
c -> PQueue t c a -> PQueue t c a
pruneAbove c
k' PQueue t c a
q)
   where k' :: c
k' = c
k c -> c -> c
forall a. Num a => a -> a -> a
- c
c
pruneAbove c
k (Free Ground a
a PQueue t c a
q) = Ground a -> PQueue t c a -> PQueue t c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free Ground a
a (c -> PQueue t c a -> PQueue t c a
forall c t a.
(Semigroup c, Num c, Ord c) =>
c -> PQueue t c a -> PQueue t c a
pruneAbove c
k PQueue t c a
q)
pruneAbove c
_ q :: PQueue t c a
q@Empty{} = PQueue t c a
q
{-# INLINABLE pruneAbove #-}

-- | Prune away all stored values more expensive than the given cost and a less expensive alternative value.
pruneAlternativesAbove :: (Semigroup c, Num c, Ord c) => c -> PQueue t c a -> PQueue t c a
pruneAlternativesAbove :: c -> PQueue t c a -> PQueue t c a
pruneAlternativesAbove c
k PQueue t c a
q
   | c
k c -> c -> Bool
forall a. Ord a => a -> a -> Bool
<= c
0 = PQueue t c a
q
pruneAlternativesAbove c
k (Costly c
c PQueue t c a
q) = c -> PQueue t c a -> PQueue t c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c (c -> PQueue t c a -> PQueue t c a
forall c t a.
(Semigroup c, Num c, Ord c) =>
c -> PQueue t c a -> PQueue t c a
pruneAlternativesAbove (c
k c -> c -> c
forall a. Num a => a -> a -> a
- c
c) PQueue t c a
q)
pruneAlternativesAbove c
k (Free Ground a
a PQueue t c a
q) = Ground a -> PQueue t c a -> PQueue t c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free Ground a
a (c -> PQueue t c a -> PQueue t c a
forall c t a.
(Semigroup c, Num c, Ord c) =>
c -> PQueue t c a -> PQueue t c a
pruneAbove c
k PQueue t c a
q)
pruneAlternativesAbove c
_ q :: PQueue t c a
q@Empty{} = PQueue t c a
q
{-# INLINABLE pruneAlternativesAbove #-}

-- | Prune away all stored values except the one with the least penalty, making the queue 'Pruned'.
prune :: PQueue t c a -> PQueue Pruned c a
prune :: PQueue t c a -> PQueue Pruned c a
prune (Costly c
c PQueue t c a
q) = c -> PQueue Pruned c a -> PQueue Pruned c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c (PQueue t c a -> PQueue Pruned c a
forall t c a. PQueue t c a -> PQueue Pruned c a
prune PQueue t c a
q)
prune (Free Ground a
a PQueue t c a
q) = Ground a -> PQueue Pruned c a -> PQueue Pruned c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free (a -> Ground a
forall a. a -> Ground a
Leaf (a -> Ground a) -> a -> Ground a
forall a b. (a -> b) -> a -> b
$ Ground a -> a
forall a. Ground a -> a
leftmost Ground a
a) (String -> PQueue Pruned c a
forall t c a. String -> PQueue t c a
Empty String
"")
   where leftmost :: Ground a -> a
         leftmost :: Ground a -> a
leftmost (Leaf a
a) = a
a
         leftmost (Peer Ground a
l Ground a
r) = Ground a -> a
forall a. Ground a -> a
leftmost Ground a
l
prune (Empty String
msg) = String -> PQueue Pruned c a
forall t c a. String -> PQueue t c a
Empty String
msg

-- | Minimize the queue structure. This operation forces the entire spine of the queue and its every level.
canonical :: Semigroup c => PQueue t c a -> PQueue t c a
canonical :: PQueue t c a -> PQueue t c a
canonical (Costly c
c1 (Costly c
c2 PQueue t c a
q)) = PQueue t c a -> PQueue t c a
forall c t a. Semigroup c => PQueue t c a -> PQueue t c a
canonical (c -> PQueue t c a -> PQueue t c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly (c
c1 c -> c -> c
forall a. Semigroup a => a -> a -> a
<> c
c2) PQueue t c a
q)
canonical (Costly c
c PQueue t c a
q) = c -> PQueue t c a -> PQueue t c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c (PQueue t c a -> PQueue t c a
forall c t a. Semigroup c => PQueue t c a -> PQueue t c a
canonical PQueue t c a
q)
canonical (Free Ground a
a PQueue t c a
q) = Ground a -> PQueue t c a -> PQueue t c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free Ground a
a (PQueue t c a -> PQueue t c a
forall c t a. Semigroup c => PQueue t c a -> PQueue t c a
canonical PQueue t c a
q)
canonical q :: PQueue t c a
q@Empty{} = PQueue t c a
q

-- | Filter away from the queue the values that the argument function maps to `False`
filter :: (a -> Bool) -> PQueue t c a -> PQueue t c a
filter :: (a -> Bool) -> PQueue t c a -> PQueue t c a
filter a -> Bool
f (Costly c
c PQueue t c a
q) = c -> PQueue t c a -> PQueue t c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c ((a -> Bool) -> PQueue t c a -> PQueue t c a
forall a t c. (a -> Bool) -> PQueue t c a -> PQueue t c a
filter a -> Bool
f PQueue t c a
q)
filter a -> Bool
f (Free Ground a
g PQueue t c a
q) = (PQueue t c a -> PQueue t c a)
-> (Ground a -> PQueue t c a -> PQueue t c a)
-> Maybe (Ground a)
-> PQueue t c a
-> PQueue t c a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PQueue t c a -> PQueue t c a
forall a. a -> a
id Ground a -> PQueue t c a -> PQueue t c a
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free (Ground a -> Maybe (Ground a)
filterGround Ground a
g) ((a -> Bool) -> PQueue t c a -> PQueue t c a
forall a t c. (a -> Bool) -> PQueue t c a -> PQueue t c a
filter a -> Bool
f PQueue t c a
q)
   where filterGround :: Ground a -> Maybe (Ground a)
filterGround g :: Ground a
g@(Leaf a
a) = if a -> Bool
f a
a then Ground a -> Maybe (Ground a)
forall a. a -> Maybe a
Just Ground a
g else Maybe (Ground a)
forall a. Maybe a
Nothing
         filterGround (Peer Ground a
g1 Ground a
g2) = case (Ground a -> Maybe (Ground a)
filterGround Ground a
g1, Ground a -> Maybe (Ground a)
filterGround Ground a
g2)
                                     of (Just Ground a
g1', Just Ground a
g2') -> Ground a -> Maybe (Ground a)
forall a. a -> Maybe a
Just (Ground a -> Ground a -> Ground a
forall a. Ground a -> Ground a -> Ground a
Peer Ground a
g1' Ground a
g2')
                                        (Just Ground a
g', Maybe (Ground a)
Nothing) -> Ground a -> Maybe (Ground a)
forall a. a -> Maybe a
Just Ground a
g'
                                        (Maybe (Ground a)
Nothing, Just Ground a
g') -> Ground a -> Maybe (Ground a)
forall a. a -> Maybe a
Just Ground a
g'
                                        (Maybe (Ground a)
Nothing, Maybe (Ground a)
Nothing) -> Maybe (Ground a)
forall a. Maybe a
Nothing
filter a -> Bool
_ q :: PQueue t c a
q@Empty{} = PQueue t c a
q

-- | Map and filter away from the queue the values that the argument function maps to `Nothing'
mapMaybe :: (a -> Maybe b) -> PQueue t c a -> PQueue t c b
mapMaybe :: (a -> Maybe b) -> PQueue t c a -> PQueue t c b
mapMaybe a -> Maybe b
f (Costly c
c PQueue t c a
q) = c -> PQueue t c b -> PQueue t c b
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c ((a -> Maybe b) -> PQueue t c a -> PQueue t c b
forall a b t c. (a -> Maybe b) -> PQueue t c a -> PQueue t c b
mapMaybe a -> Maybe b
f PQueue t c a
q)
mapMaybe a -> Maybe b
f (Free Ground a
g PQueue t c a
q) = (PQueue t c b -> PQueue t c b)
-> (Ground b -> PQueue t c b -> PQueue t c b)
-> Maybe (Ground b)
-> PQueue t c b
-> PQueue t c b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PQueue t c b -> PQueue t c b
forall a. a -> a
id Ground b -> PQueue t c b -> PQueue t c b
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free (Ground a -> Maybe (Ground b)
filterGround Ground a
g) ((a -> Maybe b) -> PQueue t c a -> PQueue t c b
forall a b t c. (a -> Maybe b) -> PQueue t c a -> PQueue t c b
mapMaybe a -> Maybe b
f PQueue t c a
q)
   where filterGround :: Ground a -> Maybe (Ground b)
filterGround g :: Ground a
g@(Leaf a
a) = b -> Ground b
forall a. a -> Ground a
Leaf (b -> Ground b) -> Maybe b -> Maybe (Ground b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe b
f a
a
         filterGround (Peer Ground a
g1 Ground a
g2) = case (Ground a -> Maybe (Ground b)
filterGround Ground a
g1, Ground a -> Maybe (Ground b)
filterGround Ground a
g2)
                                     of (Just Ground b
g1', Just Ground b
g2') -> Ground b -> Maybe (Ground b)
forall a. a -> Maybe a
Just (Ground b -> Ground b -> Ground b
forall a. Ground a -> Ground a -> Ground a
Peer Ground b
g1' Ground b
g2')
                                        (Just Ground b
g', Maybe (Ground b)
Nothing) -> Ground b -> Maybe (Ground b)
forall a. a -> Maybe a
Just Ground b
g'
                                        (Maybe (Ground b)
Nothing, Just Ground b
g') -> Ground b -> Maybe (Ground b)
forall a. a -> Maybe a
Just Ground b
g'
                                        (Maybe (Ground b)
Nothing, Maybe (Ground b)
Nothing) -> Maybe (Ground b)
forall a. Maybe a
Nothing
mapMaybe a -> Maybe b
_ (Empty String
msg) = String -> PQueue t c b
forall t c a. String -> PQueue t c a
Empty String
msg

-- | Assuming the stored values belong to a cancellative monoid, prune away all extraneous values and factors using the
-- supplied function that calculates the sum and difference of the two values, if there is any difference, and the monoid null.
-- > fold (pruneSubsets plusDiff mempty pq) == fold pq
-- >   where plusDiff u a
-- >           | gcd u a == u = Nothing
-- >           | d <- a - gcd u a = Just (u <> d, d)
pruneSubsets :: (a -> b -> Maybe (a, b)) -> a -> PQueue t c b -> PQueue t c b
pruneSubsets :: (a -> b -> Maybe (a, b)) -> a -> PQueue t c b -> PQueue t c b
pruneSubsets a -> b -> Maybe (a, b)
unionDiff a
set (Costly c
c PQueue t c b
q) = c -> PQueue t c b -> PQueue t c b
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c ((a -> b -> Maybe (a, b)) -> a -> PQueue t c b -> PQueue t c b
forall a b t c.
(a -> b -> Maybe (a, b)) -> a -> PQueue t c b -> PQueue t c b
pruneSubsets a -> b -> Maybe (a, b)
unionDiff a
set PQueue t c b
q)
pruneSubsets a -> b -> Maybe (a, b)
unionDiff a
set (Free Ground b
g PQueue t c b
q) =
   case (a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
forall a b.
(a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
pruneGroundSubsets a -> b -> Maybe (a, b)
unionDiff a
set Ground b
g
   of Maybe (a, Ground b)
Nothing -> (a -> b -> Maybe (a, b)) -> a -> PQueue t c b -> PQueue t c b
forall a b t c.
(a -> b -> Maybe (a, b)) -> a -> PQueue t c b -> PQueue t c b
pruneSubsets a -> b -> Maybe (a, b)
unionDiff a
set PQueue t c b
q
      Just (a
set', Ground b
g') -> Ground b -> PQueue t c b -> PQueue t c b
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free Ground b
g' ((a -> b -> Maybe (a, b)) -> a -> PQueue t c b -> PQueue t c b
forall a b t c.
(a -> b -> Maybe (a, b)) -> a -> PQueue t c b -> PQueue t c b
pruneSubsets a -> b -> Maybe (a, b)
unionDiff a
set' PQueue t c b
q)
pruneSubsets a -> b -> Maybe (a, b)
_ a
_ q :: PQueue t c b
q@Empty{} = PQueue t c b
q

pruneGroundSubsets :: (a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
pruneGroundSubsets :: (a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
pruneGroundSubsets a -> b -> Maybe (a, b)
unionDiff a
set (Leaf b
l) = case a -> b -> Maybe (a, b)
unionDiff a
set b
l
                                            of Maybe (a, b)
Nothing -> Maybe (a, Ground b)
forall a. Maybe a
Nothing
                                               Just (a
set', b
l') -> (a, Ground b) -> Maybe (a, Ground b)
forall a. a -> Maybe a
Just (a
set', b -> Ground b
forall a. a -> Ground a
Leaf b
l')
pruneGroundSubsets a -> b -> Maybe (a, b)
unionDiff a
set (Peer Ground b
g1 Ground b
g2) =
   case (a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
forall a b.
(a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
pruneGroundSubsets a -> b -> Maybe (a, b)
unionDiff a
set Ground b
g1
   of Maybe (a, Ground b)
Nothing -> (a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
forall a b.
(a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
pruneGroundSubsets a -> b -> Maybe (a, b)
unionDiff a
set Ground b
g2
      Just (a
set', Ground b
g1') -> case (a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
forall a b.
(a -> b -> Maybe (a, b)) -> a -> Ground b -> Maybe (a, Ground b)
pruneGroundSubsets a -> b -> Maybe (a, b)
unionDiff a
set' Ground b
g2
                          of Maybe (a, Ground b)
Nothing -> (a, Ground b) -> Maybe (a, Ground b)
forall a. a -> Maybe a
Just (a
set', Ground b
g1')
                             Just (a
set'', Ground b
g2') -> (a, Ground b) -> Maybe (a, Ground b)
forall a. a -> Maybe a
Just (a
set'', Ground b -> Ground b -> Ground b
forall a. Ground a -> Ground a -> Ground a
Peer Ground b
g1' Ground b
g2')

-- | Returns the pair of the GCD of all the penalties and the penalties without the GCD
-- > gcd <*> rest == f
-- >   where (gcd, rest) = stripCommon f
stripCommon :: (Ord c, Num c, Functor f, Foldable f, Alternative (PQueue t c)) =>
               f (PQueue t c a) -> (PQueue Pruned c (a -> a), f (PQueue t c a))
stripCommon :: f (PQueue t c a) -> (PQueue Pruned c (a -> a), f (PQueue t c a))
stripCommon f (PQueue t c a)
f = (PQueue Pruned c (a -> a)
common, PQueue Pruned c (a -> a) -> PQueue t c a -> PQueue t c a
forall c a t b.
(Ord c, Num c) =>
PQueue Pruned c a -> PQueue t c b -> PQueue t c b
strip PQueue Pruned c (a -> a)
common (PQueue t c a -> PQueue t c a)
-> f (PQueue t c a) -> f (PQueue t c a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (PQueue t c a)
f)
   where common :: PQueue Pruned c (a -> a)
common = (a -> a) -> a -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id (a -> a -> a) -> PQueue Pruned c a -> PQueue Pruned c (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PQueue t c a -> PQueue Pruned c a
forall t c a. PQueue t c a -> PQueue Pruned c a
prune (Alt (PQueue t c) a -> PQueue t c a
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt (PQueue t c) a -> PQueue t c a)
-> Alt (PQueue t c) a -> PQueue t c a
forall a b. (a -> b) -> a -> b
$ (PQueue t c a -> Alt (PQueue t c) a)
-> f (PQueue t c a) -> Alt (PQueue t c) a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PQueue t c a -> Alt (PQueue t c) a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt f (PQueue t c a)
f)

-- | Subtract the first argument cost GCD from the cost of every value in the second argument
strip :: (Ord c, Num c) => PQueue Pruned c a -> PQueue t c b -> PQueue t c b
strip :: PQueue Pruned c a -> PQueue t c b -> PQueue t c b
strip (Costly c
c PQueue Pruned c a
q1) PQueue t c b
q2 = c -> PQueue t c b -> PQueue t c b
forall c t a. (Ord c, Num c) => c -> PQueue t c a -> PQueue t c a
stripCost c
c (PQueue Pruned c a -> PQueue t c b -> PQueue t c b
forall c a t b.
(Ord c, Num c) =>
PQueue Pruned c a -> PQueue t c b -> PQueue t c b
strip PQueue Pruned c a
q1 PQueue t c b
q2)
strip PQueue Pruned c a
_ PQueue t c b
q = PQueue t c b
q

-- | Subtract the given cost from the cost of every value in the queue
stripCost :: (Ord c, Num c) => c -> PQueue t c a -> PQueue t c a
stripCost :: c -> PQueue t c a -> PQueue t c a
stripCost c
c (Costly c
c' PQueue t c a
q)
   | c
c c -> c -> Bool
forall a. Ord a => a -> a -> Bool
< c
c' = c -> PQueue t c a -> PQueue t c a
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly (c
c' c -> c -> c
forall a. Num a => a -> a -> a
- c
c) PQueue t c a
q
   | c
c c -> c -> Bool
forall a. Ord a => a -> a -> Bool
> c
c' = c -> PQueue t c a -> PQueue t c a
forall c t a. (Ord c, Num c) => c -> PQueue t c a -> PQueue t c a
stripCost (c
c c -> c -> c
forall a. Num a => a -> a -> a
- c
c') PQueue t c a
q
   | Bool
otherwise = PQueue t c a
q
stripCost c
_ q :: PQueue t c a
q@Empty{} = PQueue t c a
q
-- stripCost c q = error ("stripCost " <> show c <> " " <> show (() <$ q))

-- | Returns 'Just' the minimal cost present in the queue, 'Nothing' if the queue is empty.
leastCost :: Monoid c => PQueue t c a -> Maybe c
leastCost :: PQueue t c a -> Maybe c
leastCost (Costly c
c PQueue t c a
q) = (c
c c -> c -> c
forall a. Semigroup a => a -> a -> a
<>) (c -> c) -> Maybe c -> Maybe c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PQueue t c a -> Maybe c
forall c t a. Monoid c => PQueue t c a -> Maybe c
leastCost PQueue t c a
q
leastCost Free{} = c -> Maybe c
forall a. a -> Maybe a
Just c
forall a. Monoid a => a
mempty
leastCost Empty{} = Maybe c
forall a. Maybe a
Nothing

-- | Maps each item contained in the queue, supplying the item's cost as first argument
mapWithCost :: Monoid c => (c -> a -> b) -> PQueue t c a -> PQueue t c b
mapWithCost :: (c -> a -> b) -> PQueue t c a -> PQueue t c b
mapWithCost c -> a -> b
f (Costly c
c PQueue t c a
q) = c -> PQueue t c b -> PQueue t c b
forall t c a. c -> PQueue t c a -> PQueue t c a
Costly c
c ((c -> a -> b) -> PQueue t c a -> PQueue t c b
forall c a b t.
Monoid c =>
(c -> a -> b) -> PQueue t c a -> PQueue t c b
mapWithCost (c -> a -> b
f (c -> a -> b) -> (c -> c) -> c -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
c c -> c -> c
forall a. Semigroup a => a -> a -> a
<>)) PQueue t c a
q)
mapWithCost c -> a -> b
f (Free Ground a
a PQueue t c a
q) = Ground b -> PQueue t c b -> PQueue t c b
forall t c a. Ground a -> PQueue t c a -> PQueue t c a
Free (c -> a -> b
f c
forall a. Monoid a => a
mempty (a -> b) -> Ground a -> Ground b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ground a
a) ((c -> a -> b) -> PQueue t c a -> PQueue t c b
forall c a b t.
Monoid c =>
(c -> a -> b) -> PQueue t c a -> PQueue t c b
mapWithCost c -> a -> b
f PQueue t c a
q)
mapWithCost c -> a -> b
_ (Empty String
msg) = String -> PQueue t c b
forall t c a. String -> PQueue t c a
Empty String
msg