Haskell Quiz/Probable Iterations/Solution Dolio

module Main where
 
import Data.DList
 
import Control.Monad.Writer.Lazy
 
import System.Environment
import System.Exit
import Control.Monad
 
import Text.Printf
 
die = [1..6]
 
check :: ([Int] -> Bool) -> (Int, [Int]) -> Writer (DList String) Bool
check p (line, roll) = do tell $ if b then singleton hit else singleton noHit ; return b
 where
 b = p roll
 noHit = printf "%12d  %s" line (show roll)
 hit   = noHit ++ "  <=="
 
sample :: Int -> Int -> (Int, (Int, DList String))
sample i j = (length l, runWriter . liftM length . filterM (check p) $ zip [1..] l)
 where
 p l = length (filter (==5) l) >= j
 l = replicateM i die
 
chop :: [a] -> [a]
chop [] = []
chop (x:xs) = x : chop (drop 49999 xs)
 
main = do (v,s,i,j) <- processArgs
          let (total, (selected, out)) = sample i j
          if v
           then mapM_ putStrLn $ toList out
           else when s . mapM_ putStrLn . chop $ toList out
          putStrLn ""
          putStr "Number of desirable outcomes is "
          print selected
          putStr "Number of possible outcomes is "
          print total
          putStrLn ""
          putStr "Probability is "
          print $ fromIntegral selected / fromIntegral total
 
processArgs = do l <- getArgs
                 case l of
                      [i,j]        -> return (False, False, read i, read j)
                      ["-v", i, j] -> return (True, False, read i, read j)
                      ["-s", i, j] -> return (False, True, read i, read j)
                      _            -> do putStrLn "Unrecognized arguments."
                                         exitFailure