Parallel computation of numbers with no repeated digits in Haskell

rep.hs

{-
 - Count how many numbers with no repeated digits lie between 1 and the
 - specified maximum (given as a command line argument)
 -
 - For instance 183957 is counted, while 298387 is not ('8' occurs twice).
 -
 - On SMP systems, parallelism is exploited to speed up the computation
 - significantly. The search space is divided into as many evenly-sized chunks
 - as the host system has cores, and worker threads are spawned to run on each
 - core. This small program is primarily intended to illustrate the usage of
 - Haskell's lightweight green threads and the threaded runtime to easily
 - parallelize long-running computations.
 -
 - Compile with:
 -
 -     $ ghc -threaded -with-rtsopts=-N -Wall -fno-warn-missing-signatures -O3 rep
 -
 - Run with:
 -
 -     $ ./rep 100000000
 -
 - By default, all available cores will be used for maximum efficiency. To
 - reduce the thread count in order to see the effects of reduced parallelism,
 - add `-rtsopts` to the compilation command line and run with:
 -
 -     $ ./rep 100000000 +RTS -N1
 -
 - where 1, in this example, is the number of threads that will be used.
 -}

import Control.Arrow
import Control.Concurrent
import Control.Monad

import Data.Function
import Data.List
import Data.Maybe

import System.Environment

ct :: Int -> Int -> Int -> Int
ct off step mx =
    foldl'
        (flip $ \x ->
            if (show >>> id &&& nub >>> uncurry ((==) `on` length)) x
                then (+1)
                else id)
        0
        [off, off + step .. mx]

parCt' :: Int -> IO Int
parCt' n = do
    cores <- getNumCapabilities
    ms <- forM [1..cores] $ \offset -> do
        m <- newEmptyMVar
        _ <- forkIO $ putMVar m $! ct offset cores n
        return m
    putStrLn $ "Awaiting "
            ++ show cores
            ++ " worker"
            ++ (if cores > 1 then "s" else "")
            ++ "..."
    let await prevs = do
            rs <- mapM tryTakeMVar ms
            sequence_ $
                zipWith
                    ($)
                    (fmap
                        (\t r -> when (isJust r) $ putStrLn $ "Worker #"
                                                           ++ show t
                                                           ++ " finished: "
                                                           ++ show (fromJust r))
                        [1..cores])
                    rs
            let curs = prevs ++ catMaybes rs
            (if length curs == cores then return else await) curs
    rs <- await []
    return $ sum rs

main = getArgs >>= parCt' . read . head >>= print