{- 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 Html where
import Tabulate
import Bio.Alignment.BlastData
import Data.ByteString.Lazy.Char8 (unpack,ByteString)
import Text.XHtml
import System.Directory
import System.IO
import Text.Printf
import Debug.Trace (trace)
import Options (htmldir)
instance HTML ByteString where
toHtml = toHtml . unpack
makeDirectory :: FilePath -> IO ()
makeDirectory f = do
createDirectory f `catch` (\e -> fail ("Couldn't create directory: '" ++ f++ "'\n"++show e))
doctype, htmlfooter, default_bg :: String
-- manual open tags
doctype = "\n"
htmlheader :: BlastResult -> [String] -> String
htmlheader b hs = doctype ++ "" ++ renderHtmlFragment (header << thetitle << "Blast")
++ "" ++ renderHtmlFragment pagehdr ++ "\n\n"
++ renderHtmlFragment (tr << map (th <<) hs)
where pagehdr = (h1 << "Blast results")
+++ p ((toHtml ("Program: "++unpack (blastversion b)))
+++ br +++ toHtml ("Database: "++ unpack (database b)))
htmlfooter = "
\n \n"
-- xs = writeFile "index.html" $ renderHtmlFragment document
-- mklink x = anchor ! [href (mkdirname x)] << x +++ br
mkdirname :: FilePath -> FilePath
mkdirname x = htmldir++"/"++x++".html"
type Link = String
-- | Generate two results:
-- 1. a new file displaying the aligned matches (via genBrfile)
-- 2. a row in the index file, with a link to the former (using writeRow)
mkHtml :: Handle -> (BlastRecord -> [[String]]) -> BlastRecord -> IO ()
mkHtml h writer br1 =
do let ls@((q:_):_) = writer br1
writeRow (x:xs) = hPutStr h $ renderHtmlFragment (tr << (td << mklink x : (map (td <<) xs)))
mklink x = anchor ! [href (mkdirname x)] << x
mapM writeRow ls
genBrfile q br1
genBrfile :: FilePath -> BlastRecord -> IO ()
genBrfile fn x = writeFile (mkdirname fn) $ renderHtml $ record $ tabulate x
record :: Table -> Html
record (t,w,rs) = table -- ! [ border 1 ]
<< (tr << (th << t +++ th << ruler w
+++ map hit rs))
where ruler i = table ! [ border 1, cellspacing 0, width (show i) ] << tr << go i
go i | i > 100 = td ! [ width "100" , small_font ]
<< "|" +++ go (i-100)
| otherwise = td ! [ width (show i), small_font ] << ""
small_font :: HtmlAttr
small_font = thestyle "font-size:50%"
default_bg = "#d0e0ff"
-- | Format a BlastHit as a
hit :: Row -> Html
hit (h_name,ms) = tr ! [bgcolor default_bg] <<
(td << anchor ! [ href (unpack h_name++".html") {-, title (unwords "h_desc") -} ] << h_name
+++ td << (line ms))
-- | Format a set of BlastMatches from one BlastHit
-- Total length in pixels(?
line :: [Cell] -> Html
line bs = table ! [ cellspacing 0 ] << tr << map mycell bs +++ mycomment
where
mycomment = comment $ show bs
-- $ map (\b -> let (f,t) = (q_from b,q_to b)
-- in (f,t,bits b/fromIntegral (t-f),aux b)) $ bs
mycell (Cell w c fr) = td ! [width (show w), bgcolor (makeColor c), small_font]
<< (maybe "" showFrame fr)
showFrame (Frame Plus n) = "+"++show n
showFrame (Frame Minus n) = "-"++show n
showFrame (Strands a b) = if a==b then "->" else "<-"
-- blastn and tblastn report bits > 2/position
-- Currently we just report it and truncate to 2 (i.e. 100%).
makeColor :: Int -> String
makeColor c | c == 0 = default_bg
| c > 100 = trace (" - makeColor: value >100 ("++show c++") - truncating!")
$ makeColor 100
| otherwise = printf "#%2x8080" ((0x80::Int)+0x79*c`div`100)
comment :: String -> Html
comment xs = primHtml $ ""