https://codeiq.jp/ace/yuki_hiroshi/q432 の回答。

crossing.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (readFile, readInt, split)
import Data.Vector.Unboxed.Mutable (null, read, splitAt, length, new, write, IOVector)
import qualified Data.Vector.Unboxed as VU
import System.Environment (getArgs)
import System.Posix.Time (epochTime)
import Prelude hiding (readFile, length, null, read, splitAt)

type Vec = IOVector Int

main :: IO ()
main = do
    !start   <- epochTime
    filepath <- (!! 0) <$> getArgs
    vec      <- createVector filepath
    !xcount  <- solve vec
    !end     <- epochTime
    putStrLn $ show xcount ++ "," ++ show (end - start)
    putStrLn "ENV: Haskell"

createVector :: String -> IO Vec
createVector filepath = do
    elems <- init . (split '\n') <$> readFile filepath
    VU.unsafeThaw . VU.fromList $ map toInt elems

solve :: Vec -> IO Int
solve vec = do
    (_, count) <- merge vec
    return count

merge :: Vec -> IO (Vec, Int)
merge vec
    | vlen <= 0 = return (vec, 0)
    | vlen == 1 = return (vec, 0)
    | otherwise = do
        (vec1', c1') <- merge vec1
        (vec2', c2') <- merge vec2
        (vec',  c3)  <- merge' vec1' vec2'
        return (vec', c1' + c2' + c3)
  where
    vlen = length vec
    (vec1, vec2) = splitAt (vlen `div` 2) vec

merge' :: Vec -> Vec -> IO (Vec, Int)
merge' jv kv = do
    buf <- new buflen
    go 0 0 0 0 buf
  where
    jvlen  = length jv
    kvlen  = length kv
    buflen = jvlen + kvlen
    lsize  = buflen `div` 2
    go i j k acc buf
        | i >= buflen = return (buf, acc)
        | k >= kvlen  = do v <- read jv j
                           write buf i v
                           go i' j' k acc buf
        | j >= jvlen  = do v <- read kv k
                           write buf i v
                           go i' j k' acc buf
        | otherwise   = do vj <- read jv j
                           vk <- read kv k
                           if vj <= vk
                           then do write buf i vj
                                   go i' j' k acc buf
                           else do write buf i vk
                                   go i' j k' acc' buf
      where
        i'   = i + 1
        j'   = j + 1
        k'   = k + 1
        !acc' = acc + lsize - j


toInt :: ByteString -> Int
toInt str = case readInt str of
    Just (n, _) -> n
    Nothing     -> error "Boom!!"