[added 2html
Ketil Malde **20070822123145] {
addfile ./src/Xml2Html.hs
hunk ./src/Xml2Html.hs 1
+{- Xml2Html
+
+ Read BLAST Output in XML format, and output as a (set of?)
+ HTML files. In contrast to almost everything else out there,
+ we generate HTML tables, rather than a GIF or similar for the
+ graphical output.
+
+-}
+
+module Main where
+
+import Bio.Sequence hiding ((!))
+import Bio.Alignment.BlastData
+import Bio.Alignment.BlastXML
+
+import Text.XHtml
+import System
+
+main = getArgs >>= readXML . head >>= tabulate
+
+usage = putStrLn "usage: xml2xls blastoutput.xml" >> exitWith (ExitFailure 1)
+
+tabulate :: [BlastResult] -> IO ()
+tabulate brs = do links <- mapM tabulate1 (concatMap results brs)
+ html (hheader brs:links)
+
+html x = writeFile "index.html" ("\n"++unlines x++"\n\n")
+hheader brs = "BlastBlast result...
\n"
+
+type Link = String
+dirname = "blast/"
+-- generate a result file, and return a link to it
+tabulate1 :: BlastRecord -> IO Link
+tabulate1 br = do let name = dirname ++ toStr (query br) ++ ".html"
+ genBrfile name br
+ return name
+
+genBrfile f x = return ()
+
+record :: BlastRecord -> Html
+record br = table -- ! [ border 1 ]
+ << (tr << (th << (head $ words $ toStr $ query br) +++ th << ruler (qlength br)
+ +++ map (hit 99) (hits br)))
+ where ruler i = table ! [ border 1, cellspacing 0 ] << tr << go i
+ go i | i > 100 = td ! [ width "99" ]
+ << font ! [ size "-2" ] << "|" +++ go (i-100)
+ | otherwise = td ! [ width (show i)] << font ! [ size "-2" ] << ""
+
+-- | Format a BlastHit as a
+hit :: Int -> BlastHit -> Html
+hit len h = tr << (td << (head $ words $ toStr $ subject h) +++ line len (matches h))
+
+-- | Format a set of BlastMatches from one BlastHit
+-- Total length in pixels(?
+line :: Int -> [BlastMatch] -> Html
+line len bs = td << table ! [ cellspacing 0 ] << tr <<
+ (go 0 (map q_from bs) (map q_to bs) (map (fst . identity) bs) (map (Just . aux) bs))
+ where -- todo: sort?
+ go :: Int -> [Int] -> [Int] -> [Int] -> [Maybe Aux] -> [Html]
+ go p (f:fs) (t:ts) (i:is) (fr:frs) = mycell (f-p) 0 Nothing : mycell (t-f) i fr : go (p+t) fs ts is frs
+ go _ [] [] [] [] = []
+ mycell w col fr = td ! [width (show w), bgcolor $ makeColor col]
+ << font ! [size "-2"] << (maybe "" showFrame fr)
+ showFrame (Frame (Plus,n)) = "+"++show n
+ showFrame (Frame (Minus,n)) = "-"++show n
+ showFrame (Strands (a,b)) = if a==b then "->" else "<-"
+
+makeColor c | c == 0 = "white"
+ | c < 10 = "black"
+ | c < 30 = "green"
+ | c < 50 = "blue"
+ | c < 80 = "purple"
+ | c < 90 = "yellow"
+ | otherwise = "red"
}