[refactor, stage 3: html now with detailed index
Ketil Malde **20071218145418] {
hunk ./src/Html.hs 17
+import System.IO
hunk ./src/Html.hs 23
-html :: [String] -> IO ()
-html xs = writeFile "index.html" $ renderHtml document
- where document = (header << thetitle << "Blast") +++
- (body << h1 << "Blast results" +++ map mklink xs)
- mklink x = anchor ! [href (mkdirname x)] << x +++ br
+-- manual open tags
+doctype = "\n"
+htmlheader hs = doctype ++ "" ++ renderHtmlFragment (header << thetitle << "Blast")
+ ++ "" ++ renderHtmlFragment (h1 << "Blast results") ++ "\n\n"
+ ++ renderHtmlFragment (tr << map (th <<) hs)
+
+htmlfooter = "
\n \n"
+
+-- xs = writeFile "index.html" $ renderHtmlFragment document
+-- mklink x = anchor ! [href (mkdirname x)] << x +++ br
hunk ./src/Html.hs 40
-tabulate1 :: BlastRecord -> IO Link
-tabulate1 br1 = do let nm = (head . words . toStr . query $ br1)
- genBrfile nm br1
- return nm
+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
hunk ./src/Xml2X.hs 119
- links <- mapM tabulate1 brs'
- html links
+ withFile "index.html" WriteMode $ \h -> do
+ hPutStr h (htmlheader header)
+ mapM (mkHtml h writer) brs'
+ hPutStr h htmlfooter
hunk ./src/Xml2X.hs 128
- let header = ["Query","from","to","Target","Description","from","to","bitscore","E-value","direction"]
+ let header = ["Query","from","to","Target","Description","from","to","ident","bitscore","E-value","direction"]
hunk ./src/Xml2X.hs 130
- ++ case select opts of All -> []
- _ -> ["indirect GO"]
+ ++ case select opts of All -> []
+ _ -> ["indirect GO"]
hunk ./src/Xml2X.hs 133
- wr = case select opts of All -> showAll
- Top -> showTop
- Reg -> showReg
+ wr = case format opts of Html -> showTop
+ Csv -> case select opts of All -> showAll
+ Top -> showTop
+ Reg -> showReg
hunk ./src/Xml2X.hs 145
-showAll gds pts = map (\bf -> showFlat bf ++ [showGo gds pts [subject bf]]) . flatten . return
+showAll gds pts = map show1 . flatten . return
+ where show1 bf = showFlat bf ++ if M.null gds then [] else [showGo gds pts [subject bf]]
hunk ./src/Xml2X.hs 149
-showTop gds pts = map (\(bf,go) -> showFlat bf ++ go) . select_first . flatten . return
+showTop g p = showTop' g p . flatten . return
+
+showTop' gds pts = map show1 . select_first
hunk ./src/Xml2X.hs 153
+ show1 (bf,go1,go2) = showFlat bf ++ if M.null gds then [] else [go1] ++ if M.null pts then [] else [go2]
hunk ./src/Xml2X.hs 159
- in (merge (x:bs), [showGo gds pts [subject x],showGo gds pts ysubs])
+ in (merge (x:bs), showGo gds pts [subject x],showGo gds pts ysubs)
hunk ./src/Xml2X.hs 172
-showReg gds pts = undefined -- concatMap (showTop gds pts) . select_region . flatten . return
+showReg gds pts = concatMap (showTop' gds pts) . select_region . flatten . return
}