
import           Control.Applicative
import           Control.Monad
import           Data.Array.Base
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString            as B
import qualified Data.ByteString.Char8      as C
import qualified Data.ByteString.Lazy.Char8 as LC
import           Data.IORef
import           Data.List                  hiding (insert)
import           Data.Maybe
import           Data.Word
import           System.IO
import           Text.Printf

data Heap = Heap Int (IORef Int) (IOUArray Int Int)

compItem :: IOUArray Int Int -> Int -> Int -> IO Ordering
-- compItem buff i j = liftM2 compare (readArray buff i) (readArray buff j)
compItem buff i j = liftM2 compare (unsafeRead buff i) (unsafeRead buff j)

swapItem :: IOUArray Int Int -> Int -> Int -> IO ()
swapItem buff i j = do
--  a <- readArray buff i
--  b <- readArray buff j
--  writeArray buff i b
--  writeArray buff j a
  a<- unsafeRead buff i
  b<- unsafeRead buff j
  unsafeWrite buff i b
  unsafeWrite buff j a

upheap :: IOUArray Int Int -> Int -> IO ()
upheap buff n = do
  when (n > 0) $ do
    let p = (n - 1) `div` 2
    t <- compItem buff p n
    when (t == LT) $ do
      swapItem buff p n
      upheap buff p

downheap :: IOUArray Int Int -> Int -> Int -> IO ()
downheap buff n h = iter n h
  where
    selectChild c1 h = do
      let c2 = c1 + 1
      if c2 > h
        then return c1
        else do
          t <- compItem buff c1 c2
          if t == LT
            then return c2
            else return c1
    iter n h = do
      let c1 = 2 * n + 1
      when (c1 <= h) $ do
        c <- selectChild c1 h
        t <- compItem buff n c
        when (t == LT) $ do
          swapItem buff n c
          iter c h

makeHeap :: Int -> IO Heap
makeHeap n = do
  a <- newArray_ (0, n - 1)
  b <- newIORef 0
  return (Heap n b a)

fromList :: [Int] -> IO Heap
fromList xs = do
  let n = length xs
      m = n `div` 2 - 1
  a <- newListArray (0, n - 1) xs
  b <- newIORef n
  mapM_ (\x -> downheap a x (n - 1)) [m, m-1 .. 0]
  return (Heap n b a)

insert :: Heap -> Int -> IO ()
insert (Heap size cnt buff) x = do
  c <- readIORef cnt
  if c >= size
    then error "Full Heap"
    else do
      -- writeArray buff c x
      unsafeWrite buff c x
      writeIORef cnt (c + 1)
      upheap buff c

deleteMax :: Heap -> IO Int
deleteMax (Heap _ cnt buff) = do
  c <- readIORef cnt
  if c <= 0
    then error "Empty Heap"
    else do
      -- x <- readArray buff 0
      x<- unsafeRead buff 0
      let c1 = c - 1
      writeIORef cnt c1
      when (c1 > 0) $ do
        swapItem buff 0 c1
        downheap buff 0 (c1 - 1)
      return x

readIntBs :: C.ByteString -> Int
readIntBs bs = case C.readInt bs of
                  Nothing     -> error "Not an integer"
                  Just (x, _) -> x

showIntBS :: Int -> C.ByteString
showIntBS = C.pack . show

loop::Heap -> IO()
loop heap = do
  cmd <- B.getLine
  if cIns `B.isPrefixOf` cmd
    then do
      insert heap (readIntBs . last . C.words $ cmd)
      loop heap
    else if cExt `B.isPrefixOf` cmd
      then do
        (C.putStrLn . showIntBS) =<< deleteMax heap
        loop heap
      else return ()
  where
    [cIns, cExt, cEnd] = map C.pack ["insert", "extract", "end"]

main = do
  heap <- makeHeap 2000000
  loop heap

