--  Copyright (C) 2004,2007 David Roundy
--
--  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, 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; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

-- |
-- Copyright   : 2004, 2007 David Roundy
-- License     : GPL
-- Maintainer  : darcs-devel@darcs.net
-- Stability   : experimental
-- Portability : portable

module Darcs.UI.Commands.Amend
    (
      amend
    , amendrecord
    ) where

import Prelude ()
import Darcs.Prelude

import Data.Maybe ( isNothing, isJust )
import Control.Monad ( when )

import Darcs.UI.Commands
    ( DarcsCommand(..), withStdOpts
    , commandAlias
    , nodefaults
    , setEnvDarcsFiles
    , setEnvDarcsPatches
    , amInHashedRepository
    )
import Darcs.UI.Commands.Util ( announceFiles, testTentativeAndMaybeExit )
import Darcs.UI.Completion ( modifiedFileArgs, knownFileArgs )
import Darcs.UI.Flags ( DarcsFlag, diffOpts, fixSubPaths )
import Darcs.UI.Options ( DarcsOption, (^), oparse, odesc, ocheck, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.PatchHeader ( updatePatchHeader, AskAboutDeps(..)
                            , HijackOptions(..)
                            , runHijackT )
import Darcs.Repository.Flags ( UpdateWorking(..), DryRun(NoDryRun) )
import Darcs.Patch ( IsRepoType, RepoPatch, description, PrimOf
                   , effect, invert, invertFL
                   )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Info ( isTag )
import Darcs.Patch.Split ( primSplitter )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, patchDesc )
import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..) )
import Darcs.Patch.Rebase.Name ( RebaseName(..) )
import Darcs.Util.Path ( toFilePath, SubPath(), AbsolutePath )
import Darcs.Repository
    ( Repository
    , withRepoLock
    , RepoJob(..)
    , RebaseJobFlags(..)
    , tentativelyRemovePatches
    , tentativelyAddPatch
    , withManualRebaseUpdate
    , finalizeRepositoryChanges
    , invalidateIndex
    , unrecordedChanges
    , readRecorded
    )
import Darcs.Repository.Prefs ( globalPrefsDirDoc )
import Darcs.UI.SelectChanges
    ( WhichChanges(..)
    , selectionContextPrim
    , runSelection
    , withSelectedPatchFromRepo
    )
import qualified Darcs.UI.SelectChanges as S
    ( PatchSelectionOptions(..)
    )
import Darcs.Util.Exception ( clarifyErrors )
import Darcs.Patch.Witnesses.Ordered
    ( FL(..), (:>)(..), (+>+), nullFL, reverseRL, mapFL_FL )

import Darcs.Util.Printer ( putDocLn )
import Darcs.Util.Tree( Tree )
import Darcs.Repository.Pending ( tentativelyRemoveFromPending )


amendDescription :: String
amendDescription = "Improve a patch before it leaves your repository."


amendHelp :: String
amendHelp =
    "Amend updates a \"draft\" patch with additions or improvements,\n" ++
    "resulting in a single \"finished\" patch.\n" ++
    "\n" ++
    "By default `amend` proposes you to record additional changes.\n" ++
    "If instead you want to remove changes, use the flag `--unrecord`.\n" ++
    "\n" ++
    "When recording a draft patch, it is a good idea to start the name with\n" ++
    "`DRAFT:`. When done, remove it with `darcs amend --edit-long-comment`.\n" ++
    "Alternatively, to change the patch name without starting an editor, \n" ++
    "use the `--name`/`-m` flag:\n" ++
    "\n" ++
    "    darcs amend --match 'name \"DRAFT: foo\"' --name 'foo2'\n" ++
    "\n" ++
    "Like `darcs record`, if you call amend with files as arguments,\n" ++
    "you will only be asked about changes to those files.  So to amend a\n" ++
    "patch to foo.c with improvements in bar.c, you would run:\n" ++
    "\n" ++
    "    darcs amend --match 'touch foo.c' bar.c\n" ++
    "\n" ++
    "It is usually a bad idea to amend another developer's patch.  To make\n" ++
    "amend only ask about your own patches by default, you can add\n" ++
    "something like `amend match David Roundy` to `" ++ globalPrefsDirDoc ++
    "defaults`, \n" ++
    "where `David Roundy` is your name.\n"

