--  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 OverloadedStrings #-}

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

import Prelude ()
import Darcs.Prelude

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

import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.Flags ( DarcsFlag, useCache, fixSubPaths, patchIndexYes )
import Darcs.UI.Options ( (^), 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
    )
import Darcs.Repository.PatchIndex ( attemptCreatePatchIndex )
import Darcs.Patch.Set ( patchSet2RL )
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, SubPath )
import Darcs.Util.Exception ( die )

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."
 ]

annotate :: DarcsCommand [DarcsFlag]
annotate = DarcsCommand
    { commandProgramName = "darcs"
    , commandName = "annotate"
    , commandHelp = annotateHelp
    , commandDescription = annotateDescription
    , commandExtraArgs = 1
    , commandExtraArgHelp = ["[FILE or DIRECTORY]"]
    , commandCommand = annotateCmd
    , commandPrereq = amInHashedRepository
    , commandCompleteArgs = knownFileArgs
    , commandArgdefaults = nodefaults
    , commandAdvancedOptions = odesc annotateAdvancedOpts
    , commandBasicOptions = odesc annotateBasicOpts
    , commandDefaults = defaultFlags annotateOpts
    , commandCheckOptions = ocheck annotateOpts
    , commandParseOptions = onormalise annotateOpts
    }
  where
    annotateBasicOpts = O.machineReadable ^ O.matchUpToOne ^ O.repoDir
    annotateAdvancedOpts = O.patchIndexYes
    annotateOpts = annotateBasicOpts `withStdOpts` annotateAdvancedOpts

annotateCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
annotateCmd fps opts args = do
  fixed_paths <- fixSubPaths fps args
  case fixed_paths of
    [] -> die "Error: annotate needs a filename to work with"
    (fixed_path:_) -> do
      when (patchIndexYes ? opts == O.YesPatchIndex)
        $ withRepoLockCanFail (useCache ? opts)
        $ RepoJob (\repo -> readRepo repo >>= attemptCreatePatchIndex repo)
      annotateCmd' opts fixed_path

annotateCmd' :: [DarcsFlag] -> SubPath -> IO ()
annotateCmd' opts fixed_path = withRepository (useCache ? opts) $ RepoJob $ \repository -> do
  let matchFlags = parseFlags O.matchUpToOne opts
  r <- readRepo repository
  recorded <- readRecorded repository
  (patches, initial, path') <-
    if haveNonrangeMatch (repoPatchType repository) matchFlags
       then do Sealed x <- getOnePatchset repository matchFlags
               let fn = [fp2fn $ toFilePath fixed_path]
                   nonRangeMatch = getNonrangeMatchS matchFlags r
                   (_, [path], _) = withFileNames Nothing fn nonRangeMatch
               initial <- snd `fmap` virtualTreeIO (getNonrangeMatchS matchFlags r) recorded
               return (seal $ patchSet2RL x, initial, toFilePath path)
       else return (seal $ patchSet2RL r, recorded, toFilePath fixed_path)
  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
  usePatchIndex <- (O.yes (O.patchIndexYes ? opts) &&) <$> canUsePatchIndex repository
  case found of
    Nothing -> die $ "Error: 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
         if not usePatchIndex
            then return patches
            else getRelevantSubsequence patches repository r subs
      putStrLn $ fmt (BC.intercalate "\n" $
                        map (showPath . first (anchorPath "")) $ list s') $
        A.annotateDirectory (invertRL ans_patches) (fp2fn path) subs
    Just (File b) -> do (Sealed ans_patches) <- do
                           if not usePatchIndex
                              then return patches
                              else getRelevantSubsequence patches repository r [fp2fn path]
                        con <- BC.concat `fmap` toChunks `fmap` readBlob b
                        putStrLn $ fmt con $
                          A.annotateFile (invertRL ans_patches) (fp2fn path) con
    Just (Stub _ _) -> impossible