{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.PQueue.Min
-- Copyright   :  (c) Louis Wasserman 2010
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- General purpose priority queue, supporting extract-minimum operations.
--
-- An amortized running time is given for each operation, with /n/ referring
-- to the length of the sequence and /k/ being the integral index used by
-- some operations.  These bounds hold even in a persistent (shared) setting.
--
-- This implementation is based on a binomial heap augmented with a global root.
-- The spine of the heap is maintained lazily.  To force the spine of the heap,
-- use 'seqSpine'.
--
-- This implementation does not guarantee stable behavior.
--
-- This implementation offers a number of methods of the form @xxxU@, where @U@ stands for
-- unordered.  No guarantees whatsoever are made on the execution or traversal order of
-- these functions.
-----------------------------------------------------------------------------
module Data.PQueue.Min (
  MinQueue,
  -- * Basic operations
  empty,
  null,
  size,
  -- * Query operations
  findMin,
  getMin,
  deleteMin,
  deleteFindMin,
  minView,
  -- * Construction operations
  singleton,
  insert,
  insertBehind,
  union,
  unions,
  -- * Subsets
  -- ** Extracting subsets
  (!!),
  take,
  drop,
  splitAt,
  -- ** Predicates
  takeWhile,
  dropWhile,
  span,
  break,
  -- * Filter/Map
  filter,
  partition,
  mapMaybe,
  mapEither,
  -- * Fold\/Functor\/Traversable variations
  map,
  foldrAsc,
  foldlAsc,
  foldrDesc,
  foldlDesc,
  -- * List operations
  toList,
  toAscList,
  toDescList,
  fromList,
  fromAscList,
  fromDescList,
  -- * Unordered operations
  mapU,
  foldrU,
  foldlU,
  elemsU,
  toListU,
  -- * Miscellaneous operations
  keysQueue,
  seqSpine) where

import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map)

