module Main where

import Data.Time.Clock

data Heap = Empty | Node Int Heap Heap

readSortingInput :: FilePath -> IO [Int]
readSortingInput filePath = map read . filter (not . null) . lines <$> readFile filePath

merge :: Heap -> Heap -> Heap
merge Empty heap = heap
merge heap Empty = heap
merge first@(Node firstValue firstLeft firstRight) second@(Node secondValue secondLeft secondRight)
    | firstValue >= secondValue = Node firstValue (merge firstRight second) firstLeft
    | otherwise = Node secondValue (merge secondRight first) secondLeft

insert :: Int -> Heap -> Heap
insert value heap = merge (Node value Empty Empty) heap

removeMaximum :: Heap -> Maybe (Int, Heap)
removeMaximum Empty = Nothing
removeMaximum (Node value left right) = Just (value, merge left right)

heapsort :: [Int] -> [Int]
heapsort values = reverse (drainHeap (foldr insert Empty values))
    where
        drainHeap heap = case removeMaximum heap of
            Nothing -> []
            Just (value, remaining) -> value : drainHeap remaining


main :: IO ()
main = do
     putStrLn "***HEAPSORT HASKELL***"
     putStr "READING INPUT FILE..."
     values <- readSortingInput "D:/Sorting/Sorting_Input.txt"
     putStrLn "DONE."
     putStr "SORTING ELEMENTS..."
     startTime <- getCurrentTime
     let sortedValues = heapsort values
     endTime <- getCurrentTime
     putStrLn "DONE."
     putStr "WRITING OUTPUT FILE..."
     writeFile "D:/Sorting/Output_Haskell.txt" (unlines (map show sortedValues))
     putStrLn "DONE."
     putStrLn "***RUN COMPLETE***"
     putStrLn ("HEAPSORT TOOK " ++ show (diffUTCTime endTime startTime) ++ " SECONDS.")