primes.hs

import Control.Concurrent.Async
import Data.Foldable
import Control.Exception
import Control.DeepSeq

numThreads = 4
maxChunkSize = 1024000

isPrime :: [Int] -> Int -> Bool
isPrime primes x    = all ((/=0) . (mod x)) $ takeWhile ((<=x) . (^2)) primes

nextPrimeChunk :: [Int] -> IO [Int]
nextPrimeChunk primes = (fmap concat) $ mapConcurrently evalPrimes lists
    where
        lastPrime   = last primes
        start       = lastPrime + 1
        end         = min (lastPrime * lastPrime) (start + numThreads * maxChunkSize)
        chunkLen    = end - start
        threadLen   = div chunkLen numThreads
        lists       = [[j + start + (i * threadLen) | j <- [1,3..threadLen]] | i <- [0..numThreads - 1]]
        evalPrimes  = evaluate . force . filter (isPrime primes)

getNthPrime :: Int -> [Int] -> IO Int
getNthPrime n lastBatch = do
    curr            <- nextPrimeChunk lastBatch
    total           <- return $ lastBatch ++ curr
    totalLen        <- return $ length total

    if totalLen >= n
        then return $ total !! n
        else getNthPrime n total

basicIsPrime        = (isPrime (2 : [3,5..]))
startPrimes = 2 : filter basicIsPrime [3,5..100]

main = do
    result <- getNthPrime 1000000 startPrimes
    putStrLn $ show result