import Data.Monoid (Monoid(mempty, mappend, mconcat))
import Data.Foldable (foldl, foldr, foldl')
import Data.Maybe (fromMaybe)

import qualified Data.List as List

import Data.PQueue.Internals

#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
import Text.Read (Lexeme(Ident), lexP, parens, prec,
  readPrec, readListPrec, readListPrecDefault)
#else
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build f = f (:) []
#endif

-- instance

instance (Ord a, Show a) => Show (MinQueue a) where
  showsPrec p xs = showParen (p > 10) $
    showString "fromAscList " . shows (toAscList xs)

instance Read a => Read (MinQueue a) where
#ifdef __GLASGOW_HASKELL__
  readPrec = parens $ prec 10 $ do
    Ident "fromAscList" <- lexP
    xs <- readPrec
    return (fromAscList xs)

  readListPrec = readListPrecDefault
#else
  readsPrec p = readParen (p > 10) $ \ r -> do
    ("fromAscList",s) <- lex r
    (xs,t) <- reads s
    return (fromAscList xs,t)
#endif

instance Ord a => Monoid (MinQueue a) where
  mempty = empty
  mappend = union
  mconcat = unions

-- | /O(1)/.  Returns the minimum element.  Throws an error on an empty queue.
findMin :: MinQueue a -> a
findMin = fromMaybe (error "Error: findMin called on empty queue") . getMin

-- | /O(log n)/.  Deletes the minimum element.  If the queue is empty, does nothing.
deleteMin :: Ord a => MinQueue a -> MinQueue a
deleteMin q = case minView q of
  Nothing      -> empty
  Just (_, q') -> q'

-- | /O(log n)/.  Extracts the minimum element.  Throws an error on an empty queue.
deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a)
deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView

-- | Takes the union of a list of priority queues.  Equivalent to @'foldl' 'union' 'empty'@.
unions :: Ord a => [MinQueue a] -> MinQueue a
unions = foldl union empty

-- | /O(k log n)/.  Index (subscript) operator, starting from 0.  @queue !! k@ returns the @(k+1)@th smallest
-- element in the queue.  Equivalent to @toAscList queue !! k@.
(!!) :: Ord a => MinQueue a -> Int -> a
q !! n  | n >= size q
    = error "Data.PQueue.Min.!!: index too large"
q !! n = (List.!!) (toAscList q) n

{-# INLINE takeWhile #-}
-- | 'takeWhile', applied to a predicate @p@ and a queue @queue@, returns the
-- longest prefix (possibly empty) of @queue@ of elements that satisfy @p@.
takeWhile :: Ord a => (a -> Bool) -> MinQueue a -> [a]
takeWhile p = foldWhileFB p . toAscList

{-# INLINE foldWhileFB #-}
-- | Equivalent to Data.List.takeWhile, but is a better producer.
foldWhileFB :: (a -> Bool) -> [a] -> [a]
foldWhileFB p xs0 = build (\ c nil -> let
  consWhile x xs
    | p x    = x `c` xs
    | otherwise  = nil
  in foldr consWhile nil xs0)

-- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@.
dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a
dropWhile p = drop' where
  drop' q = case minView q of
    Just (x, q') | p x -> drop' q'
    _                  -> q

-- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where
-- first element is longest prefix (possibly empty) of @queue@ of elements that
-- satisfy @p@ and second element is the remainder of the queue.
span :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
span p queue = case minView queue of
  Just (x, q')
    | p x  -> let (ys, q'') = span p q' in (x:ys, q'')
  _        -> ([], queue)

-- | 'break', applied to a predicate @p@ and a queue @queue@, returns a tuple where
-- first element is longest prefix (possibly empty) of @queue@ of elements that
-- /do not satisfy/ @p@ and second element is the remainder of the queue.
break :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
break p = span (not . p)

{-# INLINE take #-}
-- | /O(k log n)/. 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@,
-- or all elements of @queue@ itself if @k >= 'size' queue@.
take :: Ord a => Int -> MinQueue a -> [a]
take n = List.take n . toAscList

-- | /O(k log n)/.  'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,
-- or an empty queue if @k >= size 'queue'@.
drop :: Ord a => Int -> MinQueue a -> MinQueue a
drop n queue = n `seq` case minView queue of
  Just (_, queue')
    | n > 0  -> drop (n-1) queue'
  _          -> queue

-- | /O(k log n)/.  Equivalent to @('take' k queue, 'drop' k queue)@.
splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a)
splitAt n queue = n `seq` case minView queue of
  Just (x, queue')
    | n > 0  -> let (xs, queue'') = splitAt (n-1) queue' in (x:xs, queue'')
  _          -> ([], queue)

-- | /O(n)/.  Returns the queue with all elements not satisfying @p@ removed.
filter :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a
filter p = mapMaybe (\ x -> if p x then Just x else Nothing)

-- | /O(n)/.  Returns a pair where the first queue contains all elements satisfying @p@, and the second queue
-- contains all elements not satisfying @p@.
partition :: Ord a => (a -> Bool) -> MinQueue a -> (MinQueue a, MinQueue a)
partition p = mapEither (\ x -> if p x then Left x else Right x)

-- | /O(n)/.  Creates a new priority queue containing the images of the elements of this queue.
-- Equivalent to @'fromList' . 'Data.List.map' f . toList@.
map :: Ord b => (a -> b) -> MinQueue a -> MinQueue b
map f = foldrU (insert . f) empty

{-# INLINE toAscList #-}
-- | /O(n log n)/.  Extracts the elements of the priority queue in ascending order.
toAscList :: Ord a => MinQueue a -> [a]
toAscList queue = build (\ c nil -> foldrAsc c nil queue)

{-# INLINE toDescList #-}
-- | /O(n log n)/.  Extracts the elements of the priority queue in descending order.
toDescList :: Ord a => MinQueue a -> [a]
toDescList queue = build (\ c nil -> foldrDesc c nil queue)

{-# INLINE toList #-}
-- | /O(n log n)/.  Returns the elements of the priority queue in ascending order.  Equivalent to 'toAscList'.
--
-- If the order of the elements is irrelevant, consider using 'toListU'.
toList :: Ord a => MinQueue a -> [a]
toList = toAscList

{-# RULES
  "toAscList" forall q . toAscList q = build (\ c nil -> foldrAsc c nil q);
    -- inlining doesn't seem to be working out =/
  "toDescList" forall q . toDescList q = build (\ c nil -> foldrDesc c nil q);
  #-}

-- | /O(n log n)/.  Performs a right-fold on the elements of a priority queue in descending order.
-- @foldrDesc f z q == foldlAsc (flip f) z q@.
foldrDesc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrDesc = foldlAsc . flip

-- | /O(n log n)/.  Performs a left-fold on the elements of a priority queue in descending order.
-- @foldlDesc f z q == foldrAsc (flip f) z q@.
foldlDesc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b
foldlDesc = foldrAsc . flip

{-# INLINE fromList #-}
-- | /O(n)/.  Constructs a priority queue from an unordered list.
fromList :: Ord a => [a] -> MinQueue a
fromList = foldr insert empty

{-# RULES
  "fromList" fromList = foldr insert empty;
  "fromAscList" fromAscList = foldr insertMinQ empty;
  #-}

{-# INLINE fromAscList #-}
-- | /O(n)/.  Constructs a priority queue from an ascending list.  /Warning/: Does not check the precondition.
fromAscList :: [a] -> MinQueue a
fromAscList = foldr insertMinQ empty

-- | /O(n)/.  Constructs a priority queue from an descending list.  /Warning/: Does not check the precondition.
fromDescList :: [a] -> MinQueue a
fromDescList = foldl' (flip insertMinQ) empty

-- | Maps a function over the elements of the queue, ignoring order.  This function is only safe if the function is monotonic.
-- This function /does not/ check the precondition.
mapU :: (a -> b) -> MinQueue a -> MinQueue b
mapU = mapMonotonic

{-# INLINE elemsU #-}
-- | Equivalent to 'toListU'.
elemsU :: MinQueue a -> [a]
elemsU = toListU

-- | /O(n)/.  Returns the elements of the queue, in no particular order.
toListU :: MinQueue a -> [a]
toListU q = build (\ c n -> foldrU c n q)

{-# RULES
  "foldr/toListU" forall f z q . foldr f z (toListU q) = foldrU f z q;
  "foldl/toListU" forall f z q . foldl f z (toListU q) = foldlU f z q;
  #-}