{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State
import           Data.Array
import           Data.Array.Base
import           Data.Array.IO
import           Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import           Data.Char
import           Data.IORef
import           Data.List             hiding (insert)
import           Data.Maybe

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

readInt :: ByteString -> Int
readInt = fst . fromJust . BS.readInt

process:: Heap -> ByteString -> IO ()
process heap input = do
    let (cmd:args) = BS.words input
    when(cmd == "insert") $ insert heap (readInt $ head args)
    when(cmd == "extract") $ BS.putStrLn . BS.pack . show =<< deleteMax heap
    when(cmd == "end") $ return ()

main:: IO ()
main = do
  inputs <- takeWhile(/="end") . BS.lines <$> BS.getContents
  heap <- makeHeap 2000000
  mapM_ (process heap) inputs