amendBasicOpts :: DarcsOption a
                  (Bool
                   -> [O.MatchFlag]
                   -> O.TestChanges
                   -> Maybe Bool
                   -> Maybe String
                   -> Bool
                   -> Maybe String
                   -> Bool
                   -> Maybe O.AskLongComment
                   -> Bool
                   -> O.LookFor
                   -> Maybe String
                   -> O.WithContext
                   -> O.DiffAlgorithm
                   -> a)
amendBasicOpts
    = O.amendUnrecord
    ^ O.matchOneNontag
    ^ O.testChanges
    ^ O.interactive --True
    ^ O.author
    ^ O.selectAuthor
    ^ O.patchname
    ^ O.askDeps
    ^ O.askLongComment
    ^ O.keepDate
    ^ O.lookfor
    ^ O.repoDir
    ^ O.withContext
    ^ O.diffAlgorithm

amendAdvancedOpts :: DarcsOption a
                     (O.Compression
                      -> O.UseIndex
                      -> O.UMask
                      -> O.SetScriptsExecutable
                      -> a)
amendAdvancedOpts = O.compress ^ O.useIndex ^ O.umask ^ O.setScriptsExecutable

amendOpts :: DarcsOption a
             (Bool
              -> [O.MatchFlag]
              -> O.TestChanges
              -> Maybe Bool
              -> Maybe String
              -> Bool
              -> Maybe String
              -> Bool
              -> Maybe O.AskLongComment
              -> Bool
              -> O.LookFor
              -> Maybe String
              -> O.WithContext
              -> O.DiffAlgorithm
              -> Maybe O.StdCmdAction
              -> Bool
              -> Bool
              -> O.Verbosity
              -> Bool
              -> O.Compression
              -> O.UseIndex
              -> O.UMask
              -> O.SetScriptsExecutable
              -> O.UseCache
              -> O.HooksConfig
              -> a)
amendOpts = withStdOpts amendBasicOpts amendAdvancedOpts

data AmendConfig = AmendConfig
    { amendUnrecord :: Bool
    , matchFlags :: [O.MatchFlag]
    , testChanges :: O.TestChanges
    , interactive :: Maybe Bool
    , author :: Maybe String
    , selectAuthor :: Bool
    , patchname :: Maybe String
    , askDeps :: Bool
    , askLongComment :: Maybe O.AskLongComment
    , keepDate :: Bool
    , lookfor :: O.LookFor
    , _workingRepoDir :: Maybe String
    , withContext :: O.WithContext
    , diffAlgorithm :: O.DiffAlgorithm
    , verbosity :: O.Verbosity
    , compress :: O.Compression
    , useIndex :: O.UseIndex
    , umask :: O.UMask
    , sse :: O.SetScriptsExecutable
    , useCache :: O.UseCache
    }

amendConfig :: [DarcsFlag] -> AmendConfig
amendConfig =
  oparse (amendBasicOpts ^ O.verbosity ^ amendAdvancedOpts ^ O.useCache) AmendConfig

amend :: DarcsCommand AmendConfig
amend = DarcsCommand
    {
      commandProgramName          = "darcs"
    , commandName                 = "amend"
    , commandHelp                 = amendHelp
    , commandDescription          = amendDescription
    , commandExtraArgs            = -1
    , commandExtraArgHelp         = ["[FILE or DIRECTORY]..."]
    , commandCommand              = amendCmd
    , commandPrereq               = amInHashedRepository
    , commandCompleteArgs         = amendFileArgs
    , commandArgdefaults          = nodefaults
    , commandAdvancedOptions      = odesc amendAdvancedOpts
    , commandBasicOptions         = odesc amendBasicOpts
    , commandDefaults             = defaultFlags amendOpts
    , commandCheckOptions         = ocheck amendOpts
    , commandParseOptions         = amendConfig
    }
  where
    amendFileArgs fps flags args =
      if (O.amendUnrecord ? flags)
        then knownFileArgs fps flags args
        else modifiedFileArgs fps flags args

