|
Packit |
5b08af |
{-# LANGUAGE BangPatterns#-}
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
module Main(main)
|
|
Packit |
5b08af |
where
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
import Text.XML.HXT.Core
|
|
Packit |
5b08af |
import Text.Regex.XMLSchema.Generic
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
import Data.String.Unicode
|
|
Packit |
5b08af |
( unicodeToXmlEntity
|
|
Packit |
5b08af |
)
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
import Control.Monad.State.Strict hiding (when)
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
import Data.Maybe
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
import System.IO -- import the IO and commandline option stuff
|
|
Packit |
5b08af |
import System.Environment
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
main :: IO ()
|
|
Packit |
5b08af |
main
|
|
Packit |
5b08af |
= do
|
|
Packit |
5b08af |
p <- getProgName
|
|
Packit |
5b08af |
al <- getArgs
|
|
Packit |
5b08af |
let i = if null al
|
|
Packit |
5b08af |
then 4
|
|
Packit |
5b08af |
else (read . head $ al)::Int
|
|
Packit |
5b08af |
main' p i
|
|
Packit |
5b08af |
where
|
|
Packit |
5b08af |
main' p' = fromMaybe main1 . lookup (pn p') $ mpt
|
|
Packit |
5b08af |
mpt = [ ("REtest", main1)
|
|
Packit |
5b08af |
, ("Copy", main2 "copy" (:[]))
|
|
Packit |
5b08af |
, ("Lines", main2 "lines" lines)
|
|
Packit |
5b08af |
, ("RElines", main2 "relines" relines)
|
|
Packit |
5b08af |
, ("Words", main2 "words" words)
|
|
Packit |
5b08af |
, ("REwords", main2 "rewords" rewords)
|
|
Packit |
5b08af |
]
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- generate a document containing a binary tree of 2^i leafs (= 2^(i-1) XML elements)
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
main1 :: Int -> IO ()
|
|
Packit |
5b08af |
main1 i
|
|
Packit |
5b08af |
= runX (genDoc i (fn i))
|
|
Packit |
5b08af |
>> return ()
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- read a document containing a binary tree of 2^i leafs
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
main2 :: String -> (String -> [String]) -> Int -> IO ()
|
|
Packit |
5b08af |
main2 ext lines' i
|
|
Packit |
5b08af |
= do
|
|
Packit |
5b08af |
hPutStrLn stderr "start processing"
|
|
Packit |
5b08af |
h <- openBinaryFile (fn i) ReadMode
|
|
Packit |
5b08af |
c <- hGetContents h
|
|
Packit |
5b08af |
let ls = lines' c
|
|
Packit |
5b08af |
o <- openBinaryFile (fn i ++ "." ++ ext) WriteMode
|
|
Packit |
5b08af |
mapM_ (hPutStrLn o) ls
|
|
Packit |
5b08af |
hClose o
|
|
Packit |
5b08af |
hClose h
|
|
Packit |
5b08af |
hPutStrLn stderr "end processing"
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
relines :: String -> [String]
|
|
Packit |
5b08af |
relines = tokenize "[^\n\r]*"
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
rewords :: String -> [String]
|
|
Packit |
5b08af |
rewords = tokenize "[^ \t\n\r]+"
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
pn :: String -> String
|
|
Packit |
5b08af |
pn = reverse . takeWhile (/= '/') . reverse
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
fn :: Int -> String
|
|
Packit |
5b08af |
fn = ("tree-" ++) . (++ ".xml") . reverse . take 4 . reverse . ((replicate 4 '0') ++ ) . show
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
genDoc :: Int -> String -> IOSArrow b XmlTree
|
|
Packit |
5b08af |
genDoc d out = constA (mkBTree d)
|
|
Packit |
5b08af |
>>>
|
|
Packit |
5b08af |
xpickleVal xpickle
|
|
Packit |
5b08af |
>>>
|
|
Packit |
5b08af |
indentDoc
|
|
Packit |
5b08af |
>>>
|
|
Packit |
5b08af |
putDoc out
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
type Counter a = State Int a
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
incr :: Counter Int
|
|
Packit |
5b08af |
incr = do
|
|
Packit |
5b08af |
modify (+1)
|
|
Packit |
5b08af |
get
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
data BTree = Leaf Int
|
|
Packit |
5b08af |
| Fork BTree BTree
|
|
Packit |
5b08af |
deriving (Show)
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
instance XmlPickler BTree where
|
|
Packit |
5b08af |
xpickle = xpAlt tag ps
|
|
Packit |
5b08af |
where
|
|
Packit |
5b08af |
tag (Leaf _ ) = 0
|
|
Packit |
5b08af |
tag (Fork _ _ ) = 1
|
|
Packit |
5b08af |
ps = [ xpWrap ( Leaf, \ (Leaf i) -> i)
|
|
Packit |
5b08af |
( xpElem "leaf" $ xpAttr "value" $ xpickle )
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
, xpWrap ( uncurry Fork, \ (Fork l r) -> (l, r))
|
|
Packit |
5b08af |
( xpElem "fork" $ xpPair xpickle xpickle )
|
|
Packit |
5b08af |
]
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
mkBTree :: Int -> BTree
|
|
Packit |
5b08af |
mkBTree depth = evalState (mkT depth) 0
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
mkT :: Int -> Counter BTree
|
|
Packit |
5b08af |
mkT 0 = do
|
|
Packit |
5b08af |
i <- incr
|
|
Packit |
5b08af |
return (Leaf i)
|
|
Packit |
5b08af |
mkT n = do
|
|
Packit |
5b08af |
l <- mkT (n-1)
|
|
Packit |
5b08af |
r <- mkT (n-1)
|
|
Packit |
5b08af |
return (Fork l r)
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- output is done with low level ops to write the
|
|
Packit |
5b08af |
-- document i a lazy manner
|
|
Packit |
5b08af |
-- adding an xml pi and encoding is done "by hand"
|
|
Packit |
5b08af |
-- latin1 decoding is the identity, so please generate the
|
|
Packit |
5b08af |
-- docs with latin1 encoding. Here ist done even with ASCCI
|
|
Packit |
5b08af |
-- every none ASCII char is represented by a char ref (&nn;;)
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
putDoc :: String -> IOStateArrow s XmlTree XmlTree
|
|
Packit |
5b08af |
putDoc dst
|
|
Packit |
5b08af |
= addXmlPi
|
|
Packit |
5b08af |
>>>
|
|
Packit |
5b08af |
addXmlPiEncoding isoLatin1
|
|
Packit |
5b08af |
>>>
|
|
Packit |
5b08af |
xshow getChildren
|
|
Packit |
5b08af |
>>>
|
|
Packit |
5b08af |
arr unicodeToXmlEntity
|
|
Packit |
5b08af |
>>>
|
|
Packit |
5b08af |
arrIO (\ s -> hPutDocument (\h -> hPutStrLn h s))
|
|
Packit |
5b08af |
>>>
|
|
Packit |
5b08af |
none
|
|
Packit |
5b08af |
where
|
|
Packit |
5b08af |
isStdout = null dst || dst == "-"
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
hPutDocument :: (Handle -> IO()) -> IO()
|
|
Packit |
5b08af |
hPutDocument action
|
|
Packit |
5b08af |
| isStdout
|
|
Packit |
5b08af |
= action stdout
|
|
Packit |
5b08af |
| otherwise
|
|
Packit |
5b08af |
= do
|
|
Packit |
5b08af |
handle <- openBinaryFile dst WriteMode
|
|
Packit |
5b08af |
action handle
|
|
Packit |
5b08af |
hClose handle
|
|
Packit |
5b08af |
|
|
Packit |
5b08af |
-- ----------------------------------------
|