{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE CPP #-}
#include "gadts.h"
module Darcs.Commands.ShowFiles ( showFiles, showManifest ) where
import Darcs.Arguments ( DarcsFlag(..), workingRepoDir,
                        files, directories, pending, nullFlag, matchOne )
import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )
import Darcs.Repository ( Repository, amInRepository, slurp_pending, slurp_recorded,
                          withRepository )
import Darcs.Patch ( RepoPatch )
import Darcs.SlurpDirectory ( Slurpy, list_slurpy, list_slurpy_files, list_slurpy_dirs, slurp )
import Data.List( isPrefixOf )

import Darcs.Match ( haveNonrangeMatch, getNonrangeMatch )
import Workaround ( getCurrentDirectory )
import Darcs.Lock ( withDelayedDir )
showFilesDescription :: String
showFilesDescription = "Show version-controlled files in the working copy."

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\n" ++
 "the alias `darcs show manifest' only lists files.  The --files,\n" ++
 "--directories, --no-files and --no-directories 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 aroudn 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
showFiles = DarcsCommand {
  commandName = "files",
  commandHelp = showFilesHelp,
  commandDescription = showFilesDescription,
  commandExtraArgs = -1,
  commandExtraArgHelp = ["[FILE or DIRECTORY]..."],
  commandCommand = manifestCmd toListFiles,
  commandPrereq = amInRepository,
  commandGetArgPossibilities = return [],
  commandArgdefaults = nodefaults,
  commandAdvancedOptions = [],
  commandBasicOptions = [files, directories, pending, nullFlag, matchOne,
                          workingRepoDir] }

showManifest :: DarcsCommand
showManifest = commandAlias "manifest" showFiles {
  commandCommand = manifestCmd toListManifest
}

toListFiles, toListManifest :: [DarcsFlag] -> Slurpy -> [FilePath]
toListFiles    opts = filesDirs (NoFiles `notElem` opts) (NoDirectories `notElem` opts)
toListManifest opts = filesDirs (NoFiles `notElem` opts) (Directories `elem` opts)

filesDirs :: Bool -> Bool -> Slurpy -> [FilePath]
filesDirs False False = \_ -> []
filesDirs False True  = list_slurpy_dirs
filesDirs True  False = list_slurpy_files
filesDirs True  True  = list_slurpy

manifestCmd :: ([DarcsFlag] -> Slurpy -> [FilePath]) -> [DarcsFlag] -> [String] -> IO ()
manifestCmd to_list opts argList = do
    list <- (to_list opts) `fmap` withRepository opts myslurp
    case argList of 
        [] -> mapM_ output list
        prefixes -> mapM_ output (onlysubdirs prefixes list)
    where myslurp :: RepoPatch p => Repository p C(r u r) -> IO Slurpy
          myslurp = do let fRevisioned = haveNonrangeMatch opts
                           fPending = Pending `elem` opts
                           fNoPending = NoPending `elem` opts 
                       -- this covers all 8 options
                       case (fRevisioned,fPending,fNoPending) of
                            (True,False,_) -> slurp_revision opts
                            (True,True,_) -> error $ "can't mix revisioned and pending flags"
                            (False,False,True) -> slurp_recorded
                            (False,_,False) -> slurp_pending -- pending is default
                            (False,True,True) -> error $ "can't mix pending and no-pending flags"
          output_null name = do { putStr name ; putChar '\0' }
          output = if NullFlag `elem` opts then output_null else putStrLn
          isParentDir a b = a == b  
                            || (a  ++ "/") `isPrefixOf` b 
                            || ("./" ++ a ++ "/") `isPrefixOf` b 
                            || "./" ++ a == b
          onlysubdirs suffixes = filter $ or . mapM isParentDir suffixes

slurp_revision :: RepoPatch p => [DarcsFlag] -> Repository p C(r u r) -> IO Slurpy
slurp_revision opts r = withDelayedDir "revisioned.showfiles" $ \_ -> do 
  getNonrangeMatch r opts 
  slurp =<< getCurrentDirectory