amendrecord :: DarcsCommand AmendConfig
amendrecord = commandAlias "amend-record" Nothing amend

amendCmd :: (AbsolutePath, AbsolutePath)
         -> AmendConfig
         -> [String]
         -> IO ()
amendCmd _   cfg [] = doAmend cfg Nothing
amendCmd fps cfg args = do
    files <- fixSubPaths fps args
    if null files
      then fail "No valid arguments were given, nothing to do."
      else doAmend cfg $ Just files

doAmend :: AmendConfig -> Maybe [SubPath] -> IO ()
doAmend cfg files =
    let rebaseJobFlags = RebaseJobFlags (compress cfg) (verbosity cfg) YesUpdateWorking in
    withRepoLock NoDryRun (useCache cfg) YesUpdateWorking (umask cfg) $
      RebaseAwareJob rebaseJobFlags $ \(repository :: Repository rt p wR wU wR) ->
    withSelectedPatchFromRepo "amend" repository (patchSelOpts cfg) $ \ (_ :> oldp) -> do
        announceFiles (verbosity cfg) files "Amending changes in"
            -- auxiliary function needed because the witness types differ for the isTag case
        pristine <- readRecorded repository
        let go :: forall wU1 . FL (PrimOf p) wR wU1 -> IO ()
            go NilFL | not (hasEditMetadata cfg) = putStrLn "No changes!"
            go ch =
              do let context = selectionContextPrim First "record"
                                      (patchSelOpts cfg)
                                      --([All,Unified] `intersect` opts)
                                      (Just (primSplitter (diffAlgorithm cfg)))
                                      (map toFilePath <$> files)
                                      (Just pristine)
                 (chosenPatches :> _) <- runSelection ch context
                 addChangesToPatch cfg repository oldp chosenPatches
        if not (isTag (info oldp))
              -- amending a normal patch
           then if amendUnrecord cfg
                   then do let context = selectionContextPrim Last "unrecord"
                                             (patchSelOpts cfg)
                                             -- ([All,Unified] `intersect` opts)
                                             (Just (primSplitter (diffAlgorithm cfg)))
                                             (map toFilePath <$> files)
                                             (Just pristine)
                           (_ :> chosenPrims) <- runSelection (effect oldp) context
                           let invPrims = reverseRL (invertFL chosenPrims)
                           addChangesToPatch cfg repository oldp invPrims
                   else go =<< unrecordedChanges (diffingOpts cfg)
                                  (O.moves (lookfor cfg)) (O.replaces (lookfor cfg))
                                  repository files
              -- amending a tag
           else if hasEditMetadata cfg && isNothing files
                        -- the user is not trying to add new changes to the tag so there is
                        -- no reason to warn.
                   then go NilFL
                        -- the user is trying to add new changes to a tag.
                   else do if hasEditMetadata cfg
                                -- the user already knows that it is possible to edit tag metadata,
                                -- note that s/he is providing editing options!
                             then putStrLn "You cannot add new changes to a tag."
                                -- the user may not be aware that s/he can edit tag metadata.
                             else putStrLn "You cannot add new changes to a tag, but you are allowed to edit tag's metadata (see darcs help amend)."
                           go NilFL


addChangesToPatch :: forall rt p wR wU wT wX wY
                   . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                  => AmendConfig
                  -> Repository rt p wR wU wT
                  -> PatchInfoAnd rt p wX wT
                  -> FL (PrimOf p) wT wY
                  -> IO ()
