module XMLTools ( intoBody , intoBodyNmkCont , cat , ehs ) where import System.Time (getClockTime) import System.Directory (doesFileExist) import System.FilePath (combine) import Control.Monad.Tools (ifM) import Control.Applicative ((<$>)) import Data.List (sortBy) import Data.Function (on) import Text.RegexPR (gsubRegexPR) import System.Process (readProcess) intoBody :: String -> IO String -> IO String intoBody title getS = do src <- getS date <- getClockTime return $ "\n" ++ "\n" ++ "" ++ title ++ "\n" ++ "

" ++ title ++ "

\n" ++ "

updated at " ++ show date ++ "

\n" ++ src ++ "" intoBodyNmkCont :: Int -> String -> IO String -> IO String intoBodyNmkCont n t getS = mkContents n t >> intoBody (show n ++ ". " ++ t) getS mkContents :: Int -> String -> IO () mkContents n t = do cont <- filter ((/=n).fst) <$> read <$> ifM (doesFileExist contFile) (readFile contFile) (return "[]") putStr $ take (length cont - length cont) "dummy" writeFile contFile $ show (sortBy (on compare fst) $ (n,t):cont ) ++ "\n" where contFile = "contents" cat :: FilePath -> FilePath -> IO String cat dir file = do cont <- readFile (combine dir file) let cont_ = foldr (uncurry gsubRegexPR) cont [ (">", ">"), ("<", "<") ] file_a = "" ++ file ++ "" return $ "
> cat " ++ file_a ++ "\n\n" ++ cont_ ++ "
" ehs :: FilePath -> FilePath -> [ String ] -> String -> IO String ehs dir file args input = do ret <- readProcess "ehs" ( [ dir `combine` file ] ++ args ) input let cmd = if null input then "ehs " else "echo " ++ show input ++ " | ehs " return $ "
> " ++ cmd ++ file ++ " " ++ unwords args ++ "\n\n" ++ ret ++ "
"