A. Helpers

import List
import Data.Ord (comparing)
import qualified Data.Array as Array
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Control.Arrow as Arrow

listToArray :: [a] -> Array Int a
listToArray l = Array.listArray (0, length l - 1) l

indexOf subst s = findIndex (subst `isPrefixOf`) (tails s)

groupNelem :: Int -> [a] -> [[a]]
groupNelem n = unfoldr f
    where f [] = Nothing
          f s = Just (splitAt n s)

sortByKey f = map snd . sortBy (comparing fst) . map (\x -> (f x, x))
sortByKeyRev f = map snd . sortBy (flip $ comparing fst) . map (\x -> (f x, x))

-- alike python's fileinput.input() or perl's <>
-- typical usage: getArgs >>= any_input
any_input :: [FilePath] -> IO String
any_input [] = getContents
any_input (f:_) = readFile f

-- subRegex only allow a fixed string
-- subRegexWith below takes a (String -> String) function to compute a result
subRegexWith re new s =
    case matchRegexAll re s of
      Nothing -> s
      Just (before, matched, after, _) -> before ++ new matched ++ (subRegexWith re new after)

subRegexOnceWith re new s = 
    case matchRegexAll re s of
      Nothing -> s
      Just (before, matched, after, _) -> before ++ new matched ++ after

rand :: Int -> Int -> IO Int
rand low high = getStdRandom (randomR (low, high))

dirname_basename file = (if dir == "" then "." else (reverse $ tail dir), reverse base)
    where (base, dir) = break (== '/') $ reverse file

dirname = fst . dirname_basename
basename = snd . dirname_basename


-- from http://www.cse.unsw.edu.au/~dons/code/newpopen
-- modified to handle stderr
import System.Process
import System.Exit
import System.IO

import Control.Monad
import Control.Concurrent
import qualified Control.Exception as C

readProcess :: FilePath                     -- ^ command to run
            -> [String]                     -- ^ any arguments
            -> String                       -- ^ standard input
            -> IO (Either ExitCode String)  -- ^ either the stdout, or an exitcode

readProcess cmd args input = C.handle (return . handler) $ do

    (inh,outh,errh,pid) <- runInteractiveProcess cmd args Nothing Nothing

    -- fork off a thread to start consuming the output
    output  <- hGetContents outh
    outMVar <- newEmptyMVar
    forkIO $ C.evaluate (length output) >> putMVar outMVar ()

    -- fork off a thread to start consuming the output
    errput  <- hGetContents errh
    errMVar <- newEmptyMVar
    forkIO $ C.evaluate (length errput) >> putMVar errMVar ()

    -- now write and flush any input
    when (not (null input)) $ hPutStr inh input
    hClose inh          -- done with stdin

    -- wait on the output
    takeMVar outMVar
    hClose outh

    -- wait on the errput
    takeMVar errMVar
    hClose errh

    hPutStr stderr errput

    -- wait on the process
    ex <- C.catch (waitForProcess pid) (\_ -> return ExitSuccess)

    return $ case ex of
        ExitSuccess   -> Right output
        ExitFailure _ -> Left ex

  where
    handler (C.ExitException e) = Left e
    handler e                   = Left (ExitFailure 1)