addChangesToPatch cfg repository oldp chs =
    let rebaseJobFlags = RebaseJobFlags (compress cfg) (verbosity cfg) YesUpdateWorking in
    if nullFL chs && not (hasEditMetadata cfg)
    then putStrLn "You don't want to record anything!"
    else do
         invalidateIndex repository
         -- If a rebase is in progress, we want to manually update the rebase state, using
         -- the amendments directly as rebase fixups. This is necessary because otherwise
         -- the normal commute rules for the rebase state will first remove the original
         -- patch then add the amended patch, and this can lead to more conflicts than using
         -- the amendment as a fixup directly. For example, if a rename operation is amended in,
         -- the rename can be propagated to any edits to the file in the rebase state, whereas
         -- a delete then add would just cause a conflict.
         --
         -- We can also signal that any explicit dependencies of the old patch should be rewritten
         -- for the new patch using a 'NameFixup'.
         (repository''', (mlogf, newp)) <- withManualRebaseUpdate rebaseJobFlags repository $ \repository' -> do

             repository'' <- tentativelyRemovePatches repository' (compress cfg) YesUpdateWorking (oldp :>: NilFL)
             (mlogf, newp) <- runHijackT AlwaysRequestHijackPermission $ updatePatchHeader "amend"
                  (if askDeps cfg then AskAboutDeps repository'' else NoAskAboutDeps)
                  (patchSelOpts cfg)
                  (diffAlgorithm cfg)
                  (keepDate cfg)
                  (selectAuthor cfg)
                  (author cfg)
                  (patchname cfg)
                  (askLongComment cfg)
                  oldp chs
             let fixups =
                   mapFL_FL PrimFixup (invert chs) +>+
                   NameFixup (Rename (info newp) (info oldp)) :>:
                   NilFL
             setEnvDarcsFiles newp
             repository''' <- tentativelyAddPatch repository'' (compress cfg) (verbosity cfg) YesUpdateWorking newp
             return (repository''', fixups, (mlogf, newp))
         let failmsg = maybe "" (\lf -> "\nLogfile left in "++lf++".") mlogf
         testTentativeAndMaybeExit repository''' (verbosity cfg) (testChanges cfg) (sse cfg) (isInteractive cfg)
              ("you have a bad patch: '" ++ patchDesc newp ++ "'") "amend it"
              (Just failmsg)
         when (O.moves (lookfor cfg) == O.YesLookForMoves || O.replaces (lookfor cfg) == O.YesLookForReplaces)
           $ tentativelyRemoveFromPending repository''' YesUpdateWorking oldp
         finalizeRepositoryChanges repository''' YesUpdateWorking (compress cfg) `clarifyErrors` failmsg
         putStrLn "Finished amending patch:"
         putDocLn $ description newp
         setEnvDarcsPatches (newp :>: NilFL)


hasEditMetadata :: AmendConfig -> Bool
hasEditMetadata cfg = isJust (author cfg)
                    || selectAuthor cfg
                    || isJust (patchname cfg)
                    || askLongComment cfg == Just O.YesEditLongComment
                    || askLongComment cfg == Just O.PromptLongComment
                    || askDeps cfg

-- hasEditMetadata []                    = False
-- hasEditMetadata (Author _:_)          = True
-- hasEditMetadata (SelectAuthor:_)      = True
-- hasEditMetadata (LogFile _:_)         = True -- ??? not listed as an option for amend
-- hasEditMetadata (PatchName _:_)       = True
-- hasEditMetadata (EditLongComment:_)   = True
-- hasEditMetadata (PromptLongComment:_) = True
-- hasEditMetadata (AskDeps:_)           = True
-- hasEditMetadata (_:fs)                = hasEditMetadata fs


patchSelOpts :: AmendConfig -> S.PatchSelectionOptions
patchSelOpts cfg = S.PatchSelectionOptions
    { S.verbosity = verbosity cfg
    , S.matchFlags = matchFlags cfg
    , S.interactive = isInteractive cfg
    , S.selectDeps = O.PromptDeps -- option not supported, use default
    , S.summary = O.NoSummary -- option not supported, use default
    , S.withContext = withContext cfg
    }

diffingOpts :: AmendConfig -> (O.UseIndex, O.ScanKnown, O.DiffAlgorithm)
diffingOpts cfg = diffOpts (useIndex cfg) (O.adds (lookfor cfg)) O.NoIncludeBoring (diffAlgorithm cfg)

isInteractive :: AmendConfig -> Bool
isInteractive = maybe True id . interactive