--  Copyright (C) 2002-2004 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.

{-# LANGUAGE CPP #-}

#include "gadts.h"

module Darcs.Commands.WhatsNew
    (
      whatsnew
    , status
    ) where

import Control.Applicative ( (<$>) )
import Data.List ( delete )
import System.Exit ( ExitCode(..), exitWith )

import Storage.Hashed.Tree( Tree )

import Darcs.Arguments ( DarcsFlag(..), workingRepoDir, lookforadds,
                         ignoretimes, noskipBoring, unified, summary,
                         fixSubPaths, listRegisteredFiles )
import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )
import Darcs.Commands.Util ( announceFiles )
import Darcs.Diff( treeDiff )
import Darcs.Flags( isUnified, diffingOpts )
import Darcs.Patch ( RepoPatch, PrimPatch, PrimOf, plainSummaryPrims,
                     primIsHunk, applyToTree )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Format ( PatchListFormat(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Patchy ( Patchy )
import Darcs.Patch.Permutations ( partitionRL )
import Darcs.Patch.Prim.Class ( PrimDetails(..) )
import Darcs.Patch.TouchesFiles( choosePreTouching )
import Darcs.RepoPath( SubPath, toFilePath )
import Darcs.Repository ( Repository, withRepository, RepoJob(..)
                        , amInRepository
                        , unrecordedChanges, readRecorded )
import Darcs.Repository.Prefs ( filetypeFunction )
import Darcs.PrintPatch ( printPatch, contextualPrintPatch )
import Darcs.Witnesses.Ordered ( FL(..), reverseRL, reverseFL, (:>)(..) )
import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )
import Printer ( putDocLn, renderString, vcat, text )

whatsnew :: DarcsCommand
whatsnew = DarcsCommand { commandProgramName = "darcs"
                        , commandName = "whatsnew"
                        , commandHelp = whatsnewHelp
                        , commandDescription = whatsnewDescription
                        , commandExtraArgs = -1
                        , commandExtraArgHelp = ["[FILE or DIRECTORY]..."]
                        , commandCommand = whatsnewCmd
                        , commandPrereq = amInRepository
                        , commandGetArgPossibilities = listRegisteredFiles
                        , commandArgdefaults = nodefaults
                        , commandAdvancedOptions = [ignoretimes, noskipBoring]
                        , commandBasicOptions = [ summary
                                                , unified
                                                , lookforadds
                                                , workingRepoDir
                                                ]
                        }

whatsnewDescription :: String
whatsnewDescription = "List unrecorded changes in the working tree."

whatsnewHelp :: String
whatsnewHelp =
 "The `darcs whatsnew' command lists unrecorded changes to the working\n" ++
 "tree.  If you specify a set of files and directories, only unrecorded\n" ++
 "changes to those files and directories are listed.\n" ++
 "\n" ++
 "With the --summary option, the changes are condensed to one line per\n" ++
 "file, with mnemonics to indicate the nature and extent of the change.\n" ++
 "The --look-for-adds option causes candidates for `darcs add' to be\n" ++
 "included in the summary output.  Summary mnemonics are as follows:\n" ++
 "\n" ++
 "  `A f' and `A d/' respectively mean an added file or directory.\n" ++
 "  `R f' and `R d/' respectively mean a removed file or directory.\n" ++
 "  `M f -N +M rP' means a modified file, with N lines deleted, M\n" ++
 "  lines added, and P lexical replacements.\n" ++
 "  `f -> g' means a moved file or directory.\n" ++
 "  `a f' and `a d/' respectively mean a new, but unadded, file or\n" ++
 "  directory, when using --look-for-adds.\n" ++
 "\n" ++
 "  An exclamation mark (!) as in `R! foo.c', means the hunk is known to\n" ++
 "  conflict with a hunk in another patch.  The phrase `duplicated'\n" ++
 "  means the hunk is known to be identical to a hunk in another patch.\n" ++
 "\n" ++
 "By default, `darcs whatsnew' uses Darcs' internal format for changes.\n" ++
 "To see some context (unchanged lines) around each change, use the\n" ++
 "--unified option.  To view changes in conventional `diff' format, use\n" ++
 "the `darcs diff' command; but note that `darcs whatsnew' is faster.\n" ++
 "\n" ++
 "This command exits unsuccessfully (returns a non-zero exit status) if\n" ++
 "there are no unrecorded changes.\n"

whatsnewCmd :: [DarcsFlag] -> [String] -> IO ()
whatsnewCmd opts args =
   withRepository opts $ RepoJob $ \(repo :: Repository p C(r u r)) -> do
    files <- if null args
                 then return Nothing
                 else Just <$> fixSubPaths opts args
    let isLookForAdds = LookForAdds `elem` opts && NoSummary `notElem` opts
        -- LookForAdds implies Summary, unless it's explcitly disabled.
        optsModifier = if isLookForAdds
                           then (Summary :) . (LookForAdds `delete`)
                           else id
        opts' = optsModifier opts
    Sealed noLookChanges <- filteredUnrecordedChanges opts' repo files
    pristine <- readRecorded repo
    -- If we are looking for adds, return the corresponding FL of changes.
    Sealed unaddedNewPathsPs <- if isLookForAdds
        then do
            -- Use opts not opts', here, since we *do* want to look for adds.
            Sealed lookChanges <- filteredUnrecordedChanges opts repo files
            noLookAddsTree <- applyAddPatchesToPristine noLookChanges pristine
            lookAddsTree <- applyAddPatchesToPristine lookChanges pristine
            ftf <- filetypeFunction
            -- Return the patches that create files/dirs that aren't yet added.
            unFreeLeft <$> treeDiff ftf noLookAddsTree lookAddsTree
        else return (Sealed NilFL)
    announceFiles files "What's new in"
    exitOnNoChanges (unaddedNewPathsPs, noLookChanges)
    printChanges opts' pristine noLookChanges
    printUnaddedPaths unaddedNewPathsPs
  where
    -- |Filter out hunk patches (leaving add patches) and return the tree
    -- resulting from applying the filtered patches to the pristine tree.
    applyAddPatchesToPristine ps pristine = do
        adds :> _ <- return $ partitionRL primIsHunk $ reverseFL ps
        applyToTree (reverseRL adds) pristine

    exitOnNoChanges :: (FL p C(x y), FL p C(u v)) -> IO ()
    exitOnNoChanges (NilFL, NilFL) = do putStrLn "No changes!"
                                        exitWith $ ExitFailure 1
    exitOnNoChanges _ = return ()

    printUnaddedPaths :: PrimPatch p => FL p C(x y) -> IO ()
    printUnaddedPaths NilFL = return ()
    printUnaddedPaths ps =
        putDocLn . lowercaseAs . renderString . plainSummaryPrims $ ps

    -- Make any add markers lowercase, to distinguish new-but-unadded files
    -- from those that are unrecorded, but added.
    lowercaseAs x = vcat $ map (text . lowercaseA) $ lines x
    lowercaseA ('A' : x) = 'a' : x
    lowercaseA x = x

    -- |Appropriately print changes, according to the passed flags.
    printChanges :: (PatchListFormat p, IsHunk p, Patchy p, PrimDetails p,
                 ApplyState p ~ Tree) => [DarcsFlag] -> Tree IO -> FL p C(x y)
                 -> IO ()
    printChanges opts' pristine changes
        | Summary `elem` opts' = putDocLn $ plainSummaryPrims changes
        | isUnified opts' = contextualPrintPatch pristine changes
        | otherwise = printPatch changes

    -- |return the unrecorded changes that affect an optional list of paths.
    filteredUnrecordedChanges :: (RepoPatch p, ApplyState p ~ Tree,
                              ApplyState (PrimOf p) ~ Tree) => [DarcsFlag]
                              -> Repository p C(r u t) -> Maybe [SubPath]
                              -> IO (Sealed (FL (PrimOf p) C(t)))
    filteredUnrecordedChanges  opts' repo files =
        let filePaths = map toFilePath <$> files in
        let diffOpts = diffingOpts opts' in
        choosePreTouching filePaths <$> unrecordedChanges diffOpts repo files

-- |status is an alias for whatsnew, with implicit Summary and LookForAdds
-- flags. We override the default description, to include the implicit flags.
status :: DarcsCommand
status = statusAlias { commandCommand = statusCmd
                     , commandDescription = statusDesc
                     }
  where
    statusAlias = commandAlias "status" Nothing whatsnew
    statusCmd fs = commandCommand whatsnew (Summary : LookForAdds : fs)
    statusDesc = "Alias for `darcs " ++ commandName whatsnew ++ " -ls '."
