module DisTract.HTML.BugView
(formatBug,
formatBugId,
bugToHTML
)
where
import Text.HTML.Chunks
import DisTract.Types
import DisTract.Bug
import DisTract.Utils
import DisTract.Layout
import DisTract.HTML.Fields
import System.FilePath
import Data.List
import Data.Time
import qualified JSON as J
import qualified Data.Map as M
$(chunksFromFile "./html/templates/bugView.html")
formatBug :: Config -> Maybe Bug -> IO ()
formatBug _ Nothing = return ()
formatBug config (Just bug)
= do { htmlStr <- bugToHTML config bug
; writeFile path htmlStr
}
where
path = combine (htmlDir . baseDir $ config) filename
filename = addExtension (show . bugId $ bug) "html"
formatBugId :: Config -> BugId -> IO ()
formatBugId config bid
= loadBug config bid >>= formatBug config
bugToHTML :: Config -> Bug -> IO String
bugToHTML config (Bug bid comments fields)
= do { time <- (getZonedTime >>= formatTimeHuman)
; commentsFormatted <- formatComments filename True comments
; return $ format $ Chunk_page
{ page_title = header,
page_comments = commentsFormatted,
page_fields = "<tr>\n" ++ fieldsFormatted ++ "</tr>\n",
page_summary = "<tr>\n" ++ fieldsSummarized ++ "</tr>\n",
page_generation_time = time,
page_version = version
}
}
where
version = (packageName config) ++ " version " ++ (packageVersion config)
bidStr = show bid
header = format $ Chunk_header
{ header_bugId = bidStr,
header_base = baseDir config
}
fieldsSorted = sort . M.elems $ fields
fieldsFormattedList = map toFormInput . filter (not . isPseudoFieldValue)
$ fieldsSorted
fieldsFormatted = concat . intersperseEvery 2 "</tr><tr>\n" .
filter (not . null) $ fieldsFormattedList
fieldsSummarizedList = map toSummary fieldsSorted
fieldsSummarized = concat . intersperseEvery 2 "</tr><tr>\n" $
fieldsSummarizedList
filename = addExtension bidStr "html"
formatComments :: String -> Bool -> Comment -> IO String
formatComments filename classBool (Comment path author time text next)
= do { timeStr <- formatTimeHuman time
; nextComments'' <- mapM (formatComments filename classBool') next
; let nextComments' = concat nextComments''
; let nextComments = case nextComments' of
[] -> []
_ -> format $ Chunk_commentReplies
{ commentReplies_replies = nextComments' }
; return $ format $ Chunk_comment
{ comment_class = commentClass classBool,
comment_id = path,
comment_author = author,
comment_date = timeStr,
comment_textJson = J.stringify (J.String text),
comment_replies = nextComments,
comment_bugFile = filename
}
}
where
classBool' = not classBool
commentClass :: Bool -> String
commentClass True = "commentClassT"
commentClass _ = "commentClassF"