slow :)

HTWC.hs

{-# LANGUAGE BangPatterns              #-}

module Main where

import Control.Monad (when, forM_)
import Data.Char          -- toLower, isSpace
import Data.List          -- sortBy, (Foldable(foldl')), filter
import Data.Ord           -- Down
import System.IO          -- stdin, ReadMode, openFile, hClose
import System.Environment -- getArgs

-- hashtables
import Data.HashTable.IO as M

-- text
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T

frequencies :: [Text] -> IO (M.BasicHashTable Text Integer)
frequencies t = do
  ht <- M.newSized 1500000 -- cheating a bit
  forM_ t $ \w -> M.mutate ht w alter
  return ht
    where
     alter Nothing = (Just 1, ())
     alter (Just !v) = (Just (1+v), ())

main :: IO ()
main = do
  args <- getArgs
  (n,hand,filep) <- case length args of
    0 -> return (10,stdin,False)
    1 -> return (read $ head args,stdin,False)
    _ -> let (ns:fp:_) = args
         in fmap (\h -> (read ns,h,True)) (openFile fp ReadMode)
  T.hGetContents hand >>= \c -> do
    freqtable <- frequencies $ filter (not . T.null) $ T.split isSpace $ T.map toLower c
    -- for the size hint:
    -- print =<< M.foldM (\a _ -> pure $ (a+1::Int)) 0 freqtable
    freql <- M.toList freqtable
    print (take n $ sortBy (comparing (Down . snd)) freql)
  when filep (hClose hand)