import Data.List
import Data.Maybe
import Data.Char
import Data.Tree
import Control.Monad
import System.FilePath
import System.Environment
import Text.HTML.TreeMap
import System.Console.GetOpt
import Text.XML.Light
data Flag = Verbose
| MaxName String
| Output String deriving Show
options :: [OptDescr Flag]
options =
[ Option ['v'] ["verbose"] (NoArg Verbose) "verbose output on stderr"
, Option ['n'] ["name"] (ReqArg (MaxName) "Integer") "maximum size of filename. than truncation."
, Option ['o'] ["output"] (ReqArg (Output) "FILE") "output FILE"
]
checkOpts :: [String] -> IO ([Flag], [String])
checkOpts argv =
case getOpt Permute options argv of
(o,[],[] ) -> ioError (userError (usageInfo header options))
(o,n,[] ) -> return (o,n)
(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
where header = "Usage: xml2treemap [OPTION...] <input file.xml>"
filename :: [Flag] -> FilePath
filename [] = "xmlmap.html"
filename ((Output d):_) = d
filename (_:xs) = filename xs
main = do
args <- getArgs
(flags,names) <- checkOpts args
print flags
print names
input <- readFile (head names)
let xmlTree = xml2tree (head names) (parseXML input)
putStrLn $ drawTree $ xmlTree
writeFile (filename flags) (treeMap xmlTree)
putStrLn $ "Written: "++(filename flags)
xml2tree :: String -> [Content] -> Tree String
xml2tree name xs = Node name (map cont2tree (filterBlanks xs))
where
cont2tree :: Content -> Tree String
cont2tree (Elem e) = Node (showElement' e) (map cont2tree (filterBlanks $ elContent e))
cont2tree (Text t) = Node (cdData t) []
cont2tree (CRef c) = Node c []
showElement' (Element n a _ _) = showElement (Element n a [] Nothing)
filterBlanks :: [Content] -> [Content]
filterBlanks xs = filter (not . isBlank) xs
where
isBlank (Text t) = all (isSpace) (cdData t)
isBlank _ = False