{- 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/                                |
 |                                                                 |
 \-----------------------------------------------------------------}

module DisTract.Bug.Comment
    (loadComments,
     commentsDir,
     writeComment,
     addComment
    )
where

import DisTract.Utils
import DisTract.Types
import DisTract.Layout
import DisTract.JSONUtils
import DisTract.Monotone.Interaction
import DisTract.Monotone.Types
import qualified JSON as J
import qualified Data.Map as M
import Data.Maybe
import Data.List
import Data.Time
import System.FilePath
import System.Directory
import Control.Monad

commentsDir :: FilePath
commentsDir = "comments"

rootCommentFile :: FilePath
rootCommentFile = "root"

commentKeyInReplyTo :: String
commentKeyInReplyTo = "InReplyTo"

commentKeyComment :: String
commentKeyComment = "Comment"

loadComments :: Config -> BugId -> IO Comment
loadComments config bugId
    = do { files <- getDirectoryContents commentsPath
         ; comments <- mapM (readCommentFile commentsPath) files
         ; let commentsMaps = foldr buildCommentsMaps (M.empty, M.empty) comments
         ; authorsMap <- foldM fetchLog M.empty files
         ; return (buildComments commentsMaps authorsMap rootCommentFile)
         }
    where
      workspace = bugIdToPath config bugId
      commentsPath = combine workspace commentsDir
      fetchLog :: (M.Map FilePath LogBrief) -> FilePath ->
                  IO (M.Map FilePath LogBrief)
      fetchLog acc file
          = do { isFile <- doesFileExist fullPath
               ; if isFile
                 then do { [log] <- mtnLogBrief config workspace ["--last", "1"]
                                    . combine commentsDir $ file
                         ; return (M.insert file log acc)
                         }
                 else return acc
               }
          where
            fullPath = combine commentsPath file

buildComments :: (M.Map FilePath String, M.Map FilePath [FilePath]) ->
                 M.Map FilePath LogBrief -> FilePath -> Comment
buildComments maps@(m1, m2) m3 node = Comment node author time comment followups
    where
      author = logRevisionAuthor logBrief
      time = logRevisionTime logBrief
      (Just logBrief) = M.lookup node m3
      (Just comment) = M.lookup node m1
      followups = case M.lookup node m2 of
                    Nothing -> []
                    (Just next) -> map (buildComments maps m3) (sort next)

buildCommentsMaps :: Maybe (FilePath, FilePath, String) ->
                     (M.Map FilePath String, M.Map FilePath [FilePath]) ->
                     (M.Map FilePath String, M.Map FilePath [FilePath])
buildCommentsMaps Nothing maps = maps
buildCommentsMaps (Just (file, reply, comment)) (m1, m2) = (m1', m2')
    where
      m1' = M.insert file comment m1
      m2' = M.alter buildCommentsMaps' reply m2
      buildCommentsMaps' :: Maybe [FilePath] -> Maybe [FilePath]
      buildCommentsMaps' Nothing = Just [file]
      buildCommentsMaps' (Just rest) = Just (file:rest)

readCommentFile :: FilePath -> FilePath -> IO (Maybe (FilePath, FilePath, String))
readCommentFile path file
    = do { isFile <- doesFileExist fullPath
         ; if isFile
           then do { contents <- readFileStrict fullPath
                   ; return $ case J.parse contents of
                                (Just (J.Object obj)) ->
                                    Just (file,
                                          lookupJsonString obj commentKeyInReplyTo,
                                          lookupJsonString obj commentKeyComment
                                         )
                                _ -> Nothing
                   }
           else return Nothing
         }
    where fullPath = combine path file

writeComment :: Config -> BugId -> String -> Maybe String -> IO Comment
writeComment config@(Config{ user = user }) bid comment Nothing
    = writeComment' user commentsPath comment Nothing rootCommentFile
    where
      bugDir = bugIdToPath config bid
      commentsPath = combine bugDir commentsDir
writeComment config@(Config{ user = user }) bid comment (Just inReplyTo)
    = do { now <- getCurrentTime -- UTC
         ; let commentFileName = bugIdTimeFormatter now
         ; exists <- doesFileExist $ combine commentsPath commentFileName
         ; if exists
           then writeComment config bid comment (Just inReplyTo)
           else writeComment' user commentsPath comment (Just inReplyTo) commentFileName
         }
    where
      bugDir = bugIdToPath config bid
      commentsPath = combine bugDir commentsDir

writeComment' :: String -> FilePath -> String -> Maybe String -> FilePath -> IO Comment
writeComment' user commentsPath text inReplyTo commentId
-- Eek, the comment that's returned does not have a valid time.
-- This is because the time used is the commit time. Hmmm.
    = do { writeFileStrict (combine commentsPath commentId) jsonText
         ; now <- getCurrentTime
         ; return $ Comment commentId user now text []
         }
    where
      jsonText = (J.stringify (J.Object obj)) ++ "\n"
      obj = M.fromList ((commentKeyComment, J.String text):reply:[])
      reply = maybe (commentKeyInReplyTo, J.String "")
              ((,) commentKeyInReplyTo . J.String) inReplyTo

addComment :: Config -> Bug -> Maybe (String, String) -> IO Bug
addComment _ bug Nothing = return bug
addComment config bug@(Bug bid comments _) (Just newComment)
    = do { (comments', file) <- addComment' config bid newComment (comments, Nothing)
         ; case file of
             (Just fileName) -> mtnAdd config bugDir [combine commentsDir fileName]
                 where
                   bugDir = bugIdToPath config bid
             Nothing -> return ()
         ; return $ bug { bugComments = comments' }
         }

addComment' :: Config -> BugId -> (String, String) -> (Comment, Maybe FilePath) ->
               IO (Comment, Maybe FilePath)
addComment' _ _ _ cp@(_, Just _) = return cp
addComment' config bid newComment@(text, inReplyTo)
                (comment@(Comment path author time body comments), Nothing)
    = case inReplyTo == path of
        False -> do { (comments', filePathM) <- foldM addCommentHelper ([], Nothing) comments
                    ; return ((Comment path author time body (reverse comments')),
                              filePathM)
                    }
        True -> do { now <- getCurrentTime
                   ; let commentFileName = bugIdTimeFormatter now
                   ; exists <- doesFileExist $ combine commentsPath commentFileName
                   ; if exists
                     then addComment' config bid newComment (comment, Nothing)
                     else do { cmt <- writeComment' (user config) commentsPath
                                      text (Just inReplyTo) commentFileName
                             ; return ((Comment path author time body (comments ++ [cmt])),
                                       Just commentFileName)
                             }
                   }
    where
      bugDir = bugIdToPath config bid
      commentsPath = combine bugDir commentsDir
      addCommentHelper :: ([Comment], Maybe FilePath) -> Comment ->
                          IO ([Comment], Maybe FilePath)
      addCommentHelper (commentsAcc, filePathM) comment
          = do { (comment', filePathM') <- addComment' config bid newComment (comment, filePathM)
               ; return (comment':commentsAcc, filePathM')
               }