REtest.hs

{-# LANGUAGE BangPatterns#-}

-- ----------------------------------------

module Main(main)
where

import Text.Regex.XMLSchema.String
-- import Control.Monad.State.Strict hiding (when)
import Control.Arrow

import Data.List
import Data.Maybe

import System.IO			-- import the IO and commandline option stuff
import System.Environment

-- ----------------------------------------

main	:: IO ()
main
    = do
      p  <- getProgName
      al <- getArgs
      let i = if null al
	      then 4
	      else (read . head $ al)::Int
      main' p i
    where
    main' p' = fromMaybe main1 . lookup (pn p') $ mpt
    mpt = [ ("REtest",	   main1)
	  , ("Copy",       main2 "copy"     (:[]))
	  , ("Lines",      main2 "lines"    lines)
	  , ("RElines",    main2 "relines"  relines)
	  , ("SElines",    main2 "selines'" relines')
	  , ("Words",      main2 "words"    words)
	  , ("REwords",    main2 "rewords"  rewords)
	  , ("SEwords",    main2 "sewords"  rewords')
	  ]

-- ----------------------------------------

-- generate a document containing a binary tree of 2^i leafs (= 2^(i-1) XML elements)

main1	:: Int -> IO ()
main1 i
    = do
      genDoc i "REtest.hs" (fn i)
      return ()

-- ----------------------------------------

-- read a document containing a binary tree of 2^i leafs

main2	:: String -> (String -> [String]) -> Int -> IO ()
main2 ext lines' i
    = do
      hPutStrLn stderr "start processing"
      h  <- openFile (fn i) ReadMode
      c  <- hGetContents h
      let ls = lines' c
      o  <- openFile (fn i ++ "." ++ ext) WriteMode
      mapM_ (hPutStrLn o) ls
      hClose o
      hClose h
      hPutStrLn stderr "end  processing"

relines		:: String -> [String]
relines		= tokenize ".*"

relines'	:: String -> [String]
relines'	= tokenizeSubex "({line}.*)" >>> map snd

rewords		:: String -> [String]
rewords		= tokenize "\\S+"

rewords'	:: String -> [String]
rewords'	= tokenizeSubex "({word}\\S+)" >>> map snd

-- ----------------------------------------

pn	:: String -> String
pn	= reverse . takeWhile (/= '/') . reverse

fn	:: Int -> String
fn	= ("lines-" ++) . (++ ".txt") . reverse . take 4 . reverse . ((replicate 4 '0') ++ ) . show

-- ----------------------------------------

genDoc		:: Int -> String -> String -> IO ()
genDoc d inp outp
                = do
		  s <- readFile inp
		  let s' = take (2^d) . concat . repeat $ s
		  writeFile outp s'

-- ----------------------------------------