{- 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
    (makeNewBug,
     loadBug,
     updateBug
    )
where

import System.Directory
import System.FilePath
import System.IO
import DisTract.Types
import DisTract.Layout
import DisTract.Bug.Comment
import DisTract.Bug.Field
import DisTract.Bug.PseudoField
import DisTract.Monotone.Interaction
import Data.Maybe
import Data.Time
import qualified Data.Map as M
import qualified JSON as J

makeNewBug :: Config -> String -> M.Map String J.Value -> IO Bug
makeNewBug config@(Config { user = user, logger = logger }) comment fields
    = do { now <- getCurrentTime
         ; let bid = bid' now
         ; let bidStr = show bid
         ; logStr logger $ bidStr
         ; let bugPath = bugIdToPath config bid
         ; exists <- doesDirectoryExist bugPath
         ; result <- if exists
                     then makeNewBug config comment fields
                     else do { branchBase <- mtnFindCurrentBranch config bugs
                             ; let newBranch = branchBase ++ ('.':bidStr)
                             ; mtnSetupBranch config newBranch bugPath
                             ; addBugBranchFiles bugPath bid
                             ; createDirectory (combine bugPath commentsDir)
                             ; createDirectory (combine bugPath fieldsDir)
                             ; comments <- writeComment config bid comment Nothing
                             ; fieldsValidated <- writeFields config bid fields
                             ; mtnAddUnknownFiles config bugPath
                             ; hash <- mtnCommit config bugPath (summariseBug bidStr fieldsValidated) []
                             ; logStr logger $ "Committed revision " ++ (show hash)
                             ; let bug = Bug bid comments fieldsValidated
                             ; bug' <- loadPseudoFields config bug
                             ; return bug'
                             }
         ; return result
         }
    where
      bid' = flip BugId user
      summariseBug :: String -> FieldValues -> String
      summariseBug bugIdStr fields
          = unlines $ ("Creation of bug " ++ bugIdStr)
                      : (M.foldWithKey summariseField [] fields)
      summariseField :: String -> FieldValue -> [String] -> [String]
      summariseField key (FieldValue value _) acc
          = ((key ++ padding ++ value) : acc)
          where
            padding = replicate (15 - (length key)) ' '                                          

addBugBranchFiles :: FilePath -> BugId -> IO ()
addBugBranchFiles path bid
    = do { h <- openFile uidPath WriteMode
         ; hPutStrLn h $ show bid
         ; hClose h
         }
    where
      uidPath = combine path uidFile

uidFile :: FilePath
uidFile = "bugId"

loadBug :: Config -> BugId -> IO (Maybe Bug)
loadBug config bid
    = do { exists <- doesDirectoryExist bugPath
         ; if exists
           then loadBugFromFiles config bid >>= return . Just
           else do { branchBase <- mtnFindCurrentBranch config bugs
                   ; let bugBranch = branchBase ++ ('.':bidStr)
                   ; log bugBranch
                   ; branchExists <- mtnDoesBranchExist config bugBranch
                   ; if branchExists
                     then do { mtnCheckOutBranch config bugs bugBranch bidStr
                             ; loadBug config bid
                             }
                     else return Nothing
                   }
         }
    where
      bugPath = bugIdToPath config bid
      bidStr = show bid
      log = logStr . logger $ config

loadBugFromFiles :: Config -> BugId -> IO Bug
loadBugFromFiles config bid
    = do { comments <- loadComments config bid
         ; fields <- loadFields config bid
         ; let bug = Bug bid comments fields
         ; bug' <- loadPseudoFields config bug
         ; return bug'
         }

updateBug :: Config -> BugId -> Maybe (String, String) -> M.Map String J.Value ->
             IO (Maybe Bug)
updateBug config bid newComment newFields
    = do { bugM <- loadBug config bid
         ; case bugM of
             Nothing -> return Nothing
             (Just bug) -> do { bugC <- addComment config bug newComment
                              ; (bugCF, newFieldValues) <- updateFields config bugC newFields
                              ; hash <- mtnCommit config bugPath (summariseBug (show bid) newFieldValues) []
                              ; log $ "Committed revision " ++ (show hash)
                              ; return $ Just $ bugCF
                              }
         }
    where
      bugPath = bugIdToPath config bid
      log = logStr . logger $ config

      summariseBug :: String -> [FieldValue] -> String
      summariseBug bugIdStr fields
          = unlines $ ("Update to bug " ++ bugIdStr)
                      : (foldr summariseField [] fields)
      summariseField :: FieldValue -> [String] -> [String]
      summariseField (FieldValue value field) acc
          = ((key ++ padding ++ value) : acc)
          where
            padding = replicate (15 - (length key)) ' '
            key = fieldName field