module Printer (htmlify) where -- MITSFS iPhone schedule pretty-printer -- Copyright (C) 2008 Brian Sniffen -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- You should have received a copy of the GNU General Public License along -- with this program; if not, write to the Free Software Foundation, Inc., -- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. import Text.Html import Model pageHeader = header $ (thetitle . toHtml $ "MITSFS Schedule") +++ (meta ! [name "viewport", content "initial-scale = 1.0, user-scalable = no"]) htmlify :: [[Line]] -> String htmlify weeks = renderHtml $ pageHeader +++ (body $ foldr1 (+++) $ map htmlifyWeek weeks) htmlifyWeek :: [Line] -> Html htmlifyWeek (d:ts) = table $ htmlifyDate d +++ (toHtml $ weekheader </> (aboves . map htmlifyTime $ dropBlanks ts)) weekheader = besides $ map (th . toHtml) [" ", "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"] dropBlanks = takeWhile (not . isBlankTime) . dropWhile isBlankTime htmlifyDate :: Line -> Html htmlifyDate dates = caption . toHtml $ "Week of " ++ show m ++ "/" ++ show d where (m, d) = (month dates, day dates) htmlifyTime :: Line -> HtmlTable htmlifyTime t = besides $ (th . toHtml . show $ timeHeader t): map (td.htmlifySlot) (hours t) htmlifySlot :: Maybe String -> Html htmlifySlot Nothing = noHtml htmlifySlot (Just keyholder) = toHtml keyholder