{-# LANGUAGE UndecidableInstances #-}

--------------------------------------------------------------------------------
-- |
-- Module      : Control.Monad.Heap
-- Copyright   : (c) Donnacha Oisín Kidney 2021
-- Maintainer  : mail@doisinkidney.com
-- Stability   : experimental
-- Portability : non-portable
--
-- The Heap monad: a monad for efficient weighted search.
--
-- This module provides an implementation of the Heap monad transformer as
-- described in:
--
-- * Donnacha Oisín Kidney and Nicolas Wu. 2021. /Algebras for weighted search/.
--   Proc. ACM Program. Lang. 5, ICFP, Article 72 (August 2021), 30 pages.
--   DOI:<https://doi.org/10.1145/3473577>
--
-- This monad transformer can be used to implement search algorithms like
-- Dijkstra's algorithm (see "MonusWeightedSearch.Examples.Dijkstra"), or the
-- Viterbi algorithm ("MonusWeightedSearch.Examples.Viterbi"), or probabilistic
-- parsing ("MonusWeightedSearch.Examples.Parsing").
--
-- The type supports nondeterminism (using the 'Alternative' and 'MonadPlus'
-- interfaces), where each branch in a computation can be weighted by some
-- 'Monus'. A 'Monus' is an ordered 'Monoid' with some pseudo-subtraction
-- operator, see the "Data.Monus" module for more details.
--------------------------------------------------------------------------------


module Control.Monad.Heap
  ( -- * Heap Type
    HeapT(..)
  , Node(..)
    -- ** Non-transformer form
  , Heap
  , pattern Heap
  , runHeap

    -- * Constructing Heaps
  , fromList

    -- * Popping the smallest elements
  , popMin
  , popMinT
  
    -- * Popping the smallest element
  , popMinOne
  , popMinOneT

    -- * Turning into a cons-list
  , flatten
  , flattenT

    -- * Searching the whole heap
  , search
  , searchT

    -- * Returning one element
  , best
  , bestT
  )
  where

import Data.Bifunctor ( Bifunctor(..) )
import Data.Bifoldable ( Bifoldable(..), bifoldl', bifoldr' )
import Data.Bitraversable ( Bitraversable(..) )
import Control.Monad.Heap.List
    ( toListT, ListCons(..), ListT(..) )
import Control.Monad ( MonadPlus , (<=<))
import Control.Applicative
    ( Applicative(liftA2), Alternative(empty, (<|>)) )
import Control.Monad.Trans ( MonadTrans(..) )
import Data.Monus ( Monus(..) )
import Control.Monad.Writer ( MonadWriter(..), WriterT(..) )
import Control.Monad.State ( MonadState(..) )
import Control.Monad.Except ( MonadError(..) )
import Control.Monad.Reader ( MonadReader(..) )
import Control.Monad.Cont ( MonadCont(..) )
import Data.Functor.Identity ( Identity(..) )
import Test.QuickCheck
    ( arbitrary1,
      frequency,
      sized,
      Arbitrary(arbitrary),
      Arbitrary1(liftArbitrary) )
import MonusWeightedSearch.Internal.CoerceOperators
    ( (<#$>), (.#), (#.), under )
import MonusWeightedSearch.Internal.TestHelpers ( sumsTo )
import Data.Data ( Data, Typeable )
import GHC.Generics ( Generic, Generic1 )
import Control.DeepSeq ( NFData(..) )
import Data.Foldable (Foldable(foldl', foldr'))
import Text.Read (readPrec, parens, prec, Lexeme(Ident), lexP, step)
import Data.Monoid (Alt(Alt))
import Control.Monad.Free.Class
import GHC.Exts (IsList)
import qualified GHC.Exts as IsList

-- $setup
-- >>> import Data.Monus.Dist
-- >>> default (Dist,Integer,Double)

infixr 5 :<
-- | A 'Heap' is a list of 'Node's of 'Heap's.
data Node w a b = Leaf a | !w :< b
  deriving (Int -> Node w a b -> ShowS
[Node w a b] -> ShowS
Node w a b -> String
(Int -> Node w a b -> ShowS)
-> (Node w a b -> String)
-> ([Node w a b] -> ShowS)
-> Show (Node w a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w a b.
(Show a, Show w, Show b) =>
Int -> Node w a b -> ShowS
forall w a b. (Show a, Show w, Show b) => [Node w a b] -> ShowS
forall w a b. (Show a, Show w, Show b) => Node w a b -> String
showList :: [Node w a b] -> ShowS
$cshowList :: forall w a b. (Show a, Show w, Show b) => [Node w a b] -> ShowS
show :: Node w a b -> String
$cshow :: forall w a b. (Show a, Show w, Show b) => Node w a b -> String
showsPrec :: Int -> Node w a b -> ShowS
$cshowsPrec :: forall w a b.
(Show a, Show w, Show b) =>
Int -> Node w a b -> ShowS
Show, ReadPrec [Node w a b]
ReadPrec (Node w a b)
Int -> ReadS (Node w a b)
ReadS [Node w a b]
(Int -> ReadS (Node w a b))
-> ReadS [Node w a b]
-> ReadPrec (Node w a b)
-> ReadPrec [Node w a b]
-> Read (Node w a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall w a b. (Read a, Read w, Read b) => ReadPrec [Node w a b]
forall w a b. (Read a, Read w, Read b) => ReadPrec (Node w a b)
forall w a b. (Read a, Read w, Read b) => Int -> ReadS (Node w a b)
forall w a b. (Read a, Read w, Read b) => ReadS [Node w a b]
readListPrec :: ReadPrec [Node w a b]
$creadListPrec :: forall w a b. (Read a, Read w, Read b) => ReadPrec [Node w a b]
readPrec :: ReadPrec (Node w a b)
$creadPrec :: forall w a b. (Read a, Read w, Read b) => ReadPrec (Node w a b)
readList :: ReadS [Node w a b]
$creadList :: forall w a b. (Read a, Read w, Read b) => ReadS [Node w a b]
readsPrec :: Int -> ReadS (Node w a b)
$creadsPrec :: forall w a b. (Read a, Read w, Read b) => Int -> ReadS (Node w a b)
Read, Node w a b -> Node w a b -> Bool
(Node w a b -> Node w a b -> Bool)
-> (Node w a b -> Node w a b -> Bool) -> Eq (Node w a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w a b.
(Eq a, Eq w, Eq b) =>
Node w a b -> Node w a b -> Bool
/= :: Node w a b -> Node w a b -> Bool
$c/= :: forall w a b.
(Eq a, Eq w, Eq b) =>
Node w a b -> Node w a b -> Bool
== :: Node w a b -> Node w a b -> Bool
$c== :: forall w a b.
(Eq a, Eq w, Eq b) =>
Node w a b -> Node w a b -> Bool
Eq, Eq (Node w a b)
Eq (Node w a b)
-> (Node w a b -> Node w a b -> Ordering)
-> (Node w a b -> Node w a b -> Bool)
-> (Node w a b -> Node w a b -> Bool)
-> (Node w a b -> Node w a b -> Bool)
-> (Node w a b -> Node w a b -> Bool)
-> (Node w a b -> Node w a b -> Node w a b)
-> (Node w a b -> Node w a b -> Node w a b)
-> Ord (Node w a b)
Node w a b -> Node w a b -> Bool
Node w a b -> Node w a b -> Ordering
Node w a b -> Node w a b -> Node w a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {w} {a} {b}. (Ord a, Ord w, Ord b) => Eq (Node w a b)
forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Bool
forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Ordering
forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Node w a b
min :: Node w a b -> Node w a b -> Node w a b
$cmin :: forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Node w a b
max :: Node w a b -> Node w a b -> Node w a b
$cmax :: forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Node w a b
>= :: Node w a b -> Node w a b -> Bool
$c>= :: forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Bool
> :: Node w a b -> Node w a b -> Bool
$c> :: forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Bool
<= :: Node w a b -> Node w a b -> Bool
$c<= :: forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Bool
< :: Node w a b -> Node w a b -> Bool
$c< :: forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Bool
compare :: Node w a b -> Node w a b -> Ordering
$ccompare :: forall w a b.
(Ord a, Ord w, Ord b) =>
Node w a b -> Node w a b -> Ordering
Ord, (forall a b. (a -> b) -> Node w a a -> Node w a b)
-> (forall a b. a -> Node w a b -> Node w a a)
-> Functor (Node w a)
forall a b. a -> Node w a b -> Node w a a
forall a b. (a -> b) -> Node w a a -> Node w a b
forall w a a b. a -> Node w a b -> Node w a a
forall w a a b. (a -> b) -> Node w a a -> Node w a b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Node w a b -> Node w a a
$c<$ :: forall w a a b. a -> Node w a b -> Node w a a
fmap :: forall a b. (a -> b) -> Node w a a -> Node w a b
$cfmap :: forall w a a b. (a -> b) -> Node w a a -> Node w a b
Functor, (forall m. Monoid m => Node w a m -> m)
-> (forall m a. Monoid m => (a -> m) -> Node w a a -> m)
-> (forall m a. Monoid m => (a -> m) -> Node w a a -> m)
-> (forall a b. (a -> b -> b) -> b -> Node w a a -> b)
-> (forall a b. (a -> b -> b) -> b -> Node w a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node w a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node w a a -> b)
-> (forall a. (a -> a -> a) -> Node w a a -> a)
-> (forall a. (a -> a -> a) -> Node w a a -> a)
-> (forall a. Node w a a -> [a])
-> (forall a. Node w a a -> Bool)
-> (forall a. Node w a a -> Int)
-> (forall a. Eq a => a -> Node w a a -> Bool)
-> (forall a. Ord a => Node w a a -> a)
-> (forall a. Ord a => Node w a a -> a)
-> (forall a. Num a => Node w a a -> a)
-> (forall a. Num a => Node w a a -> a)
-> Foldable (Node w a)
forall a. Eq a => a -> Node w a a -> Bool
forall a. Num a => Node w a a -> a
forall a. Ord a => Node w a a -> a
forall m. Monoid m => Node w a m -> m
forall a. Node w a a -> Bool
forall a. Node w a a -> Int
forall a. Node w a a -> [a]
forall a. (a -> a -> a) -> Node w a a -> a
forall m a. Monoid m => (a -> m) -> Node w a a -> m
forall b a. (b -> a -> b) -> b -> Node w a a -> b
forall a b. (a -> b -> b) -> b -> Node w a a -> b
forall w a a. Eq a => a -> Node w a a -> Bool
forall w a a. Num a => Node w a a -> a
forall w a a. Ord a => Node w a a -> a
forall w a m. Monoid m => Node w a m -> m
forall w a a. Node w a a -> Bool
forall w a a. Node w a a -> Int
forall w a a. Node w a a -> [a]
forall w a a. (a -> a -> a) -> Node w a a -> a
forall w a m a. Monoid m => (a -> m) -> Node w a a -> m
forall w a b a. (b -> a -> b) -> b -> Node w a a -> b
forall w a a b. (a -> b -> b) -> b -> Node w a a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Node w a a -> a
$cproduct :: forall w a a. Num a => Node w a a -> a
sum :: forall a. Num a => Node w a a -> a
$csum :: forall w a a. Num a => Node w a a -> a
minimum :: forall a. Ord a => Node w a a -> a
$cminimum :: forall w a a. Ord a => Node w a a -> a
maximum :: forall a. Ord a => Node w a a -> a
$cmaximum :: forall w a a. Ord a => Node w a a -> a
elem :: forall a. Eq a => a -> Node w a a -> Bool
$celem :: forall w a a. Eq a => a -> Node w a a -> Bool
length :: forall a. Node w a a -> Int
$clength :: forall w a a. Node w a a -> Int
null :: forall a. Node w a a -> Bool
$cnull :: forall w a a. Node w a a -> Bool
toList :: forall a. Node w a a -> [a]
$ctoList :: forall w a a. Node w a a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Node w a a -> a
$cfoldl1 :: forall w a a. (a -> a -> a) -> Node w a a -> a
foldr1 :: forall a. (a -> a -> a) -> Node w a a -> a
$cfoldr1 :: forall w a a. (a -> a -> a) -> Node w a a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Node w a a -> b
$cfoldl' :: forall w a b a. (b -> a -> b) -> b -> Node w a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Node w a a -> b
$cfoldl :: forall w a b a. (b -> a -> b) -> b -> Node w a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Node w a a -> b
$cfoldr' :: forall w a a b. (a -> b -> b) -> b -> Node w a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Node w a a -> b
$cfoldr :: forall w a a b. (a -> b -> b) -> b -> Node w a a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Node w a a -> m
$cfoldMap' :: forall w a m a. Monoid m => (a -> m) -> Node w a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Node w a a -> m
$cfoldMap :: forall w a m a. Monoid m => (a -> m) -> Node w a a -> m
fold :: forall m. Monoid m => Node w a m -> m
$cfold :: forall w a m. Monoid m => Node w a m -> m
Foldable, Functor (Node w a)
Foldable (Node w a)
Functor (Node w a)
-> Foldable (Node w a)
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Node w a a -> f (Node w a b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    Node w a (f a) -> f (Node w a a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> Node w a a -> m (Node w a b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    Node w a (m a) -> m (Node w a a))
-> Traversable (Node w a)
forall w a. Functor (Node w a)
forall w a. Foldable (Node w a)
forall w a (m :: Type -> Type) a.
Monad m =>
Node w a (m a) -> m (Node w a a)
forall w a (f :: Type -> Type) a.
Applicative f =>
Node w a (f a) -> f (Node w a a)
forall w a (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Node w a a -> m (Node w a b)
forall w a (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Node w a a -> f (Node w a b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a.
Monad m =>
Node w a (m a) -> m (Node w a a)
forall (f :: Type -> Type) a.
Applicative f =>
Node w a (f a) -> f (Node w a a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Node w a a -> m (Node w a b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Node w a a -> f (Node w a b)
sequence :: forall (m :: Type -> Type) a.
Monad m =>
Node w a (m a) -> m (Node w a a)
$csequence :: forall w a (m :: Type -> Type) a.
Monad m =>
Node w a (m a) -> m (Node w a a)
mapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Node w a a -> m (Node w a b)
$cmapM :: forall w a (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Node w a a -> m (Node w a b)
sequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
Node w a (f a) -> f (Node w a a)
$csequenceA :: forall w a (f :: Type -> Type) a.
Applicative f =>
Node w a (f a) -> f (Node w a a)
traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Node w a a -> f (Node w a b)
$ctraverse :: forall w a (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Node w a a -> f (Node w a b)
Traversable, Typeable (Node w a b)
Typeable (Node w a b)
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Node w a b -> c (Node w a b))
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Node w a b))
-> (Node w a b -> Constr)
-> (Node w a b -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Node w a b)))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Node w a b)))
-> ((forall b. Data b => b -> b) -> Node w a b -> Node w a b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Node w a b -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Node w a b -> r)
-> (forall u. (forall d. Data d => d -> u) -> Node w a b -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Node w a b -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b))
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b))
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b))
-> Data (Node w a b)
Node w a b -> DataType
Node w a b -> Constr
(forall b. Data b => b -> b) -> Node w a b -> Node w a b
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Node w a b -> u
forall u. (forall d. Data d => d -> u) -> Node w a b -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Node w a b -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Node w a b -> r
forall {w} {a} {b}.
(Data w, Data a, Data b) =>
Typeable (Node w a b)
forall w a b. (Data w, Data a, Data b) => Node w a b -> DataType
forall w a b. (Data w, Data a, Data b) => Node w a b -> Constr
forall w a b.
(Data w, Data a, Data b) =>
(forall b. Data b => b -> b) -> Node w a b -> Node w a b
forall w a b u.
(Data w, Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Node w a b -> u
forall w a b u.
(Data w, Data a, Data b) =>
(forall d. Data d => d -> u) -> Node w a b -> [u]
forall w a b r r'.
(Data w, Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Node w a b -> r
forall w a b r r'.
(Data w, Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Node w a b -> r
forall w a b (m :: Type -> Type).
(Data w, Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
forall w a b (m :: Type -> Type).
(Data w, Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
forall w a b (c :: Type -> Type).
(Data w, Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Node w a b)
forall w a b (c :: Type -> Type).
(Data w, Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node w a b -> c (Node w a b)
forall w a b (t :: Type -> Type) (c :: Type -> Type).
(Data w, Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Node w a b))
forall w a b (t :: Type -> Type -> Type) (c :: Type -> Type).
(Data w, Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Node w a b))
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Node w a b)
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node w a b -> c (Node w a b)
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Node w a b))
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Node w a b))
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
$cgmapMo :: forall w a b (m :: Type -> Type).
(Data w, Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
$cgmapMp :: forall w a b (m :: Type -> Type).
(Data w, Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
$cgmapM :: forall w a b (m :: Type -> Type).
(Data w, Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Node w a b -> m (Node w a b)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node w a b -> u
$cgmapQi :: forall w a b u.
(Data w, Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Node w a b -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Node w a b -> [u]
$cgmapQ :: forall w a b u.
(Data w, Data a, Data b) =>
(forall d. Data d => d -> u) -> Node w a b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Node w a b -> r
$cgmapQr :: forall w a b r r'.
(Data w, Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Node w a b -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Node w a b -> r
$cgmapQl :: forall w a b r r'.
(Data w, Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Node w a b -> r
gmapT :: (forall b. Data b => b -> b) -> Node w a b -> Node w a b
$cgmapT :: forall w a b.
(Data w, Data a, Data b) =>
(forall b. Data b => b -> b) -> Node w a b -> Node w a b
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Node w a b))
$cdataCast2 :: forall w a b (t :: Type -> Type -> Type) (c :: Type -> Type).
(Data w, Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Node w a b))
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Node w a b))
$cdataCast1 :: forall w a b (t :: Type -> Type) (c :: Type -> Type).
(Data w, Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Node w a b))
dataTypeOf :: Node w a b -> DataType
$cdataTypeOf :: forall w a b. (Data w, Data a, Data b) => Node w a b -> DataType
toConstr :: Node w a b -> Constr
$ctoConstr :: forall w a b. (Data w, Data a, Data b) => Node w a b -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Node w a b)
$cgunfold :: forall w a b (c :: Type -> Type).
(Data w, Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Node w a b)
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node w a b -> c (Node w a b)
$cgfoldl :: forall w a b (c :: Type -> Type).
(Data w, Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node w a b -> c (Node w a b)
Data, Typeable, (forall x. Node w a b -> Rep (Node w a b) x)
-> (forall x. Rep (Node w a b) x -> Node w a b)
-> Generic (Node w a b)
forall x. Rep (Node w a b) x -> Node w a b
forall x. Node w a b -> Rep (Node w a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w a b x. Rep (Node w a b) x -> Node w a b
forall w a b x. Node w a b -> Rep (Node w a b) x
$cto :: forall w a b x. Rep (Node w a b) x -> Node w a b
$cfrom :: forall w a b x. Node w a b -> Rep (Node w a b) x
Generic, (forall a. Node w a a -> Rep1 (Node w a) a)
-> (forall a. Rep1 (Node w a) a -> Node w a a)
-> Generic1 (Node w a)
forall a. Rep1 (Node w a) a -> Node w a a
forall a. Node w a a -> Rep1 (Node w a) a
forall w a a. Rep1 (Node w a) a -> Node w a a
forall w a a. Node w a a -> Rep1 (Node w a) a
forall k (f :: k -> Type).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall w a a. Rep1 (Node w a) a -> Node w a a
$cfrom1 :: forall w a a. Node w a a -> Rep1 (Node w a) a
Generic1)

instance (NFData w, NFData a, NFData b) => NFData (Node w a b) where
  rnf :: Node w a b -> ()
rnf (Leaf a
x) = a -> ()
forall a. NFData a => a -> ()
rnf a
x
  rnf (w
x :< b
xs) = w -> ()
forall a. NFData a => a -> ()
rnf w
x () -> () -> ()
`seq` b -> ()
forall a. NFData a => a -> ()
rnf b
xs
  {-# INLINE rnf #-}

instance Bifunctor (Node w) where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Node w a c -> Node w b d
bimap a -> b
f c -> d
g (Leaf a
x) = b -> Node w b d
forall w a b. a -> Node w a b
Leaf (a -> b
f a
x)
  bimap a -> b
f c -> d
g (w
x :< c
xs) = w
x w -> d -> Node w b d
forall w a b. w -> b -> Node w a b
:< c -> d
g c
xs

  first :: forall a b c. (a -> b) -> Node w a c -> Node w b c
first a -> b
f (Leaf a
x) = b -> Node w b c
forall w a b. a -> Node w a b
Leaf (a -> b
f a
x)
  first a -> b
f (w
x :< c
xs) = w
x w -> c -> Node w b c
forall w a b. w -> b -> Node w a b
:< c
xs

  second :: forall b c a. (b -> c) -> Node w a b -> Node w a c
second b -> c
f (Leaf a
x) = a -> Node w a c
forall w a b. a -> Node w a b
Leaf a
x
  second b -> c
f (w
x :< b
xs) = w
x w -> c -> Node w a c
forall w a b. w -> b -> Node w a b
:< b -> c
f b
xs

  {-# INLINE bimap #-}
  {-# INLINE first #-}
  {-# INLINE second #-}

instance Bifoldable (Node w) where
  bifold :: forall m. Monoid m => Node w m m -> m
bifold (Leaf m
x) = m
x
  bifold (w
_ :< m
x) = m
x
  {-# INLINE bifold #-}

  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Node w a b -> m
bifoldMap a -> m
f b -> m
_ (Leaf a
x) = a -> m
f a
x
  bifoldMap a -> m
_ b -> m
f (w
_ :< b
x) = b -> m
f b
x
  {-# INLINE bifoldMap #-}

  bifoldr :: forall a c b.
(a -> c -> c) -> (b -> c -> c) -> c -> Node w a b -> c
bifoldr a -> c -> c
f b -> c -> c
_ c
b (Leaf a
x) = a -> c -> c
f a
x c
b
  bifoldr a -> c -> c
_ b -> c -> c
f c
b (w
_ :< b
x) = b -> c -> c
f b
x c
b
  {-# INLINE bifoldr #-}

  bifoldl :: forall c a b.
(c -> a -> c) -> (c -> b -> c) -> c -> Node w a b -> c
bifoldl c -> a -> c
f c -> b -> c
_ c
b (Leaf a
x) = c -> a -> c
f c
b a
x
  bifoldl c -> a -> c
_ c -> b -> c
f c
b (w
_ :< b
x) = c -> b -> c
f c
b b
x
  {-# INLINE bifoldl #-}

instance Bitraversable (Node w) where
  bitraverse :: forall (f :: Type -> Type) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Node w a b -> f (Node w c d)
bitraverse a -> f c
f b -> f d
_ (Leaf a
x) = (c -> Node w c d) -> f c -> f (Node w c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> Node w c d
forall w a b. a -> Node w a b
Leaf (a -> f c
f a
x)
  bitraverse a -> f c
_ b -> f d
f (w
x :< b
xs) = (d -> Node w c d) -> f d -> f (Node w c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (w
x w -> d -> Node w c d
forall w a b. w -> b -> Node w a b
:<) (b -> f d
f b
xs)
  {-# INLINE bitraverse #-}

-- | The 'HeapT' monad transformer: a monad for weighted search.
--
-- This monad supports nondeterminism through the 'Alternative' and
-- 'MonadPlus' classes, but different branches in the computation may be
-- weighted by the @w@ parameter. A computation can be given a specific weight
-- using the 'MonadWriter' interface:
--
-- @
--   'tell' 4 '>>' xs
-- @
--
-- This weights the computation @xs@ with @4@.
--
-- Depending on the 'Monus' used, the order of the search can be specified.
-- For instance, using the 'Monus' in "Data.Monus.Dist", we have the following:
--
-- >>> search (fromList [('a',5), ('b', 3), ('c',6)])
-- [('b',3),('a',5),('c',6)]
--
-- >>> search (fromList [('b',3), ('a',5), ('c',6)])
-- [('b',3),('a',5),('c',6)]
newtype HeapT w m a = HeapT { forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT :: ListT m (Node w a (HeapT w m a)) }
  deriving (Typeable, (forall x. HeapT w m a -> Rep (HeapT w m a) x)
-> (forall x. Rep (HeapT w m a) x -> HeapT w m a)
-> Generic (HeapT w m a)
forall x. Rep (HeapT w m a) x -> HeapT w m a
forall x. HeapT w m a -> Rep (HeapT w m a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w (m :: Type -> Type) a x.
Rep (HeapT w m a) x -> HeapT w m a
forall w (m :: Type -> Type) a x.
HeapT w m a -> Rep (HeapT w m a) x
$cto :: forall w (m :: Type -> Type) a x.
Rep (HeapT w m a) x -> HeapT w m a
$cfrom :: forall w (m :: Type -> Type) a x.
HeapT w m a -> Rep (HeapT w m a) x
Generic)
  deriving (NonEmpty (HeapT w m a) -> HeapT w m a
HeapT w m a -> HeapT w m a -> HeapT w m a
(HeapT w m a -> HeapT w m a -> HeapT w m a)
-> (NonEmpty (HeapT w m a) -> HeapT w m a)
-> (forall b. Integral b => b -> HeapT w m a -> HeapT w m a)
-> Semigroup (HeapT w m a)
forall b. Integral b => b -> HeapT w m a -> HeapT w m a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall w (m :: Type -> Type) a.
Monad m =>
NonEmpty (HeapT w m a) -> HeapT w m a
forall w (m :: Type -> Type) a.
Monad m =>
HeapT w m a -> HeapT w m a -> HeapT w m a
forall w (m :: Type -> Type) a b.
(Monad m, Integral b) =>
b -> HeapT w m a -> HeapT w m a
stimes :: forall b. Integral b => b -> HeapT w m a -> HeapT w m a
$cstimes :: forall w (m :: Type -> Type) a b.
(Monad m, Integral b) =>
b -> HeapT w m a -> HeapT w m a
sconcat :: NonEmpty (HeapT w m a) -> HeapT w m a
$csconcat :: forall w (m :: Type -> Type) a.
Monad m =>
NonEmpty (HeapT w m a) -> HeapT w m a
<> :: HeapT w m a -> HeapT w m a -> HeapT w m a
$c<> :: forall w (m :: Type -> Type) a.
Monad m =>
HeapT w m a -> HeapT w m a -> HeapT w m a
Semigroup, Semigroup (HeapT w m a)
HeapT w m a
Semigroup (HeapT w m a)
-> HeapT w m a
-> (HeapT w m a -> HeapT w m a -> HeapT w m a)
-> ([HeapT w m a] -> HeapT w m a)
-> Monoid (HeapT w m a)
[HeapT w m a] -> HeapT w m a
HeapT w m a -> HeapT w m a -> HeapT w m a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall w (m :: Type -> Type) a. Monad m => Semigroup (HeapT w m a)
forall w (m :: Type -> Type) a. Monad m => HeapT w m a
forall w (m :: Type -> Type) a.
Monad m =>
[HeapT w m a] -> HeapT w m a
forall w (m :: Type -> Type) a.
Monad m =>
HeapT w m a -> HeapT w m a -> HeapT w m a
mconcat :: [HeapT w m a] -> HeapT w m a
$cmconcat :: forall w (m :: Type -> Type) a.
Monad m =>
[HeapT w m a] -> HeapT w m a
mappend :: HeapT w m a -> HeapT w m a -> HeapT w m a
$cmappend :: forall w (m :: Type -> Type) a.
Monad m =>
HeapT w m a -> HeapT w m a -> HeapT w m a
mempty :: HeapT w m a
$cmempty :: forall w (m :: Type -> Type) a. Monad m => HeapT w m a
Monoid) via Alt (HeapT w m) a

deriving instance (forall x. Data x => Data (m x), Typeable m, Data a, Data w) => Data (HeapT w m a)

-- | Build a heap from a list of values paired with their weights.
fromList :: Applicative m => [(a,w)] -> HeapT w m a
fromList :: forall (m :: Type -> Type) a w.
Applicative m =>
[(a, w)] -> HeapT w m a
fromList = ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w a (HeapT w m a)) -> HeapT w m a)
-> ([(a, w)] -> ListT m (Node w a (HeapT w m a)))
-> [(a, w)]
-> HeapT w m a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. ((a, w)
 -> ListT m (Node w a (HeapT w m a))
 -> ListT m (Node w a (HeapT w m a)))
-> ListT m (Node w a (HeapT w m a))
-> [(a, w)]
-> ListT m (Node w a (HeapT w m a))
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, w)
-> ListT m (Node w a (HeapT w m a))
-> ListT m (Node w a (HeapT w m a))
forall {m :: Type -> Type} {m :: Type -> Type} {a} {w} {a} {w}.
(Applicative m, Applicative m) =>
(a, w)
-> ListT m (Node w a (HeapT w m a))
-> ListT m (Node w a (HeapT w m a))
f (m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall a b. ListCons a b
Nil))
  where
    f :: (a, w)
-> ListT m (Node w a (HeapT w m a))
-> ListT m (Node w a (HeapT w m a))
f (a
x,w
w) ListT m (Node w a (HeapT w m a))
xs = m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((w
w w -> HeapT w m a -> Node w a (HeapT w m a)
forall w a b. w -> b -> Node w a b
:< ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a -> Node w a (HeapT w m a)
forall w a b. a -> Node w a b
Leaf a
x Node w a (HeapT w m a)
-> ListT m (Node w a (HeapT w m a))
-> ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall a b. a -> b -> ListCons a b
:- m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall a b. ListCons a b
Nil))))) Node w a (HeapT w m a)
-> ListT m (Node w a (HeapT w m a))
-> ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall a b. a -> b -> ListCons a b
:- ListT m (Node w a (HeapT w m a))
xs))
{-# INLINE fromList #-}

instance Monad m => MonadFree ((,) w) (HeapT w m) where
  wrap :: forall a. (w, HeapT w m a) -> HeapT w m a
wrap (w
w, HeapT w m a
xs) = ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (Node w a (HeapT w m a) -> ListT m (Node w a (HeapT w m a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (w
w w -> HeapT w m a -> Node w a (HeapT w m a)
forall w a b. w -> b -> Node w a b
:< HeapT w m a
xs))
  {-# INLINE wrap #-}

instance Foldable m => Foldable (HeapT w m) where
  foldr :: forall a b. (a -> b -> b) -> b -> HeapT w m a -> b
foldr a -> b -> b
f = b -> HeapT w m a -> b
go
    where
      go :: b -> HeapT w m a -> b
go = ((ListT m (Node w a (HeapT w m a)) -> b)
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT) ((ListT m (Node w a (HeapT w m a)) -> b) -> HeapT w m a -> b)
-> (b -> ListT m (Node w a (HeapT w m a)) -> b)
-> b
-> HeapT w m a
-> b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (Node w a (HeapT w m a) -> b -> b)
-> b -> ListT m (Node w a (HeapT w m a)) -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((b -> Node w a (HeapT w m a) -> b)
-> Node w a (HeapT w m a) -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> b -> b)
-> (HeapT w m a -> b -> b) -> b -> Node w a (HeapT w m a) -> b
forall (p :: Type -> Type -> Type) a c b.
Bifoldable p =>
(a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
bifoldr a -> b -> b
f ((b -> HeapT w m a -> b) -> HeapT w m a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> HeapT w m a -> b
go)))
  {-# INLINE foldr #-}
  
  foldMap :: forall m a. Monoid m => (a -> m) -> HeapT w m a -> m
foldMap a -> m
f = HeapT w m a -> m
go
    where
      go :: HeapT w m a -> m
go = (Node w a (HeapT w m a) -> m)
-> ListT m (Node w a (HeapT w m a)) -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (HeapT w m a -> m) -> Node w a (HeapT w m a) -> m
forall (p :: Type -> Type -> Type) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f HeapT w m a -> m
go) (ListT m (Node w a (HeapT w m a)) -> m)
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> m
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT
  {-# INLINE foldMap #-}

  foldl :: forall b a. (b -> a -> b) -> b -> HeapT w m a -> b
foldl b -> a -> b
f = b -> HeapT w m a -> b
go
    where
      go :: b -> HeapT w m a -> b
go = ((ListT m (Node w a (HeapT w m a)) -> b)
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT) ((ListT m (Node w a (HeapT w m a)) -> b) -> HeapT w m a -> b)
-> (b -> ListT m (Node w a (HeapT w m a)) -> b)
-> b
-> HeapT w m a
-> b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (b -> Node w a (HeapT w m a) -> b)
-> b -> ListT m (Node w a (HeapT w m a)) -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((b -> a -> b)
-> (b -> HeapT w m a -> b) -> b -> Node w a (HeapT w m a) -> b
forall (p :: Type -> Type -> Type) c a b.
Bifoldable p =>
(c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c
bifoldl b -> a -> b
f b -> HeapT w m a -> b
go)
  {-# INLINE foldl #-}
  
  foldl' :: forall b a. (b -> a -> b) -> b -> HeapT w m a -> b
foldl' b -> a -> b
f = b -> HeapT w m a -> b
go
    where
      go :: b -> HeapT w m a -> b
go = ((ListT m (Node w a (HeapT w m a)) -> b)
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT) ((ListT m (Node w a (HeapT w m a)) -> b) -> HeapT w m a -> b)
-> (b -> ListT m (Node w a (HeapT w m a)) -> b)
-> b
-> HeapT w m a
-> b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (b -> Node w a (HeapT w m a) -> b)
-> b -> ListT m (Node w a (HeapT w m a)) -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((b -> a -> b)
-> (b -> HeapT w m a -> b) -> b -> Node w a (HeapT w m a) -> b
forall (t :: Type -> Type -> Type) a b c.
Bifoldable t =>
(a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a
bifoldl' b -> a -> b
f b -> HeapT w m a -> b
go)
  {-# INLINE foldl' #-}
  
  foldr' :: forall a b. (a -> b -> b) -> b -> HeapT w m a -> b
foldr' a -> b -> b
f = b -> HeapT w m a -> b
go
    where
      go :: b -> HeapT w m a -> b
go = ((ListT m (Node w a (HeapT w m a)) -> b)
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT) ((ListT m (Node w a (HeapT w m a)) -> b) -> HeapT w m a -> b)
-> (b -> ListT m (Node w a (HeapT w m a)) -> b)
-> b
-> HeapT w m a
-> b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (Node w a (HeapT w m a) -> b -> b)
-> b -> ListT m (Node w a (HeapT w m a)) -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' ((b -> Node w a (HeapT w m a) -> b)
-> Node w a (HeapT w m a) -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> b -> b)
-> (HeapT w m a -> b -> b) -> b -> Node w a (HeapT w m a) -> b
forall (t :: Type -> Type -> Type) a c b.
Bifoldable t =>
(a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c
bifoldr' a -> b -> b
f ((b -> HeapT w m a -> b) -> HeapT w m a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> HeapT w m a -> b
go)))
  {-# INLINE foldr' #-}

instance Traversable m => Traversable (HeapT w m) where
  traverse :: forall f a b. Applicative f => (a -> f b) -> HeapT w m a -> f (HeapT w m b)
  traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> HeapT w m a -> f (HeapT w m b)
traverse a -> f b
f = (m (ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
 -> HeapT w m b)
-> f (m (ListCons
           (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
-> f (HeapT w m b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListT m (Node w b (HeapT w m b)) -> HeapT w m b
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w b (HeapT w m b)) -> HeapT w m b)
-> (m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
    -> ListT m (Node w b (HeapT w m b)))
-> m (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> HeapT w m b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. m (ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> ListT m (Node w b (HeapT w m b))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT) (f (m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
 -> f (HeapT w m b))
-> (HeapT w m a
    -> f (m (ListCons
               (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))))
-> HeapT w m a
-> f (HeapT w m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ListCons
   (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
 -> f (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> f (m (ListCons
           (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> f (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
h (m (ListCons
      (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
 -> f (m (ListCons
            (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))))
-> (HeapT w m a
    -> m (ListCons
            (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> HeapT w m a
-> f (m (ListCons
           (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# (ListT m (Node w a (HeapT w m a))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (m :: Type -> Type) a.
ListT m a -> m (ListCons a (ListT m a))
runListT (ListT m (Node w a (HeapT w m a))
 -> m (ListCons
         (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT))
    where
      h :: ListCons (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))) -> 
           f (ListCons (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
      h :: ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> f (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
h ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
Nil = ListCons
  (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
-> f (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ListCons
  (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
forall a b. ListCons a b
Nil
      h (Leaf a
x :- ListT m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
xs) = (b
 -> m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
 -> ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> f b
-> f (m (ListCons
           (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
-> f (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((ListT m (Node w b (HeapT w m b))
 -> ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> (m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
    -> ListT m (Node w b (HeapT w m b)))
-> m (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> ListT m (Node w b (HeapT w m b))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT) ((ListT m (Node w b (HeapT w m b))
  -> ListCons
       (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
 -> m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
 -> ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> (b
    -> ListT m (Node w b (HeapT w m b))
    -> ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> b
-> m (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Node w b (HeapT w m b)
-> ListT m (Node w b (HeapT w m b))
-> ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
forall a b. a -> b -> ListCons a b
(:-) (Node w b (HeapT w m b)
 -> ListT m (Node w b (HeapT w m b))
 -> ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> (b -> Node w b (HeapT w m b))
-> b
-> ListT m (Node w b (HeapT w m b))
-> ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Node w b (HeapT w m b)
forall w a b. a -> Node w a b
Leaf) (a -> f b
f a
x) ((ListCons
   (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
 -> f (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> f (m (ListCons
           (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> f (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
h m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
xs)
      h ((w
x :< HeapT (ListT m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
xs)) :- ListT m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
xss) = (m (ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
 -> m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
 -> ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> f (m (ListCons
           (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
-> f (m (ListCons
           (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
-> f (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((((ListT m (Node w b (HeapT w m b))
 -> ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> (m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
    -> ListT m (Node w b (HeapT w m b)))
-> m (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> ListT m (Node w b (HeapT w m b))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT) ((ListT m (Node w b (HeapT w m b))
  -> ListCons
       (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
 -> m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
 -> ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> (Node w b (HeapT w m b)
    -> ListT m (Node w b (HeapT w m b))
    -> ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> Node w b (HeapT w m b)
-> m (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Node w b (HeapT w m b)
-> ListT m (Node w b (HeapT w m b))
-> ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
forall a b. a -> b -> ListCons a b
(:-)) (Node w b (HeapT w m b)
 -> m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
 -> ListCons
      (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> (m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
    -> Node w b (HeapT w m b))
-> m (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> m (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((w
x w -> HeapT w m b -> Node w b (HeapT w m b)
forall w a b. w -> b -> Node w a b
:<) (HeapT w m b -> Node w b (HeapT w m b))
-> (m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
    -> HeapT w m b)
-> m (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> Node w b (HeapT w m b)
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# (ListT m (Node w b (HeapT w m b)) -> HeapT w m b
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w b (HeapT w m b)) -> HeapT w m b)
-> (m (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
    -> ListT m (Node w b (HeapT w m b)))
-> m (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> HeapT w m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (ListCons
     (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
-> ListT m (Node w b (HeapT w m b))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT))) ((ListCons
   (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
 -> f (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> f (m (ListCons
           (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> f (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
h m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
xs) ((ListCons
   (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
 -> f (ListCons
         (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> f (m (ListCons
           (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b)))))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> f (ListCons
        (Node w b (HeapT w m b)) (ListT m (Node w b (HeapT w m b))))
h m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
xss)
  {-# INLINE traverse #-}

deriving newtype instance (forall x. NFData x => NFData (m x), NFData w, NFData a) => NFData (HeapT w m a) 

instance (Arbitrary1 m, Arbitrary w, Arbitrary a) => Arbitrary (HeapT w m a) where
  arbitrary :: Gen (HeapT w m a)
arbitrary = Gen (HeapT w m a)
forall (f :: Type -> Type) a.
(Arbitrary1 f, Arbitrary a) =>
Gen (f a)
arbitrary1

instance (Arbitrary1 m, Arbitrary w) => Arbitrary1 (HeapT w m) where
  liftArbitrary :: forall a. Gen a -> Gen (HeapT w m a)
liftArbitrary Gen a
arb = (Int -> Gen (HeapT w m a)) -> Gen (HeapT w m a)
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen (HeapT w m a)
go1
    where
      go1 :: Int -> Gen (HeapT w m a)
go1 Int
n = ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w a (HeapT w m a)) -> HeapT w m a)
-> Gen (ListT m (Node w a (HeapT w m a))) -> Gen (HeapT w m a)
forall (f :: Type -> Type) a b.
Coercible (f a) (f b) =>
(a -> b) -> f a -> f b
<#$> (Int -> Gen [Int]
sumsTo Int
n Gen [Int]
-> ([Int] -> Gen (ListT m (Node w a (HeapT w m a))))
-> Gen (ListT m (Node w a (HeapT w m a)))
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int
 -> Gen (ListT m (Node w a (HeapT w m a)))
 -> Gen (ListT m (Node w a (HeapT w m a))))
-> Gen (ListT m (Node w a (HeapT w m a)))
-> [Int]
-> Gen (ListT m (Node w a (HeapT w m a)))
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int
-> Gen (ListT m (Node w a (HeapT w m a)))
-> Gen (ListT m (Node w a (HeapT w m a)))
go2f Gen (ListT m (Node w a (HeapT w m a)))
forall {a}. Gen (ListT m a)
go2b)
      go2b :: Gen (ListT m a)
go2b      = m (ListCons a (ListT m a)) -> ListT m a
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (m (ListCons a (ListT m a)) -> ListT m a)
-> Gen (m (ListCons a (ListT m a))) -> Gen (ListT m a)
forall (f :: Type -> Type) a b.
Coercible (f a) (f b) =>
(a -> b) -> f a -> f b
<#$> Gen (ListCons a (ListT m a)) -> Gen (m (ListCons a (ListT m a)))
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (ListCons a (ListT m a) -> Gen (ListCons a (ListT m a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ListCons a (ListT m a)
forall a b. ListCons a b
Nil)
      go2f :: Int
-> Gen (ListT m (Node w a (HeapT w m a)))
-> Gen (ListT m (Node w a (HeapT w m a)))
go2f Int
n Gen (ListT m (Node w a (HeapT w m a)))
ns = m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (m (ListCons
      (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
 -> ListT m (Node w a (HeapT w m a)))
-> Gen
     (m (ListCons
           (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> Gen (ListT m (Node w a (HeapT w m a)))
forall (f :: Type -> Type) a b.
Coercible (f a) (f b) =>
(a -> b) -> f a -> f b
<#$> Gen
  (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> Gen
     (m (ListCons
           (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary ((Node w a (HeapT w m a)
 -> ListT m (Node w a (HeapT w m a))
 -> ListCons
      (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> Gen (Node w a (HeapT w m a))
-> Gen (ListT m (Node w a (HeapT w m a)))
-> Gen
     (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Node w a (HeapT w m a)
-> ListT m (Node w a (HeapT w m a))
-> ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall a b. a -> b -> ListCons a b
(:-) (Int -> Gen (Node w a (HeapT w m a))
go3 Int
n) Gen (ListT m (Node w a (HeapT w m a)))
ns)
      go3 :: Int -> Gen (Node w a (HeapT w m a))
go3 Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = (a -> Node w a (HeapT w m a))
-> Gen a -> Gen (Node w a (HeapT w m a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Node w a (HeapT w m a)
forall w a b. a -> Node w a b
Leaf Gen a
arb
      go3 Int
n = [(Int, Gen (Node w a (HeapT w m a)))]
-> Gen (Node w a (HeapT w m a))
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
1, (a -> Node w a (HeapT w m a))
-> Gen a -> Gen (Node w a (HeapT w m a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Node w a (HeapT w m a)
forall w a b. a -> Node w a b
Leaf Gen a
arb), (Int
n, (w -> HeapT w m a -> Node w a (HeapT w m a))
-> Gen w -> Gen (HeapT w m a) -> Gen (Node w a (HeapT w m a))
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 w -> HeapT w m a -> Node w a (HeapT w m a)
forall w a b. w -> b -> Node w a b
(:<) Gen w
forall a. Arbitrary a => Gen a
arbitrary (Int -> Gen (HeapT w m a)
go1 Int
n))]

-- | The 'Heap' type, specialised to the 'Identity' monad.
type Heap w = HeapT w Identity

runHeapIdent :: Heap w a -> [Node w a (Heap w a)]
runHeapIdent :: forall w a. Heap w a -> [Node w a (Heap w a)]
runHeapIdent = Identity [Node w a (HeapT w Identity a)]
-> [Node w a (HeapT w Identity a)]
forall a. Identity a -> a
runIdentity (Identity [Node w a (HeapT w Identity a)]
 -> [Node w a (HeapT w Identity a)])
-> (HeapT w Identity a -> Identity [Node w a (HeapT w Identity a)])
-> HeapT w Identity a
-> [Node w a (HeapT w Identity a)]
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (ListT Identity (Node w a (HeapT w Identity a))
-> Identity [Node w a (HeapT w Identity a)]
forall (m :: Type -> Type) a. Monad m => ListT m a -> m [a]
toListT (ListT Identity (Node w a (HeapT w Identity a))
 -> Identity [Node w a (HeapT w Identity a)])
-> (HeapT w Identity a
    -> ListT Identity (Node w a (HeapT w Identity a)))
-> HeapT w Identity a
-> Identity [Node w a (HeapT w Identity a)]
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# HeapT w Identity a
-> ListT Identity (Node w a (HeapT w Identity a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT)
{-# INLINE runHeapIdent #-}

toHeapIdent :: [Node w a (Heap w a)] -> Heap w a
toHeapIdent :: forall w a. [Node w a (Heap w a)] -> Heap w a
toHeapIdent = ListT Identity (Node w a (HeapT w Identity a))
-> HeapT w Identity a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT Identity (Node w a (HeapT w Identity a))
 -> HeapT w Identity a)
-> ([Node w a (HeapT w Identity a)]
    -> ListT Identity (Node w a (HeapT w Identity a)))
-> [Node w a (HeapT w Identity a)]
-> HeapT w Identity a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (Node w a (HeapT w Identity a)
 -> ListT Identity (Node w a (HeapT w Identity a))
 -> ListT Identity (Node w a (HeapT w Identity a)))
-> ListT Identity (Node w a (HeapT w Identity a))
-> [Node w a (HeapT w Identity a)]
-> ListT Identity (Node w a (HeapT w Identity a))
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Identity
  (ListCons
     (Node w a (HeapT w Identity a))
     (ListT Identity (Node w a (HeapT w Identity a))))
-> ListT Identity (Node w a (HeapT w Identity a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (Identity
   (ListCons
      (Node w a (HeapT w Identity a))
      (ListT Identity (Node w a (HeapT w Identity a))))
 -> ListT Identity (Node w a (HeapT w Identity a)))
-> (ListCons
      (Node w a (HeapT w Identity a))
      (ListT Identity (Node w a (HeapT w Identity a)))
    -> Identity
         (ListCons
            (Node w a (HeapT w Identity a))
            (ListT Identity (Node w a (HeapT w Identity a)))))
-> ListCons
     (Node w a (HeapT w Identity a))
     (ListT Identity (Node w a (HeapT w Identity a)))
-> ListT Identity (Node w a (HeapT w Identity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListCons
  (Node w a (HeapT w Identity a))
  (ListT Identity (Node w a (HeapT w Identity a)))
-> Identity
     (ListCons
        (Node w a (HeapT w Identity a))
        (ListT Identity (Node w a (HeapT w Identity a))))
forall a. a -> Identity a
Identity) (ListCons
   (Node w a (HeapT w Identity a))
   (ListT Identity (Node w a (HeapT w Identity a)))
 -> ListT Identity (Node w a (HeapT w Identity a)))
-> (ListT Identity (Node w a (HeapT w Identity a))
    -> ListCons
         (Node w a (HeapT w Identity a))
         (ListT Identity (Node w a (HeapT w Identity a))))
-> ListT Identity (Node w a (HeapT w Identity a))
-> ListT Identity (Node w a (HeapT w Identity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ) ((ListT Identity (Node w a (HeapT w Identity a))
  -> ListCons
       (Node w a (HeapT w Identity a))
       (ListT Identity (Node w a (HeapT w Identity a))))
 -> ListT Identity (Node w a (HeapT w Identity a))
 -> ListT Identity (Node w a (HeapT w Identity a)))
-> (Node w a (HeapT w Identity a)
    -> ListT Identity (Node w a (HeapT w Identity a))
    -> ListCons
         (Node w a (HeapT w Identity a))
         (ListT Identity (Node w a (HeapT w Identity a))))
-> Node w a (HeapT w Identity a)
-> ListT Identity (Node w a (HeapT w Identity a))
-> ListT Identity (Node w a (HeapT w Identity a))
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Node w a (HeapT w Identity a)
-> ListT Identity (Node w a (HeapT w Identity a))
-> ListCons
     (Node w a (HeapT w Identity a))
     (ListT Identity (Node w a (HeapT w Identity a)))
forall a b. a -> b -> ListCons a b
(:-)) (Identity
  (ListCons
     (Node w a (HeapT w Identity a))
     (ListT Identity (Node w a (HeapT w Identity a))))
-> ListT Identity (Node w a (HeapT w Identity a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (ListCons
  (Node w a (HeapT w Identity a))
  (ListT Identity (Node w a (HeapT w Identity a)))
-> Identity
     (ListCons
        (Node w a (HeapT w Identity a))
        (ListT Identity (Node w a (HeapT w Identity a))))
forall a. a -> Identity a
Identity ListCons
  (Node w a (HeapT w Identity a))
  (ListT Identity (Node w a (HeapT w Identity a)))
forall a b. ListCons a b
Nil))
{-# INLINE toHeapIdent #-}

-- | The constructor for the non-transformer 'Heap' type.
pattern Heap :: [Node w a (Heap w a)] -> Heap w a
pattern $bHeap :: forall w a. [Node w a (Heap w a)] -> Heap w a
$mHeap :: forall {r} {w} {a}.
Heap w a -> ([Node w a (Heap w a)] -> r) -> (Void# -> r) -> r
Heap { forall w a. Heap w a -> [Node w a (Heap w a)]
runHeap } <- (runHeapIdent -> runHeap) 
  where
    Heap = [Node w a (Heap w a)] -> Heap w a
forall w a. [Node w a (Heap w a)] -> Heap w a
toHeapIdent
{-# COMPLETE Heap #-}

instance (forall x. Show x => Show (m x), Show a, Show w) => Show (HeapT w m a) where
  showsPrec :: Int -> HeapT w m a -> ShowS
showsPrec Int
n (HeapT ListT m (Node w a (HeapT w m a))
xs) = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (String -> ShowS
showString String
"HeapT " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ListT m (Node w a (HeapT w m a)) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ListT m (Node w a (HeapT w m a))
xs)
  
instance (forall x. Read x => Read (m x), Read w, Read a) => Read (HeapT w m a) where
  readPrec :: ReadPrec (HeapT w m a)
readPrec = ReadPrec (HeapT w m a) -> ReadPrec (HeapT w m a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (HeapT w m a) -> ReadPrec (HeapT w m a))
-> ReadPrec (HeapT w m a) -> ReadPrec (HeapT w m a)
forall a b. (a -> b) -> a -> b
$
      Int -> ReadPrec (HeapT w m a) -> ReadPrec (HeapT w m a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (HeapT w m a) -> ReadPrec (HeapT w m a))
-> ReadPrec (HeapT w m a) -> ReadPrec (HeapT w m a)
forall a b. (a -> b) -> a -> b
$ do
        Ident String
"HeapT" <- ReadPrec Lexeme
lexP
        ListT m (Node w a (HeapT w m a))
m <- ReadPrec (ListT m (Node w a (HeapT w m a)))
-> ReadPrec (ListT m (Node w a (HeapT w m a)))
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (ListT m (Node w a (HeapT w m a)))
forall a. Read a => ReadPrec a
readPrec
        return (ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT ListT m (Node w a (HeapT w m a))
m)
  
deriving instance (forall x. Eq x => Eq (m x), Eq a, Eq w) => Eq (HeapT w m a)
-- Some special incantations are needed to make this work:
-- In my mind, the following *should* work:
-- @
-- deriving instance (Ord w, Ord a, forall x. Ord x => Ord (m x)) => Ord (HeapT w m a)
-- @
-- But for reasons described here
-- https://downloads.haskell.org/~ghc/9.0.1/docs/html/users_guide/9.0.1-notes.html#language
-- You need the following slightly more complicated thing:
deriving instance ( Ord w, Ord a
                  , forall x. Ord x => Ord (m x)
                  , Eq (HeapT w m a)                       -- These two are needed
                  , Eq (ListT m (Node w a (HeapT w m a)))  -- for reasons I do not understand!
                  ) => Ord (HeapT w m a)

instance Functor m => Functor (HeapT w m) where
  fmap :: forall a b. (a -> b) -> HeapT w m a -> HeapT w m b
fmap a -> b
f = ListT m (Node w b (HeapT w m b)) -> HeapT w m b
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w b (HeapT w m b)) -> HeapT w m b)
-> (HeapT w m a -> ListT m (Node w b (HeapT w m b)))
-> HeapT w m a
-> HeapT w m b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. ((Node w a (HeapT w m a) -> Node w b (HeapT w m b))
-> ListT m (Node w a (HeapT w m a))
-> ListT m (Node w b (HeapT w m b))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
-> (HeapT w m a -> HeapT w m b)
-> Node w a (HeapT w m a)
-> Node w b (HeapT w m b)
forall (p :: Type -> Type -> Type) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f ((a -> b) -> HeapT w m a -> HeapT w m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (ListT m (Node w a (HeapT w m a))
 -> ListT m (Node w b (HeapT w m b)))
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> ListT m (Node w b (HeapT w m b))
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT)
  {-# INLINE fmap #-}

instance Monad m => Applicative (HeapT w m) where
  pure :: forall a. a -> HeapT w m a
pure = ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w a (HeapT w m a)) -> HeapT w m a)
-> (a -> ListT m (Node w a (HeapT w m a))) -> a -> HeapT w m a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Node w a (HeapT w m a) -> ListT m (Node w a (HeapT w m a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Node w a (HeapT w m a) -> ListT m (Node w a (HeapT w m a)))
-> (a -> Node w a (HeapT w m a))
-> a
-> ListT m (Node w a (HeapT w m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Node w a (HeapT w m a)
forall w a b. a -> Node w a b
Leaf
  {-# INLINE pure #-}
  <*> :: forall a b. HeapT w m (a -> b) -> HeapT w m a -> HeapT w m b
(<*>) = ((a -> b) -> a -> b)
-> HeapT w m (a -> b) -> HeapT w m a -> HeapT w m b
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (a -> b) -> a -> b
forall a. a -> a
id
  {-# INLINE (<*>) #-}
  *> :: forall a b. HeapT w m a -> HeapT w m b -> HeapT w m b
(*>) = HeapT w m a -> HeapT w m b -> HeapT w m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
(>>)  -- We have to do this because the default definition
               -- is (x *> y) = (id <$ x) <*> y. (which is horrifically slow)
  {-# INLINE (*>) #-}
  liftA2 :: forall a b c.
(a -> b -> c) -> HeapT w m a -> HeapT w m b -> HeapT w m c
liftA2 a -> b -> c
f HeapT w m a
xs HeapT w m b
ys = do
    a
x <- HeapT w m a
xs
    (b -> c) -> HeapT w m b -> HeapT w m c
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
x) HeapT w m b
ys
  {-# INLINE liftA2 #-}

instance Monad m => Monad (HeapT w m) where
  HeapT ListT m (Node w a (HeapT w m a))
m >>= :: forall a b. HeapT w m a -> (a -> HeapT w m b) -> HeapT w m b
>>= a -> HeapT w m b
f = ListT m (Node w b (HeapT w m b)) -> HeapT w m b
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w a (HeapT w m a))
m ListT m (Node w a (HeapT w m a))
-> (Node w a (HeapT w m a) -> ListT m (Node w b (HeapT w m b)))
-> ListT m (Node w b (HeapT w m b))
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node w a (HeapT w m a) -> ListT m (Node w b (HeapT w m b))
g)
    where
      g :: Node w a (HeapT w m a) -> ListT m (Node w b (HeapT w m b))
g (Leaf a
x) = HeapT w m b -> ListT m (Node w b (HeapT w m b))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT (a -> HeapT w m b
f a
x)
      g (w
w :< HeapT w m a
xs) = Node w b (HeapT w m b) -> ListT m (Node w b (HeapT w m b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (w
w w -> HeapT w m b -> Node w b (HeapT w m b)
forall w a b. w -> b -> Node w a b
:< (HeapT w m a
xs HeapT w m a -> (a -> HeapT w m b) -> HeapT w m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> HeapT w m b
f))
  {-# INLINE (>>=) #-}
  HeapT w m a
xs >> :: forall a b. HeapT w m a -> HeapT w m b -> HeapT w m b
>> HeapT w m b
ys = HeapT w m a
xs HeapT w m a -> (a -> HeapT w m b) -> HeapT w m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= HeapT w m b -> a -> HeapT w m b
forall a b. a -> b -> a
const HeapT w m b
ys
  {-# INLINE (>>) #-}

instance Monad m => Alternative (HeapT w m) where
  <|> :: forall a. HeapT w m a -> HeapT w m a -> HeapT w m a
(<|>) = (ListT m (Node w a (HeapT w m a))
 -> ListT m (Node w a (HeapT w m a))
 -> ListT m (Node w a (HeapT w m a)))
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> HeapT w m a
-> HeapT w m a
forall a b.
Coercible a b =>
(b -> b -> b) -> (a -> b) -> a -> a -> a
under ListT m (Node w a (HeapT w m a))
-> ListT m (Node w a (HeapT w m a))
-> ListT m (Node w a (HeapT w m a))
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
(<|>) HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT
  {-# INLINE (<|>) #-}
  empty :: forall a. HeapT w m a
empty = ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT ListT m (Node w a (HeapT w m a))
forall (f :: Type -> Type) a. Alternative f => f a
empty
  {-# INLINE empty #-}

instance Monad m => MonadPlus (HeapT w m)

instance MonadTrans (HeapT w) where
  lift :: forall (m :: Type -> Type) a. Monad m => m a -> HeapT w m a
lift = ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w a (HeapT w m a)) -> HeapT w m a)
-> (m a -> ListT m (Node w a (HeapT w m a))) -> m a -> HeapT w m a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (m (ListCons
      (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
 -> ListT m (Node w a (HeapT w m a)))
-> (m a
    -> m (ListCons
            (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> m a
-> ListT m (Node w a (HeapT w m a))
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a
 -> ListCons
      (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> m a
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Node w a (HeapT w m a)
-> ListT m (Node w a (HeapT w m a))
-> ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall a b. a -> b -> ListCons a b
:- ListT m (Node w a (HeapT w m a))
forall (f :: Type -> Type) a. Alternative f => f a
empty) (Node w a (HeapT w m a)
 -> ListCons
      (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> (a -> Node w a (HeapT w m a))
-> a
-> ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Node w a (HeapT w m a)
forall w a b. a -> Node w a b
Leaf)
  {-# INLINE lift #-}

(<||>) ::  (Monus w, Monad m) =>
           (w, HeapT w m a) ->
           (w, HeapT w m a) ->
           (w, HeapT w m a)
(w
x, HeapT w m a
xv) <||> :: forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
(w, HeapT w m a) -> (w, HeapT w m a) -> (w, HeapT w m a)
<||> (w
y, HeapT w m a
yv)
  | w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
y    = (w
x, ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((w
y w -> w -> w
forall a. Monus a => a -> a -> a
|-| w
x w -> HeapT w m a -> Node w a (HeapT w m a)
forall w a b. w -> b -> Node w a b
:< HeapT w m a
yv) Node w a (HeapT w m a)
-> ListT m (Node w a (HeapT w m a))
-> ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall a b. a -> b -> ListCons a b
:- HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT HeapT w m a
xv))))
  | Bool
otherwise = (w
y, ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((w
x w -> w -> w
forall a. Monus a => a -> a -> a
|-| w
y w -> HeapT w m a -> Node w a (HeapT w m a)
forall w a b. w -> b -> Node w a b
:< HeapT w m a
xv) Node w a (HeapT w m a)
-> ListT m (Node w a (HeapT w m a))
-> ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall a b. a -> b -> ListCons a b
:- HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT HeapT w m a
yv))))
{-# INLINE (<||>) #-}

comb ::  (Monus w, Monad m) =>
         [(w, HeapT w m a)] ->
         Maybe (w, HeapT w m a)
comb :: forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
[(w, HeapT w m a)] -> Maybe (w, HeapT w m a)
comb [] = Maybe (w, HeapT w m a)
forall a. Maybe a
Nothing
comb ((w, HeapT w m a)
x:[(w, HeapT w m a)]
xs) = (w, HeapT w m a) -> Maybe (w, HeapT w m a)
forall a. a -> Maybe a
Just ((w, HeapT w m a) -> [(w, HeapT w m a)] -> (w, HeapT w m a)
forall {w} {m :: Type -> Type} {a}.
(Monus w, Monad m) =>
(w, HeapT w m a) -> [(w, HeapT w m a)] -> (w, HeapT w m a)
comb1 (w, HeapT w m a)
x [(w, HeapT w m a)]
xs)
  where
    comb1 :: (w, HeapT w m a) -> [(w, HeapT w m a)] -> (w, HeapT w m a)
comb1 (w, HeapT w m a)
x [] = (w, HeapT w m a)
x
    comb1 (w, HeapT w m a)
x1 [(w, HeapT w m a)
x2] = (w, HeapT w m a)
x1 (w, HeapT w m a) -> (w, HeapT w m a) -> (w, HeapT w m a)
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
(w, HeapT w m a) -> (w, HeapT w m a) -> (w, HeapT w m a)
<||> (w, HeapT w m a)
x2
    comb1 (w, HeapT w m a)
x1 ((w, HeapT w m a)
x2 : (w, HeapT w m a)
x3 : [(w, HeapT w m a)]
xs) = ((w, HeapT w m a)
x1 (w, HeapT w m a) -> (w, HeapT w m a) -> (w, HeapT w m a)
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
(w, HeapT w m a) -> (w, HeapT w m a) -> (w, HeapT w m a)
<||> (w, HeapT w m a)
x2) (w, HeapT w m a) -> (w, HeapT w m a) -> (w, HeapT w m a)
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
(w, HeapT w m a) -> (w, HeapT w m a) -> (w, HeapT w m a)
<||> (w, HeapT w m a) -> [(w, HeapT w m a)] -> (w, HeapT w m a)
comb1 (w, HeapT w m a)
x3 [(w, HeapT w m a)]
xs
{-# INLINE comb #-}

partition :: [Node w a b] -> ([a], [(w, b)])
partition :: forall w a b. [Node w a b] -> ([a], [(w, b)])
partition = (Node w a b -> ([a], [(w, b)]) -> ([a], [(w, b)]))
-> ([a], [(w, b)]) -> [Node w a b] -> ([a], [(w, b)])
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node w a b -> ([a], [(w, b)]) -> ([a], [(w, b)])
forall {a} {a} {b}.
Node a a b -> ([a], [(a, b)]) -> ([a], [(a, b)])
f ([],[])
  where
    f :: Node a a b -> ([a], [(a, b)]) -> ([a], [(a, b)])
f (Leaf a
x) ([a]
ys,[(a, b)]
zs) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys,[(a, b)]
zs)
    f (a
w :< b
x) ([a]
ys,[(a, b)]
zs) = ([a]
ys, (a
w, b
x) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
zs)
{-# INLINE partition #-}

-- | The monadic variant of 'popMin'.
popMinT ::  (Monus w, Monad m) =>
            HeapT w m a ->
            m ([a], Maybe (w, HeapT w m a))
popMinT :: forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
HeapT w m a -> m ([a], Maybe (w, HeapT w m a))
popMinT = ([Node w a (HeapT w m a)] -> ([a], Maybe (w, HeapT w m a)))
-> m [Node w a (HeapT w m a)] -> m ([a], Maybe (w, HeapT w m a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(w, HeapT w m a)] -> Maybe (w, HeapT w m a))
-> ([a], [(w, HeapT w m a)]) -> ([a], Maybe (w, HeapT w m a))
forall (p :: Type -> Type -> Type) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(w, HeapT w m a)] -> Maybe (w, HeapT w m a)
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
[(w, HeapT w m a)] -> Maybe (w, HeapT w m a)
comb (([a], [(w, HeapT w m a)]) -> ([a], Maybe (w, HeapT w m a)))
-> ([Node w a (HeapT w m a)] -> ([a], [(w, HeapT w m a)]))
-> [Node w a (HeapT w m a)]
-> ([a], Maybe (w, HeapT w m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node w a (HeapT w m a)] -> ([a], [(w, HeapT w m a)])
forall w a b. [Node w a b] -> ([a], [(w, b)])
partition) (m [Node w a (HeapT w m a)] -> m ([a], Maybe (w, HeapT w m a)))
-> (HeapT w m a -> m [Node w a (HeapT w m a)])
-> HeapT w m a
-> m ([a], Maybe (w, HeapT w m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m (Node w a (HeapT w m a)) -> m [Node w a (HeapT w m a)]
forall (m :: Type -> Type) a. Monad m => ListT m a -> m [a]
toListT (ListT m (Node w a (HeapT w m a)) -> m [Node w a (HeapT w m a)])
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> m [Node w a (HeapT w m a)]
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT
{-# INLINE popMinT #-}

-- | /O(log n)/. 'popMin' returns a list of those elements in the 'Heap' with a
-- weight equal to 'mempty', paired with the rest of the heap and the minimum
-- weight in the rest of the heap.
popMin :: Monus w => Heap w a -> ([a], Maybe (w, Heap w a))
popMin :: forall w a. Monus w => Heap w a -> ([a], Maybe (w, Heap w a))
popMin = Identity ([a], Maybe (w, HeapT w Identity a))
-> ([a], Maybe (w, HeapT w Identity a))
forall a. Identity a -> a
runIdentity (Identity ([a], Maybe (w, HeapT w Identity a))
 -> ([a], Maybe (w, HeapT w Identity a)))
-> (HeapT w Identity a
    -> Identity ([a], Maybe (w, HeapT w Identity a)))
-> HeapT w Identity a
-> ([a], Maybe (w, HeapT w Identity a))
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. HeapT w Identity a -> Identity ([a], Maybe (w, HeapT w Identity a))
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
HeapT w m a -> m ([a], Maybe (w, HeapT w m a))
popMinT
{-# INLINE popMin #-}

-- | The monadic variant of 'popMinOne'.
popMinOneT :: forall w m a. (Monus w, Monad m) => HeapT w m a -> m (Maybe ((a, w), HeapT w m a))
popMinOneT :: forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
HeapT w m a -> m (Maybe ((a, w), HeapT w m a))
popMinOneT = w
-> [(w, HeapT w m a)]
-> ListT m (Node w a (HeapT w m a))
-> m (Maybe ((a, w), HeapT w m a))
go w
forall a. Monoid a => a
mempty [] (ListT m (Node w a (HeapT w m a))
 -> m (Maybe ((a, w), HeapT w m a)))
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> m (Maybe ((a, w), HeapT w m a))
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT
  where
    go' :: w -> Maybe (w, HeapT w m a) -> m (Maybe ((a, w), HeapT w m a))
    go' :: w -> Maybe (w, HeapT w m a) -> m (Maybe ((a, w), HeapT w m a))
go' w
a Maybe (w, HeapT w m a)
Nothing = Maybe ((a, w), HeapT w m a) -> m (Maybe ((a, w), HeapT w m a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe ((a, w), HeapT w m a)
forall a. Maybe a
Nothing
    go' w
a (Just (w
w, HeapT ListT m (Node w a (HeapT w m a))
xs)) = w
-> [(w, HeapT w m a)]
-> ListT m (Node w a (HeapT w m a))
-> m (Maybe ((a, w), HeapT w m a))
go (w
a w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w) [] ListT m (Node w a (HeapT w m a))
xs
    
    go :: w -> [(w, HeapT w m a)] -> ListT m (Node w a (HeapT w m a)) -> m (Maybe ((a, w), HeapT w m a))
    go :: w
-> [(w, HeapT w m a)]
-> ListT m (Node w a (HeapT w m a))
-> m (Maybe ((a, w), HeapT w m a))
go w
w [(w, HeapT w m a)]
a (ListT m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
xs) = m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
xs m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> (ListCons
      (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
    -> m (Maybe ((a, w), HeapT w m a)))
-> m (Maybe ((a, w), HeapT w m a))
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
Nil -> w -> Maybe (w, HeapT w m a) -> m (Maybe ((a, w), HeapT w m a))
go' w
w ([(w, HeapT w m a)] -> Maybe (w, HeapT w m a)
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
[(w, HeapT w m a)] -> Maybe (w, HeapT w m a)
comb ([(w, HeapT w m a)] -> [(w, HeapT w m a)]
forall a. [a] -> [a]
reverse [(w, HeapT w m a)]
a))
      Leaf a
x :- ListT m (Node w a (HeapT w m a))
xs -> Maybe ((a, w), HeapT w m a) -> m (Maybe ((a, w), HeapT w m a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (((a, w), HeapT w m a) -> Maybe ((a, w), HeapT w m a)
forall a. a -> Maybe a
Just ((a
x, w
w), w -> HeapT w m ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell w
w HeapT w m () -> HeapT w m a -> HeapT w m a
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT ((ListT m (Node w a (HeapT w m a))
 -> (w, HeapT w m a) -> ListT m (Node w a (HeapT w m a)))
-> ListT m (Node w a (HeapT w m a))
-> [(w, HeapT w m a)]
-> ListT m (Node w a (HeapT w m a))
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ListT m (Node w a (HeapT w m a))
ys (w
yw,HeapT w m a
y) -> m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (ListCons
  (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((w
yw w -> HeapT w m a -> Node w a (HeapT w m a)
forall w a b. w -> b -> Node w a b
:< HeapT w m a
y) Node w a (HeapT w m a)
-> ListT m (Node w a (HeapT w m a))
-> ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))
forall a b. a -> b -> ListCons a b
:- ListT m (Node w a (HeapT w m a))
ys))) ListT m (Node w a (HeapT w m a))
xs [(w, HeapT w m a)]
a)))
      (w
u :< HeapT w m a
x) :- ListT m (Node w a (HeapT w m a))
xs -> w
-> [(w, HeapT w m a)]
-> ListT m (Node w a (HeapT w m a))
-> m (Maybe ((a, w), HeapT w m a))
go w
w ((w
u,HeapT w m a
x) (w, HeapT w m a) -> [(w, HeapT w m a)] -> [(w, HeapT w m a)]
forall a. a -> [a] -> [a]
: [(w, HeapT w m a)]
a) ListT m (Node w a (HeapT w m a))
xs
{-# INLINE popMinOneT #-}
    
-- | /O(log n)/. 'popMinOne' returns the smallest weighted element in the
-- heap, along with its weight, along with the rest of the heap.
--
-- This function is a more traditional version of 'popMin', but it has much
-- worse performance in general.
popMinOne :: Monus w => Heap w a -> Maybe ((a, w), Heap w a)
popMinOne :: forall w a. Monus w => Heap w a -> Maybe ((a, w), Heap w a)
popMinOne = Identity (Maybe ((a, w), HeapT w Identity a))
-> Maybe ((a, w), HeapT w Identity a)
forall a. Identity a -> a
runIdentity (Identity (Maybe ((a, w), HeapT w Identity a))
 -> Maybe ((a, w), HeapT w Identity a))
-> (HeapT w Identity a
    -> Identity (Maybe ((a, w), HeapT w Identity a)))
-> HeapT w Identity a
-> Maybe ((a, w), HeapT w Identity a)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. HeapT w Identity a -> Identity (Maybe ((a, w), HeapT w Identity a))
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
HeapT w m a -> m (Maybe ((a, w), HeapT w m a))
popMinOneT
{-# INLINE popMinOne #-}

-- | The monadic version of 'flatten'.
flattenT :: (Monad m, Monoid w) => HeapT w m a -> ListT m (a, w)
flattenT :: forall (m :: Type -> Type) w a.
(Monad m, Monoid w) =>
HeapT w m a -> ListT m (a, w)
flattenT = WriterT w (ListT m) a -> ListT m (a, w)
forall w (m :: Type -> Type) a. WriterT w m a -> m (a, w)
runWriterT (WriterT w (ListT m) a -> ListT m (a, w))
-> (HeapT w m a -> WriterT w (ListT m) a)
-> HeapT w m a
-> ListT m (a, w)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. HeapT w m a -> WriterT w (ListT m) a
forall {b}. HeapT w m b -> WriterT w (ListT m) b
go
  where
    go :: HeapT w m b -> WriterT w (ListT m) b
go = (Node w b (HeapT w m b) -> WriterT w (ListT m) b
h (Node w b (HeapT w m b) -> WriterT w (ListT m) b)
-> (ListT m (Node w b (HeapT w m b))
    -> WriterT w (ListT m) (Node w b (HeapT w m b)))
-> ListT m (Node w b (HeapT w m b))
-> WriterT w (ListT m) b
forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ListT m (Node w b (HeapT w m b))
-> WriterT w (ListT m) (Node w b (HeapT w m b))
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (ListT m (Node w b (HeapT w m b)) -> WriterT w (ListT m) b)
-> (HeapT w m b -> ListT m (Node w b (HeapT w m b)))
-> HeapT w m b
-> WriterT w (ListT m) b
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# HeapT w m b -> ListT m (Node w b (HeapT w m b))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT
    h :: Node w b (HeapT w m b) -> WriterT w (ListT m) b
h (Leaf b
x) = b -> WriterT w (ListT m) b
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
x
    h (w
w :< HeapT w m b
xs) = (HeapT w m b, w) -> WriterT w (ListT m) (HeapT w m b)
forall w (m :: Type -> Type) a. MonadWriter w m => (a, w) -> m a
writer (HeapT w m b
xs, w
w) WriterT w (ListT m) (HeapT w m b)
-> (HeapT w m b -> WriterT w (ListT m) b) -> WriterT w (ListT m) b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= HeapT w m b -> WriterT w (ListT m) b
go
{-# INLINE flattenT #-}

-- | /O(n)/. Return all the elements of the heap, /not/ in order of their
-- weights, paired with their weights.
--
-- >>> flatten (fromList [('a',5), ('b', 3), ('c',6)])
-- [('a',5),('b',3),('c',6)]
flatten :: Monoid w => Heap w a -> [(a, w)]
flatten :: forall w a. Monoid w => Heap w a -> [(a, w)]
flatten = Identity [(a, w)] -> [(a, w)]
forall a. Identity a -> a
runIdentity (Identity [(a, w)] -> [(a, w)])
-> (HeapT w Identity a -> Identity [(a, w)])
-> HeapT w Identity a
-> [(a, w)]
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. ListT Identity (a, w) -> Identity [(a, w)]
forall (m :: Type -> Type) a. Monad m => ListT m a -> m [a]
toListT (ListT Identity (a, w) -> Identity [(a, w)])
-> (HeapT w Identity a -> ListT Identity (a, w))
-> HeapT w Identity a
-> Identity [(a, w)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeapT w Identity a -> ListT Identity (a, w)
forall (m :: Type -> Type) w a.
(Monad m, Monoid w) =>
HeapT w m a -> ListT m (a, w)
flattenT
{-# INLINE flatten #-}

-- | The monadic variant of 'search'.
searchT ::  (Monad m, Monus w) =>
            HeapT w m a -> m [(a, w)]
searchT :: forall (m :: Type -> Type) w a.
(Monad m, Monus w) =>
HeapT w m a -> m [(a, w)]
searchT HeapT w m a
xs = HeapT w m a -> m ([a], Maybe (w, HeapT w m a))
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
HeapT w m a -> m ([a], Maybe (w, HeapT w m a))
popMinT HeapT w m a
xs m ([a], Maybe (w, HeapT w m a))
-> (([a], Maybe (w, HeapT w m a)) -> m [(a, w)]) -> m [(a, w)]
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> ([a], Maybe (w, HeapT w m a)) -> m [(a, w)]
forall {f :: Type -> Type} {w} {a}.
(Monad f, Monus w) =>
w -> ([a], Maybe (w, HeapT w f a)) -> f [(a, w)]
go w
forall a. Monoid a => a
mempty where
    go :: w -> ([a], Maybe (w, HeapT w f a)) -> f [(a, w)]
go !w
w1 ([a]
x, Maybe (w, HeapT w f a)
Nothing)        = [(a, w)] -> f [(a, w)]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure  ((a -> (a, w)) -> [a] -> [(a, w)]
forall a b. (a -> b) -> [a] -> [b]
map (,w
w1) [a]
x)
    go !w
w1 ([a]
x, Just (w
w2, HeapT w f a
xs))  = ([(a, w)] -> [(a, w)]) -> f [(a, w)] -> f [(a, w)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap  ((a -> (a, w)) -> [a] -> [(a, w)]
forall a b. (a -> b) -> [a] -> [b]
map (,w
w1) [a]
x [(a, w)] -> [(a, w)] -> [(a, w)]
forall a. [a] -> [a] -> [a]
++) (HeapT w f a -> f ([a], Maybe (w, HeapT w f a))
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
HeapT w m a -> m ([a], Maybe (w, HeapT w m a))
popMinT HeapT w f a
xs f ([a], Maybe (w, HeapT w f a))
-> (([a], Maybe (w, HeapT w f a)) -> f [(a, w)]) -> f [(a, w)]
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> ([a], Maybe (w, HeapT w f a)) -> f [(a, w)]
go (w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2))
{-# INLINE searchT #-}

-- | /O(n log n)/. Return all of the elements in the heap, in order, paired
-- with their weights.
search :: Monus w => Heap w a -> [(a, w)]
search :: forall w a. Monus w => Heap w a -> [(a, w)]
search = Identity [(a, w)] -> [(a, w)]
forall a. Identity a -> a
runIdentity (Identity [(a, w)] -> [(a, w)])
-> (HeapT w Identity a -> Identity [(a, w)])
-> HeapT w Identity a
-> [(a, w)]
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. HeapT w Identity a -> Identity [(a, w)]
forall (m :: Type -> Type) w a.
(Monad m, Monus w) =>
HeapT w m a -> m [(a, w)]
searchT
{-# INLINE search #-}

instance (Monoid w, m ~ Identity) => IsList (HeapT w m a) where
  type Item (HeapT w m a) = (a, w)
  fromList :: [Item (HeapT w m a)] -> HeapT w m a
fromList = [Item (HeapT w m a)] -> HeapT w m a
forall (m :: Type -> Type) a w.
Applicative m =>
[(a, w)] -> HeapT w m a
fromList
  {-# INLINE fromList #-}
  toList :: HeapT w m a -> [Item (HeapT w m a)]
toList = HeapT w m a -> [Item (HeapT w m a)]
forall w a. Monoid w => Heap w a -> [(a, w)]
flatten
  {-# INLINE toList #-}

-- | The monadic variant of 'best'.
bestT :: (Monad m, Monus w) => HeapT w m a -> m (Maybe (w, a))
bestT :: forall (m :: Type -> Type) w a.
(Monad m, Monus w) =>
HeapT w m a -> m (Maybe (w, a))
bestT = w -> HeapT w m a -> m (Maybe (w, a))
forall {m :: Type -> Type} {t} {b}.
(Monad m, Monus t) =>
t -> HeapT t m b -> m (Maybe (t, b))
go w
forall a. Monoid a => a
mempty
  where
    go :: t -> HeapT t m b -> m (Maybe (t, b))
go !t
a HeapT t m b
xs = HeapT t m b -> m ([b], Maybe (t, HeapT t m b))
forall w (m :: Type -> Type) a.
(Monus w, Monad m) =>
HeapT w m a -> m ([a], Maybe (w, HeapT w m a))
popMinT HeapT t m b
xs m ([b], Maybe (t, HeapT t m b))
-> (([b], Maybe (t, HeapT t m b)) -> m (Maybe (t, b)))
-> m (Maybe (t, b))
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (b
y:[b]
_,Maybe (t, HeapT t m b)
_) -> Maybe (t, b) -> m (Maybe (t, b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((t, b) -> Maybe (t, b)
forall a. a -> Maybe a
Just (t
a, b
y))
      ([],Maybe (t, HeapT t m b)
Nothing) -> Maybe (t, b) -> m (Maybe (t, b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (t, b)
forall a. Maybe a
Nothing
      ([],Just (t
w,HeapT t m b
zs)) -> t -> HeapT t m b -> m (Maybe (t, b))
go (t
a t -> t -> t
forall a. Semigroup a => a -> a -> a
<> t
w) HeapT t m b
zs
{-# INLINE bestT #-}

-- | /O(log n)/. Return the lowest-weight element in the heap, paired with its
-- weight.
best :: Monus w => Heap w a -> Maybe (w, a)
best :: forall w a. Monus w => Heap w a -> Maybe (w, a)
best = Identity (Maybe (w, a)) -> Maybe (w, a)
forall a. Identity a -> a
runIdentity (Identity (Maybe (w, a)) -> Maybe (w, a))
-> (HeapT w Identity a -> Identity (Maybe (w, a)))
-> HeapT w Identity a
-> Maybe (w, a)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. HeapT w Identity a -> Identity (Maybe (w, a))
forall (m :: Type -> Type) w a.
(Monad m, Monus w) =>
HeapT w m a -> m (Maybe (w, a))
bestT
{-# INLINE best #-}

heapMmap :: forall m1 m2 a1 a2 w1 w2. Functor m1 =>
            (m1 (ListCons (Node w1 a1 (HeapT w2 m2 a2)) (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))) ->
             m2 (ListCons (Node w2 a2 (HeapT w2 m2 a2)) (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))))
         -> HeapT w1 m1 a1 -> HeapT w2 m2 a2
heapMmap :: forall (m1 :: Type -> Type) (m2 :: Type -> Type) a1 a2 w1 w2.
Functor m1 =>
(m1
   (ListCons
      (Node w1 a1 (HeapT w2 m2 a2))
      (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
 -> m2
      (ListCons
         (Node w2 a2 (HeapT w2 m2 a2))
         (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))))
-> HeapT w1 m1 a1 -> HeapT w2 m2 a2
heapMmap m1
  (ListCons
     (Node w1 a1 (HeapT w2 m2 a2))
     (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
-> m2
     (ListCons
        (Node w2 a2 (HeapT w2 m2 a2))
        (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
h = ListT m2 (Node w2 a2 (HeapT w2 m2 a2)) -> HeapT w2 m2 a2
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)) -> HeapT w2 m2 a2)
-> (HeapT w1 m1 a1 -> ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))
-> HeapT w1 m1 a1
-> HeapT w2 m2 a2
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
-> ListT m2 (Node w2 a2 (HeapT w2 m2 a2))
goL (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
 -> ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))
-> (HeapT w1 m1 a1 -> ListT m1 (Node w1 a1 (HeapT w1 m1 a1)))
-> HeapT w1 m1 a1
-> ListT m2 (Node w2 a2 (HeapT w2 m2 a2))
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# HeapT w1 m1 a1 -> ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT)
  where
    goL :: ListT m1 (Node w1 a1 (HeapT w1 m1 a1)) -> ListT m2 (Node w2 a2 (HeapT w2 m2 a2))
    goL :: ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
-> ListT m2 (Node w2 a2 (HeapT w2 m2 a2))
goL = m2
  (ListCons
     (Node w2 a2 (HeapT w2 m2 a2))
     (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
-> ListT m2 (Node w2 a2 (HeapT w2 m2 a2))
forall (m :: Type -> Type) a.
m (ListCons a (ListT m a)) -> ListT m a
ListT (m2
   (ListCons
      (Node w2 a2 (HeapT w2 m2 a2))
      (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
 -> ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))
-> (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
    -> m2
         (ListCons
            (Node w2 a2 (HeapT w2 m2 a2))
            (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))))
-> ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
-> ListT m2 (Node w2 a2 (HeapT w2 m2 a2))
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. m1
  (ListCons
     (Node w1 a1 (HeapT w2 m2 a2))
     (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
-> m2
     (ListCons
        (Node w2 a2 (HeapT w2 m2 a2))
        (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
h (m1
   (ListCons
      (Node w1 a1 (HeapT w2 m2 a2))
      (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
 -> m2
      (ListCons
         (Node w2 a2 (HeapT w2 m2 a2))
         (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))))
-> (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
    -> m1
         (ListCons
            (Node w1 a1 (HeapT w2 m2 a2))
            (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))))
-> ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
-> m2
     (ListCons
        (Node w2 a2 (HeapT w2 m2 a2))
        (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ListCons
   (Node w1 a1 (HeapT w1 m1 a1))
   (ListT m1 (Node w1 a1 (HeapT w1 m1 a1)))
 -> ListCons
      (Node w1 a1 (HeapT w2 m2 a2))
      (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
-> m1
     (ListCons
        (Node w1 a1 (HeapT w1 m1 a1))
        (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))))
-> m1
     (ListCons
        (Node w1 a1 (HeapT w2 m2 a2))
        (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Node w1 a1 (HeapT w1 m1 a1) -> Node w1 a1 (HeapT w2 m2 a2))
-> (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
    -> ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))
-> ListCons
     (Node w1 a1 (HeapT w1 m1 a1))
     (ListT m1 (Node w1 a1 (HeapT w1 m1 a1)))
-> ListCons
     (Node w1 a1 (HeapT w2 m2 a2))
     (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))
forall (p :: Type -> Type -> Type) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((HeapT w1 m1 a1 -> HeapT w2 m2 a2)
-> Node w1 a1 (HeapT w1 m1 a1) -> Node w1 a1 (HeapT w2 m2 a2)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)) -> HeapT w2 m2 a2
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)) -> HeapT w2 m2 a2)
-> (HeapT w1 m1 a1 -> ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))
-> HeapT w1 m1 a1
-> HeapT w2 m2 a2
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
-> ListT m2 (Node w2 a2 (HeapT w2 m2 a2))
goL (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
 -> ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))
-> (HeapT w1 m1 a1 -> ListT m1 (Node w1 a1 (HeapT w1 m1 a1)))
-> HeapT w1 m1 a1
-> ListT m2 (Node w2 a2 (HeapT w2 m2 a2))
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# HeapT w1 m1 a1 -> ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT))) ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
-> ListT m2 (Node w2 a2 (HeapT w2 m2 a2))
goL) (m1
   (ListCons
      (Node w1 a1 (HeapT w1 m1 a1))
      (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))))
 -> m1
      (ListCons
         (Node w1 a1 (HeapT w2 m2 a2))
         (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))))
-> (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
    -> m1
         (ListCons
            (Node w1 a1 (HeapT w1 m1 a1))
            (ListT m1 (Node w1 a1 (HeapT w1 m1 a1)))))
-> ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
-> m1
     (ListCons
        (Node w1 a1 (HeapT w2 m2 a2))
        (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# ListT m1 (Node w1 a1 (HeapT w1 m1 a1))
-> m1
     (ListCons
        (Node w1 a1 (HeapT w1 m1 a1))
        (ListT m1 (Node w1 a1 (HeapT w1 m1 a1))))
forall (m :: Type -> Type) a.
ListT m a -> m (ListCons a (ListT m a))
runListT)
{-# INLINE heapMmap #-}

instance (Monad m, Monoid w) => MonadWriter w (HeapT w m) where
  writer :: forall a. (a, w) -> HeapT w m a
writer (a
x, !w
w) = ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (Node w a (HeapT w m a) -> ListT m (Node w a (HeapT w m a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (w
w w -> HeapT w m a -> Node w a (HeapT w m a)
forall w a b. w -> b -> Node w a b
:< a -> HeapT w m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
x))
  {-# INLINE writer #-}
  tell :: w -> HeapT w m ()
tell !w
w = ListT m (Node w () (HeapT w m ())) -> HeapT w m ()
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (Node w () (HeapT w m ()) -> ListT m (Node w () (HeapT w m ()))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (w
w w -> HeapT w m () -> Node w () (HeapT w m ())
forall w a b. w -> b -> Node w a b
:< () -> HeapT w m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()))
  {-# INLINE tell #-}
  listen :: forall a. HeapT w m a -> HeapT w m (a, w)
listen = w -> HeapT w m a -> HeapT w m (a, w)
forall {m :: Type -> Type} {w} {a}.
(Functor m, Semigroup w) =>
w -> HeapT w m a -> HeapT w m (a, w)
go w
forall a. Monoid a => a
mempty
    where
      go :: w -> HeapT w m a -> HeapT w m (a, w)
go !w
w = ListT m (Node w (a, w) (HeapT w m (a, w))) -> HeapT w m (a, w)
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w (a, w) (HeapT w m (a, w))) -> HeapT w m (a, w))
-> (HeapT w m a -> ListT m (Node w (a, w) (HeapT w m (a, w))))
-> HeapT w m a
-> HeapT w m (a, w)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. ((Node w a (HeapT w m a) -> Node w (a, w) (HeapT w m (a, w)))
-> ListT m (Node w a (HeapT w m a))
-> ListT m (Node w (a, w) (HeapT w m (a, w)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (w -> Node w a (HeapT w m a) -> Node w (a, w) (HeapT w m (a, w))
h w
w) (ListT m (Node w a (HeapT w m a))
 -> ListT m (Node w (a, w) (HeapT w m (a, w))))
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> ListT m (Node w (a, w) (HeapT w m (a, w)))
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT)
      h :: w -> Node w a (HeapT w m a) -> Node w (a, w) (HeapT w m (a, w))
h !w
w1 (Leaf a
x) = (a, w) -> Node w (a, w) (HeapT w m (a, w))
forall w a b. a -> Node w a b
Leaf (a
x, w
w1)
      h !w
w1 (w
w2 :< HeapT w m a
xs) = w
w2 w -> HeapT w m (a, w) -> Node w (a, w) (HeapT w m (a, w))
forall w a b. w -> b -> Node w a b
:< w -> HeapT w m a -> HeapT w m (a, w)
go (w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2) HeapT w m a
xs
  {-# INLINE listen #-}
  pass :: forall a. HeapT w m (a, w -> w) -> HeapT w m a
pass = ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w a (HeapT w m a)) -> HeapT w m a)
-> (HeapT w m (a, w -> w) -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m (a, w -> w)
-> HeapT w m a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. ((a, w) -> Node w a (HeapT w m a))
-> ListT m (a, w) -> ListT m (Node w a (HeapT w m a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
x, w
w) -> w
w w -> HeapT w m a -> Node w a (HeapT w m a)
forall w a b. w -> b -> Node w a b
:< a -> HeapT w m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a
x) (ListT m (a, w) -> ListT m (Node w a (HeapT w m a)))
-> (HeapT w m (a, w -> w) -> ListT m (a, w))
-> HeapT w m (a, w -> w)
-> ListT m (Node w a (HeapT w m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WriterT w (ListT m) a -> ListT m (a, w)
forall w (m :: Type -> Type) a. WriterT w m a -> m (a, w)
runWriterT (WriterT w (ListT m) a -> ListT m (a, w))
-> (WriterT w (ListT m) (a, w -> w) -> WriterT w (ListT m) a)
-> WriterT w (ListT m) (a, w -> w)
-> ListT m (a, w)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. WriterT w (ListT m) (a, w -> w) -> WriterT w (ListT m) a
forall w (m :: Type -> Type) a.
MonadWriter w m =>
m (a, w -> w) -> m a
pass) (WriterT w (ListT m) (a, w -> w) -> ListT m (a, w))
-> (HeapT w m (a, w -> w) -> WriterT w (ListT m) (a, w -> w))
-> HeapT w m (a, w -> w)
-> ListT m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListT m ((a, w -> w), w) -> WriterT w (ListT m) (a, w -> w)
forall w (m :: Type -> Type) a. m (a, w) -> WriterT w m a
WriterT (ListT m ((a, w -> w), w) -> WriterT w (ListT m) (a, w -> w))
-> (HeapT w m (a, w -> w) -> ListT m ((a, w -> w), w))
-> HeapT w m (a, w -> w)
-> WriterT w (ListT m) (a, w -> w)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. HeapT w m (a, w -> w) -> ListT m ((a, w -> w), w)
forall (m :: Type -> Type) w a.
(Monad m, Monoid w) =>
HeapT w m a -> ListT m (a, w)
flattenT)
  {-# INLINE pass #-}

instance MonadState s m => MonadState s (HeapT w m) where
  get :: HeapT w m s
get = m s -> HeapT w m s
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: Type -> Type). MonadState s m => m s
get
  put :: s -> HeapT w m ()
put = m () -> HeapT w m ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HeapT w m ()) -> (s -> m ()) -> s -> HeapT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: Type -> Type). MonadState s m => s -> m ()
put
  state :: forall a. (s -> (a, s)) -> HeapT w m a
state = m a -> HeapT w m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HeapT w m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> HeapT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall s (m :: Type -> Type) a.
MonadState s m =>
(s -> (a, s)) -> m a
state
  {-# INLINE get #-}
  {-# INLINE put #-}
  {-# INLINE state #-}

instance MonadError e m => MonadError e (HeapT w m) where
  throwError :: forall a. e -> HeapT w m a
throwError = m a -> HeapT w m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HeapT w m a) -> (e -> m a) -> e -> HeapT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError
  {-# INLINE throwError #-}
  catchError :: forall a. HeapT w m a -> (e -> HeapT w m a) -> HeapT w m a
catchError HeapT w m a
xs e -> HeapT w m a
h = (m (ListCons
      (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
 -> m (ListCons
         (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> HeapT w m a -> HeapT w m a
forall (m1 :: Type -> Type) (m2 :: Type -> Type) a1 a2 w1 w2.
Functor m1 =>
(m1
   (ListCons
      (Node w1 a1 (HeapT w2 m2 a2))
      (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
 -> m2
      (ListCons
         (Node w2 a2 (HeapT w2 m2 a2))
         (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))))
-> HeapT w1 m1 a1 -> HeapT w2 m2 a2
heapMmap (m (ListCons
     (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> (e
    -> m (ListCons
            (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall e (m :: Type -> Type) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ((ListT m (Node w a (HeapT w m a))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall (m :: Type -> Type) a.
ListT m a -> m (ListCons a (ListT m a))
runListT (ListT m (Node w a (HeapT w m a))
 -> m (ListCons
         (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> (HeapT w m a -> ListT m (Node w a (HeapT w m a)))
-> HeapT w m a
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT) (HeapT w m a
 -> m (ListCons
         (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> (e -> HeapT w m a)
-> e
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. e -> HeapT w m a
h)) HeapT w m a
xs
  {-# INLINE catchError #-}

instance MonadReader r m => MonadReader r (HeapT w m) where
  ask :: HeapT w m r
ask = m r -> HeapT w m r
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: Type -> Type). MonadReader r m => m r
ask
  {-# INLINE ask #-}
  reader :: forall a. (r -> a) -> HeapT w m a
reader = m a -> HeapT w m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HeapT w m a)
-> ((r -> a) -> m a) -> (r -> a) -> HeapT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
reader
  {-# INLINE reader #-}
  local :: forall a. (r -> r) -> HeapT w m a -> HeapT w m a
local = (m (ListCons
      (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
 -> m (ListCons
         (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> HeapT w m a -> HeapT w m a
forall (m1 :: Type -> Type) (m2 :: Type -> Type) a1 a2 w1 w2.
Functor m1 =>
(m1
   (ListCons
      (Node w1 a1 (HeapT w2 m2 a2))
      (ListT m2 (Node w2 a2 (HeapT w2 m2 a2))))
 -> m2
      (ListCons
         (Node w2 a2 (HeapT w2 m2 a2))
         (ListT m2 (Node w2 a2 (HeapT w2 m2 a2)))))
-> HeapT w1 m1 a1 -> HeapT w2 m2 a2
heapMmap ((m (ListCons
       (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
  -> m (ListCons
          (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
 -> HeapT w m a -> HeapT w m a)
-> ((r -> r)
    -> m (ListCons
            (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
    -> m (ListCons
            (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a)))))
-> (r -> r)
-> HeapT w m a
-> HeapT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r)
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
-> m (ListCons
        (Node w a (HeapT w m a)) (ListT m (Node w a (HeapT w m a))))
forall r (m :: Type -> Type) a.
MonadReader r m =>
(r -> r) -> m a -> m a
local
  {-# INLINE local #-}

instance MonadCont m => MonadCont (HeapT w m) where
  callCC :: forall a b. ((a -> HeapT w m b) -> HeapT w m a) -> HeapT w m a
callCC (a -> HeapT w m b) -> HeapT w m a
f = ListT m (Node w a (HeapT w m a)) -> HeapT w m a
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (((Node w a (HeapT w m a) -> ListT m (Node w b (HeapT w m b)))
 -> ListT m (Node w a (HeapT w m a)))
-> ListT m (Node w a (HeapT w m a))
forall (m :: Type -> Type) a b.
MonadCont m =>
((a -> m b) -> m a) -> m a
callCC (\Node w a (HeapT w m a) -> ListT m (Node w b (HeapT w m b))
c -> HeapT w m a -> ListT m (Node w a (HeapT w m a))
forall w (m :: Type -> Type) a.
HeapT w m a -> ListT m (Node w a (HeapT w m a))
runHeapT ((a -> HeapT w m b) -> HeapT w m a
f (ListT m (Node w b (HeapT w m b)) -> HeapT w m b
forall w (m :: Type -> Type) a.
ListT m (Node w a (HeapT w m a)) -> HeapT w m a
HeapT (ListT m (Node w b (HeapT w m b)) -> HeapT w m b)
-> (a -> ListT m (Node w b (HeapT w m b))) -> a -> HeapT w m b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Node w a (HeapT w m a) -> ListT m (Node w b (HeapT w m b))
c (Node w a (HeapT w m a) -> ListT m (Node w b (HeapT w m b)))
-> (a -> Node w a (HeapT w m a))
-> a
-> ListT m (Node w b (HeapT w m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Node w a (HeapT w m a)
forall w a b. a -> Node w a b
Leaf))))
  {-# INLINE callCC #-}