--  Copyright (C) 2005 Florian Weimer
--
--  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.

module Darcs.UI.Commands.ShowFiles ( showFiles ) where

import Prelude ()
import Darcs.Prelude

import Darcs.UI.Flags ( DarcsFlag, useCache )
import Darcs.UI.Options ( (^), oid, odesc, ocheck, onormalise
                        , defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInRepository )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.Repository ( Repository, withRepository,
                          RepoJob(..), repoPatchType )
import Darcs.Patch ( IsRepoType, RepoPatch )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Repository.State ( readRecorded, readRecordedAndPending )
import Darcs.Util.Tree( Tree, TreeItem(..), list, expand )
import Darcs.Util.Tree.Plain( readPlainTree )
import Darcs.Util.Path( anchorPath, AbsolutePath )
import System.FilePath ( splitDirectories )

import Data.List( isPrefixOf )

import Darcs.Patch.Match ( haveNonrangeExplicitMatch )
import Darcs.Repository.Match ( getNonrangeMatch )
import Darcs.Util.Lock ( withDelayedDir )

showFilesDescription :: String
showFilesDescription = "Show version-controlled files in the working tree."

showFilesHelp :: String
showFilesHelp =
 "The `darcs show files` command lists those files and directories in\n" ++
 "the working tree that are under version control.  This command is\n" ++
 "primarily for scripting purposes; end users will probably want `darcs\n" ++
 "whatsnew --summary`.\n" ++
 "\n" ++
 "A file is \"pending\" if it has been added but not recorded.  By\n" ++
 "default, pending files (and directories) are listed; the `--no-pending`\n" ++
 "option prevents this.\n" ++
 "\n" ++
 "By default `darcs show files` lists both files and directories, but the\n" ++
 "`--no-files` and `--no-directories` flags modify this behaviour.\n" ++
 "\n" ++
 "By default entries are one-per-line (i.e. newline separated).  This\n" ++
 "can cause problems if the files themselves contain newlines or other\n" ++
 "control characters.  To get around this, the `--null` option uses the\n" ++
 "null character instead.  The script interpreting output from this\n" ++
 "command needs to understand this idiom; `xargs -0` is such a command.\n" ++
 "\n" ++
 "For example, to list version-controlled files by size:\n" ++
 "\n" ++
 "    darcs show files -0 | xargs -0 ls -ldS\n"

showFiles :: DarcsCommand [DarcsFlag]
showFiles = DarcsCommand
    { commandProgramName = "darcs"
    , commandName = "files"
    , commandHelp = showFilesHelp
    , commandDescription = showFilesDescription
    , commandExtraArgs = -1
    , commandExtraArgHelp = ["[FILE or DIRECTORY]..."]
    , commandCommand = manifestCmd toListFiles
    , commandPrereq = amInRepository
    , commandCompleteArgs = knownFileArgs
    , commandArgdefaults = nodefaults
    , commandAdvancedOptions = []
    , commandBasicOptions = odesc showFilesBasicOpts
    , commandDefaults = defaultFlags showFilesOpts
    , commandCheckOptions = ocheck showFilesOpts
    , commandParseOptions = onormalise showFilesOpts
    }
  where
    showFilesBasicOpts
      = O.files
      ^ O.directories
      ^ O.pending
      ^ O.nullFlag
      ^ O.matchUpToOne
      ^ O.repoDir
    showFilesOpts = showFilesBasicOpts `withStdOpts` oid

toListFiles :: [DarcsFlag] -> Tree m -> [FilePath]
toListFiles    opts = filesDirs (parseFlags O.files opts) (parseFlags O.directories opts)

filesDirs :: Bool -> Bool -> Tree m -> [FilePath]
filesDirs False False _ = []
filesDirs False True  t = "." : [ anchorPath "." p | (p, SubTree _) <- list t ]
filesDirs True  False t = [ anchorPath "." p | (p, File _) <- list t ]
filesDirs True  True  t = "." : map (anchorPath "." . fst) (list t)

manifestCmd :: ([DarcsFlag] -> Tree IO -> [FilePath])
            -> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
manifestCmd to_list _ opts argList =
    mapM_ output =<< manifestHelper to_list opts argList
  where
    output_null name = do { putStr name ; putChar '\0' }
    output = if parseFlags O.nullFlag opts then output_null else putStrLn

manifestHelper :: ([DarcsFlag] -> Tree IO -> [FilePath]) -> [DarcsFlag] -> [String] -> IO [FilePath]
manifestHelper to_list opts argList = do
    list' <- to_list opts `fmap` withRepository (useCache ? opts) (RepoJob slurp)
    case argList of
        []       -> return list'
        prefixes -> return (onlysubdirs prefixes list')
  where
    matchFlags = parseFlags O.matchUpToOne opts
    slurp :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
          => Repository rt p wR wU wR -> IO (Tree IO)
    slurp r = do
      let fUpto = haveNonrangeExplicitMatch (repoPatchType r) matchFlags
          fPending = parseFlags O.pending opts
      -- this covers all 4 possibilities
      case (fUpto,fPending) of
        (True, False) -> slurpUpto matchFlags r
        (True, True)  -> error "can't mix match and pending flags"
        (False,False) -> expand =<< readRecorded r
        (False,True)  -> expand =<< readRecordedAndPending r -- pending is default
    isParentDir a' b' =
      let a = splitDirectories a'
          b = splitDirectories b'
      in (a `isPrefixOf` b) || (("." : a) `isPrefixOf` b)
    onlysubdirs dirs = filter (\p -> any (`isParentDir` p) dirs)

slurpUpto :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
          => [O.MatchFlag] -> Repository rt p wR wU wR -> IO (Tree IO)
slurpUpto matchFlags r = withDelayedDir "show.files" $ \_ -> do
  getNonrangeMatch r matchFlags
  -- note: it is important that we expand the tree from inside the
  -- withDelayedDir action, else it has no effect.
  expand =<< readPlainTree "."