GoogleCodeJam-0.0.1: GCJ.hs

{-# LANGUAGE
ScopedTypeVariables
,Rank2Types
,GeneralizedNewtypeDeriving
 #-}
{-# OPTIONS_HADDOCK ignore-exports #-}

-- | This defines a Google Code Jam monad with a handful of combinators for simple parsing of input files.
--
-- The test cases are solved in parallel.
--
-- Although the parsing of the input cannot happen in parallel
-- (lines are consumed one by one, and input of the nexta example
-- depends on how much the current has consumed), the actual work can be
-- automatically parallelized, if the number of lines to consume does
-- not depend on the result of the main workload of each case.
--
-- This is demonstrated by the following example:
--
-- @
-- parallel test
-- mainP = mainId $ do
--        r <- return . length . show . product . enumFromTo (1::Integer) . read =<< cLine
--        if not parallel && r == 1 then return =<< cLine else return $ show r  
--        where parallel = False
-- @
--
-- input file:
--
-- @
-- 2
-- 200000
-- 200000
-- 200000
-- 200000
-- @

module GCJ (
  GCJ
  ,module Control.Applicative
  ,module Control.Monad
  )
       where

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Identity
import Control.Monad.Trans.State.Lazy
import Control.Monad.Trans.Class
import Control.Parallel.Strategies
import Data.List
import Prelude
import Safe
import System.Environment
import System.IO
import Text.Printf

-- | data type for Google Code Jam Solution Program
--
-- It has to be a Monad (e.g. to implement cBlock).
--
-- Next action has to be able to depend on state.
newtype GCJ m a = GCJ { fromGCJ :: (StateT [String] m a) }
                deriving (Functor,Applicative,Monad,MonadIO,MonadTrans)

-- * Combinators       
  
-- | consumes and returns one line
cLine :: Monad m => GCJ m String
cLine = GCJ $ do x <- get
                 put $ tail x
                 return $ headNote "GCJ: No input lines left to consume" x

-- | consumes and returns n lines
cLines :: Monad m => Int -> GCJ m [String]
cLines n = sequence $ take n $ repeat cLine

-- | consumes, transforms and returns next block:
--
-- a block consists of first line: n, then (n-m) lines
cBlock :: Monad m => Int -> ([String] -> a) -> GCJ m (Int,a)
cBlock m f = do n <-  liftM read cLine
                return . (,) n . f =<< cLines (n-m) 


-- * Runners
type Runner m = GCJ m String -> [String] -> IO ()
             
-- | produce main from pure function
mainId :: Runner Identity
mainId = mainM $ return.runIdentity

-- | produce main from with transformed IO monad
mainIO :: Runner IO
mainIO = mainM $ id
                         
-- | produce main from Monad
--
-- reads testInput or the file given on the command line
--
-- writes to standard out and to the given file with '.out' appended
mainM :: Monad m => (forall a. (m a -> IO a))
         -> Runner m
mainM exec (GCJ gen) args = do
  let cc []     = return ("test", return (), putStr)
      cc (a:[]) = do h <- openFile (a++".out") WriteMode 
                     return (a, hClose h, \x -> putStr x >> hPutStr h x) 
  (inF,close,myP) <- cc args
  printf "Reading file: %s\n" inF
  (head:tail) <- lines <$> readFile inF
  let ncase = read head
  printf "Found %d cases\n" ncase
  (work,rest) <- (exec $ runStateT (replicateM ncase gen) tail)
  zipWithM_ ((myP.).printf "Case #%u: %s") [(1::Int)..] $
    parMap rdeepseq (\y -> y ++ if "\n" `isSuffixOf` y then "" else "\n") work
  close >> when (length rest > 0) 
    (error $ "GCJ: not all input lines have been consumed:\n" ++ unlines rest)