--  Copyright (C) 2003 David Roundy, 2010-2011 Petr Rockai
--
--  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.
{-# LANGUAGE CPP, OverloadedStrings #-}

module Darcs.UI.Commands.Annotate ( annotate ) where

import Prelude ()
import Darcs.Prelude

import Prelude hiding ( (^) )

import Control.Arrow ( first )
import Control.Monad ( unless )

import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository )
import Darcs.UI.Flags ( DarcsFlag(NoPatchIndexFlag), useCache, fixSubPaths, umask )
import Darcs.UI.Options ( DarcsOption, (^), odesc, ocheck, onormalise
                        , defaultFlags, parseFlags )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.State ( readRecorded )
import Darcs.Repository
    ( withRepository
    , withRepoLockCanFail
    , RepoJob(..)
    , readRepo
    , repoPatchType
    , listRegisteredFiles
    )
import Darcs.Repository.Flags ( UpdateWorking(..) )
import Darcs.Repository.PatchIndex ( attemptCreatePatchIndex )
import Darcs.Patch.Set ( newset2RL )
import Darcs.Patch ( invertRL )
import qualified Data.ByteString.Char8 as BC ( pack, concat, intercalate )
import Data.ByteString.Lazy ( toChunks )
import Darcs.Patch.ApplyMonad( withFileNames )
import System.FilePath.Posix ( (</>) )
import Darcs.Patch.Match ( haveNonrangeMatch, getNonrangeMatchS  )
import Darcs.Repository.Match ( getOnePatchset )
import Darcs.Repository.PatchIndex ( getRelevantSubsequence, canUsePatchIndex )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal )
import qualified Darcs.Patch.Annotate as A

import Darcs.Util.Tree( TreeItem(..), readBlob, list, expand )
import Darcs.Util.Tree.Monad( findM, virtualTreeIO )
import Darcs.Util.Path( floatPath, anchorPath, fp2fn, toFilePath
                      , AbsolutePath )
import qualified Darcs.Util.Diff as D ( DiffAlgorithm(MyersDiff) )

#include "impossible.h"

annotateDescription :: String
annotateDescription = "Annotate lines of a file with the last patch that modified it."

annotateHelp :: String
annotateHelp = unlines
 [ "When `darcs annotate` is called on a file, it will find the patch that"
 , "last modified each line in that file. This also works on directories."
 , ""
 , "The `--machine-readable` option can be used to generate output for"
 , "machine postprocessing."
 ]

annotateBasicOpts :: DarcsOption a
                     (Bool
                      -> [O.MatchFlag]
                      -> Maybe String
                      -> a)
annotateBasicOpts = O.machineReadable
                  ^ O.matchUpToOne
                  ^ O.workingRepoDir

annotateAdvancedOpts :: DarcsOption a (O.WithPatchIndex -> a)
annotateAdvancedOpts = O.patchIndexYes

annotateOpts :: DarcsOption a
                (   Bool
                 -> [O.MatchFlag]
                 -> Maybe String
                 -> Maybe O.StdCmdAction
                 -> Bool
                 -> Bool
                 -> O.Verbosity
                 -> Bool
                 -> O.WithPatchIndex
                 -> O.UseCache
                 -> Maybe String
                 -> Bool
                 -> Maybe String
                 -> Bool
                 -> a)
annotateOpts = annotateBasicOpts `withStdOpts` annotateAdvancedOpts

annotate :: DarcsCommand [DarcsFlag]
annotate = DarcsCommand
    { commandProgramName = "darcs"
    , commandName = "annotate"
    , commandHelp = annotateHelp
    , commandDescription = annotateDescription
    , commandExtraArgs = 1
    , commandExtraArgHelp = ["[FILE or DIRECTORY]"]
    , commandCommand = annotateCmd
    , commandPrereq = amInHashedRepository
    , commandGetArgPossibilities = listRegisteredFiles
    , commandArgdefaults = nodefaults
    , commandAdvancedOptions = odesc annotateAdvancedOpts
    , commandBasicOptions = odesc annotateBasicOpts
    , commandDefaults = defaultFlags annotateOpts
    , commandCheckOptions = ocheck annotateOpts
    , commandParseOptions = onormalise annotateOpts
}

annotateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
annotateCmd _ _ [""] = fail "No filename argument given to annotate!"
annotateCmd fps opts args = do
 let matchFlags = parseFlags O.matchUpToOne opts
 unless (NoPatchIndexFlag `elem` opts)
   $ withRepoLockCanFail (useCache opts) YesUpdateWorking (umask opts) $ RepoJob attemptCreatePatchIndex
 withRepository (useCache opts) $ RepoJob $ \repository -> do
  r <- readRepo repository
  (origpath:_) <- fixSubPaths fps args
  recorded <- readRecorded repository

  (patches, initial, path') <-
    if haveNonrangeMatch (repoPatchType repository) matchFlags
       then do Sealed x <- getOnePatchset repository matchFlags
               let fn = [fp2fn $ toFilePath origpath]
                   nonRangeMatch = getNonrangeMatchS matchFlags r
                   (_, [path], _) = withFileNames Nothing fn nonRangeMatch
               initial <- snd `fmap` virtualTreeIO (getNonrangeMatchS matchFlags r) recorded
               return (seal $ newset2RL x, initial, toFilePath path)
       else return (seal $ newset2RL r, recorded, toFilePath origpath)
  let path = "./" ++ path'

  found <- findM initial (floatPath $ toFilePath path)
  -- TODO need to decide about the --machine flag
  let fmt = if parseFlags O.machineReadable opts then A.machineFormat else A.format
  case found of
    Nothing -> fail $ "No such file or directory: " ++ toFilePath path
    Just (SubTree s) -> do
      s' <- expand s
      let subs = map (fp2fn . (path </>) . anchorPath "" . fst) $ list s'
          showPath (n, File _) = BC.pack (path </> n)
          showPath (n, _) = BC.concat [BC.pack (path </> n), "/"]
      (Sealed ans_patches) <- do
         upi <- canUsePatchIndex repository
         if not upi
            then return patches
            else getRelevantSubsequence patches repository subs
      putStrLn $ fmt (BC.intercalate "\n" $
                        map (showPath . first (anchorPath "")) $ list s') $
        A.annotateDirectory D.MyersDiff (invertRL ans_patches) (fp2fn path) subs
    Just (File b) -> do (Sealed ans_patches) <- do
                           upi <- canUsePatchIndex repository
                           if not upi
                              then return patches
                              else getRelevantSubsequence patches repository [fp2fn path]
                        con <- BC.concat `fmap` toChunks `fmap` readBlob b
                        putStrLn $ fmt con $ A.annotate D.MyersDiff (invertRL ans_patches) (fp2fn path) con
    Just (Stub _ _) -> impossible