{- DisTract ------------------------------------------------------\
 |                                                                 |
 | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |
 |                                                                 |
 | DisTract is freely distributable under the terms of a 3-Clause  |
 | BSD-style license. For details, see the DisTract web site:      |
 |   http://distract.wellquite.org/                                |
 |                                                                 |
 \-----------------------------------------------------------------}

{-# LANGUAGE TemplateHaskell #-}

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"