{-# LANGUAGE BangPatterns, PatternSynonyms #-}
module Data.MinMaxPSQ
    ( module Data.MinMaxPSQ
    , Binding'
    , pattern Binding
    ) where

import Data.Ord
import qualified Data.Wrapper.PSQ as PSQ
         ;import Data.Wrapper.PSQ as PSQ hiding (insert, insert', null, size)
import Prelude hiding (null, take)

data MinMaxPSQ' k p v = MinMaxPSQ !Int !(PSQ' k p v) !(PSQ' k (Down p) v)
type MinMaxPSQ k p = MinMaxPSQ' k p ()

empty :: MinMaxPSQ' k p v
empty = MinMaxPSQ 0 PSQ.empty PSQ.empty

singleton' :: (PSQKey k, Ord p) => k -> v -> p -> MinMaxPSQ' k p v
singleton' k v p = MinMaxPSQ 1 (PSQ.singleton' k v p) (PSQ.singleton' k v (Down p))

null :: MinMaxPSQ' k p v -> Bool
null (MinMaxPSQ sz _ _) = sz==0
{-# INLINE null #-}

size :: MinMaxPSQ' k p v -> Int
size (MinMaxPSQ sz _ _) = sz
{-# INLINE size #-}

toList :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> [Binding' k p v]
toList (MinMaxPSQ _ nq xq) = PSQ.toList nq

fromList :: (PSQKey k, Ord p) => [Binding' k p v] -> MinMaxPSQ' k p v
fromList kps = let nq = PSQ.fromList kps
                   xq = PSQ.fromList $ map (\(Binding k v p) -> Binding k v (Down p)) kps
               in MinMaxPSQ (PSQ.size nq) nq xq

findMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v)
findMin (MinMaxPSQ _ nq xq) = PSQ.findMin nq

findMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v)
findMax (MinMaxPSQ _ nq xq) = fmap (\(Binding k v (Down p)) -> Binding k v p) $ PSQ.findMin xq

insert :: (PSQKey k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p
insert k p (MinMaxPSQ sz nq xq) = case PSQ.insertView k p () nq of
    (Just _ ,nq') -> MinMaxPSQ sz     nq' (PSQ.insert k (Down p) xq)
    (Nothing,nq') -> MinMaxPSQ (sz+1) nq' (PSQ.insert k (Down p) xq)

insert' :: (PSQKey k, Ord p) => k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
insert' k v p (MinMaxPSQ sz nq xq) = case PSQ.insertView k p v nq of
    (Just _ ,nq') -> MinMaxPSQ sz     nq' (PSQ.insert' k v (Down p) xq)
    (Nothing,nq') -> MinMaxPSQ (sz+1) nq' (PSQ.insert' k v (Down p) xq)

delete :: (PSQKey k, Ord p) => k -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
delete k q@(MinMaxPSQ sz nq xq) = case PSQ.deleteView k nq of
    Just (_,_,nq') -> MinMaxPSQ (sz - 1) nq' (PSQ.delete k xq)
    Nothing        -> q

deleteMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v
deleteMin q@(MinMaxPSQ sz nq xq) = case PSQ.minView nq of
    Just (Binding k _ _, nq') -> MinMaxPSQ (sz - 1) nq' (PSQ.delete k xq)
    Nothing                   -> q

deleteMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v
deleteMax q@(MinMaxPSQ sz nq xq) = case PSQ.minView xq of
    Just (Binding k _ _, xq') -> MinMaxPSQ (sz - 1) (PSQ.delete k nq) xq'
    Nothing                   -> q

minView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v)
minView (MinMaxPSQ sz nq xq) = fmap (\(Binding k v p, nq') -> (Binding k v p, MinMaxPSQ (sz-1) nq' (PSQ.delete k xq)))
                               $ PSQ.minView nq

maxView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v)
maxView (MinMaxPSQ sz nq xq) = fmap (\(Binding k v (Down p), xq') -> (Binding k v p, MinMaxPSQ (sz-1) (PSQ.delete k nq) xq'))
                               $ PSQ.minView xq

-- | Maintains a bounded 'MinMaxPSQ' by deleting the maximum element if the
-- insertion would cause the queue to have too many elements.
insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p
insertTake n k p q
    | size q <  n  = insert k p q
    | size q == n  = insert k p $ deleteMax q
    | otherwise    = take n $ insert k p q

-- | Maintains a bounded 'MinMaxPSQ\'' by deleting the maximum element if the
-- insertion would cause the queue to have too many elements.
insertTake' :: (PSQKey k, Ord p) => Int -> k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
insertTake' n k v p q
    | size q <  n  = insert' k v p q
    | size q == n  = insert' k v p $ deleteMax q
    | otherwise    = take n $ insert' k v p q


-- | Truncate the 'MinMaxPSQ' to the given number of lowest priority elements.
take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
take !n !q | (size q <= n) = q
           | null q        = q
           | otherwise     = take n $ deleteMax q

-- | Like 'take', except it provides a list deleted bindings.
takeView :: (PSQKey k, Ord p) => Int -> MinMaxPSQ' k p v -> ( [Binding' k p v], MinMaxPSQ' k p v )
takeView !n !q | (size q <= n) = ([], q)
               | null q        = ([], q)
               | otherwise     = let Just (x,q') = maxView q
                                     (xs,q'')    = takeView n q'
                                     ys          = x:xs
                                 in (ys, ys `seq` q'')



lookup' :: (PSQKey k, Ord p) => k -> MinMaxPSQ' k p v -> Maybe (p, v)
lookup' k (MinMaxPSQ _ q _) = PSQ.lookup k q