{-# LANGUAGE PatternSignatures #-}

module Main (main) where

import Control.Parallel (par, pseq)
import Control.Parallel.Strategies (NFData(..))
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import System.Environment (getArgs)
import System.Random (getStdGen, randoms)

sort :: (Ord a) => [a] -> [a]

sort (x:xs) = lesser ++ x:greater
    where lesser  = sort [y | y <- xs, y <  x]
          greater = sort [y | y <- xs, y >= x]
sort _ = []

parSort :: (NFData a, Ord a) => Int -> [a] -> [a]
parSort d list@(x:xs)
  | d <= 0     = sort list
  | otherwise = rnf lesser `par` (rnf greater `pseq`
                lesser ++ x:greater)
      where lesser      = parSort d' [y | y <- xs, y <  x]
            greater     = parSort d' [y | y <- xs, y >= x]
            d' = d - 1
parSort _ _              = []

main = do
  args <- getArgs
  let count | null args = 8192
            | otherwise = read (head args)
  input :: [Int] <- (take count . randoms) `fmap` getStdGen

  putStrLn $ "We have " ++ show (length input) ++ " elements to sort."
  start <- getCurrentTime
  let sorted = parSort 2 input
  putStrLn $ "Sorted all " ++ show (length sorted) ++ " elements."
  end <- getCurrentTime
  putStrLn $ show (end `diffUTCTime` start) ++ " elapsed."