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

module Darcs.UI.Commands.Remove ( remove, rm, unadd ) where

import Darcs.Prelude

import Control.Monad ( when, foldM )
import Darcs.UI.Commands
    ( DarcsCommand(..)
    , withStdOpts, nodefaults
    , commandAlias, commandStub
    , putWarning, putInfo
    , amInHashedRepository
    )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.Flags
    ( DarcsFlag, useCache, dryRun, umask, diffAlgorithm, quiet, pathsFromArgs )
import Darcs.UI.Options ( (^), odesc, ocheck, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O

import Darcs.Repository.Flags ( UpdatePending (..) )
import Darcs.Repository
    ( Repository
    , withRepoLock
    , RepoJob(..)
    , addToPending
    , readRecordedAndPending
    , readUnrecorded
    )
import Darcs.Repository.Diff( treeDiff )

import Darcs.Patch ( RepoPatch, PrimOf, PrimPatch, adddir, rmdir, addfile, rmfile,
                     listTouchedFiles )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Witnesses.Ordered ( FL(..), (+>+), nullFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), Gap(..), FreeLeft, unFreeLeft )
import Darcs.Repository.Prefs ( filetypeFunction, FileType )
import Darcs.Util.Tree( Tree, TreeItem(..), explodePaths )
import qualified Darcs.Util.Tree as T ( find, modifyTree, expand, list )
import Darcs.Util.Path( AnchoredPath, displayPath, isRoot, AbsolutePath )
import Darcs.Util.Printer ( Doc, text, vcat )

removeDescription :: String
removeDescription :: String
removeDescription = String
"Remove files from version control."

removeHelp :: Doc
removeHelp :: Doc
removeHelp = String -> Doc
text forall a b. (a -> b) -> a -> b
$
 String
"The `darcs remove` command exists primarily for symmetry with `darcs\n" forall a. [a] -> [a] -> [a]
++
 String
"add`, as the normal way to remove a file from version control is\n" forall a. [a] -> [a] -> [a]
++
 String
"simply to delete it from the working tree.  This command is only\n" forall a. [a] -> [a] -> [a]
++
 String
"useful in the unusual case where one wants to record a removal patch\n" forall a. [a] -> [a] -> [a]
++
 String
"WITHOUT deleting the copy in the working tree (which can be re-added).\n" forall a. [a] -> [a] -> [a]
++
 String
"\n" forall a. [a] -> [a] -> [a]
++
 String
"Note that applying a removal patch to a repository (e.g. by pulling\n" forall a. [a] -> [a] -> [a]
++
 String
"the patch) will ALWAYS affect the working tree of that repository.\n"

remove :: DarcsCommand
remove :: DarcsCommand
remove = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"remove"
    , commandHelp :: Doc
commandHelp = Doc
removeHelp
    , commandDescription :: String
commandDescription = String
removeDescription
    , commandExtraArgs :: Int
commandExtraArgs = -Int
1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"<FILE or DIRECTORY> ..."]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
removeCmd
    , commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
knownFileArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
removeAdvancedOpts
    , commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> Bool -> a)
removeBasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
  a
  (Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
removeOpts
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
  a
  (Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
removeOpts
    }
  where
    removeBasicOpts :: OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> Bool -> a)
removeBasicOpts = PrimDarcsOption (Maybe String)
O.repoDir forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.recursive
    removeAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
removeAdvancedOpts = PrimDarcsOption UseIndex
O.useIndex forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UMask
O.umask
    removeOpts :: DarcsOption
  a
  (Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseIndex
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
removeOpts = forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> Bool -> a)
removeBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (UseIndex -> UMask -> a)
removeAdvancedOpts

removeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
removeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
removeCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [String]
relargs = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
relargs) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Nothing specified, nothing removed."
    [AnchoredPath]
paths <- (AbsolutePath, AbsolutePath) -> [String] -> IO [AnchoredPath]
pathsFromArgs (AbsolutePath, AbsolutePath)
fps [String]
relargs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any AnchoredPath -> Bool
isRoot [AnchoredPath]
paths) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot remove a repository's root directory!"
    forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
      forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob forall a b. (a -> b) -> a -> b
$ \Repository rt p wR wU wR
repository -> do
        Tree IO
recorded_and_pending <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO (Tree IO)
readRecordedAndPending Repository rt p wR wU wR
repository
        let exploded_paths :: [AnchoredPath]
exploded_paths =
              (if forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Bool
O.recursive [DarcsFlag]
opts
                then forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree IO -> [AnchoredPath] -> [AnchoredPath]
explodePaths Tree IO
recorded_and_pending
                else forall a. a -> a
id) [AnchoredPath]
paths
        Sealed FL (PrimOf p) wU wX
p <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository rt p wR wU wR
-> [AnchoredPath]
-> IO (Sealed (FL (PrimOf p) wU))
makeRemovePatch [DarcsFlag]
opts Repository rt p wR wU wR
repository [AnchoredPath]
exploded_paths
        -- TODO whether command fails depends on verbosity BAD BAD BAD
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PrimOf p) wU wX
p Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnchoredPath]
paths) Bool -> Bool -> Bool
&& Bool -> Bool
not ([DarcsFlag] -> Bool
quiet [DarcsFlag]
opts)) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No files were removed."
        forall (p :: * -> * -> *) (rt :: RepoType) wR wU wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> UseIndex -> FL (PrimOf p) wU wY -> IO ()
addToPending Repository rt p wR wU wR
repository (PrimDarcsOption UseIndex
O.useIndex forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wU wX
p
        [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text forall a b. (a -> b) -> a -> b
$ [String
"Will stop tracking:"] forall a. [a] -> [a] -> [a]
++
            forall a b. (a -> b) -> [a] -> [b]
map AnchoredPath -> String
displayPath (forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL (PrimOf p) wU wX
p)

-- | makeRemovePatch builds a list of patches to remove the given filepaths.
--   This function does not recursively process directories. The 'Recursive'
--   flag should be handled by the caller by adding all offspring of a directory
--   to the files list.
makeRemovePatch :: (RepoPatch p, ApplyState p ~ Tree)
                => [DarcsFlag] -> Repository rt p wR wU wR
                -> [AnchoredPath] -> IO (Sealed (FL (PrimOf p) wU))
makeRemovePatch :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository rt p wR wU wR
-> [AnchoredPath]
-> IO (Sealed (FL (PrimOf p) wU))
makeRemovePatch [DarcsFlag]
opts Repository rt p wR wU wR
repository [AnchoredPath]
files =
                          do Tree IO
recorded <- forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
T.expand forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO (Tree IO)
readRecordedAndPending Repository rt p wR wU wR
repository
                             Tree IO
unrecorded <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> UseIndex -> Maybe [AnchoredPath] -> IO (Tree IO)
readUnrecorded Repository rt p wR wU wR
repository (PrimDarcsOption UseIndex
O.useIndex forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [AnchoredPath]
files
                             String -> FileType
ftf <- IO (String -> FileType)
filetypeFunction
                             (String -> FileType, Tree IO, Tree IO, [FreeLeft (FL (PrimOf p))])
result <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {prim :: * -> * -> *}.
(CleanMerge prim, Commute prim, Invert prim, Eq2 prim, IsHunk prim,
 PatchInspect prim, RepairToFL prim, Show2 prim, PrimConstruct prim,
 PrimCanonize prim, PrimClassify prim, PrimDetails prim,
 PrimApply prim, PrimSift prim, PrimMangleUnravelled prim,
 ReadPatch prim, ShowPatch prim, ShowContextPatch prim,
 PatchListFormat prim) =>
(String -> FileType, Tree IO, Tree IO, [FreeLeft (FL prim)])
-> AnchoredPath
-> IO (String -> FileType, Tree IO, Tree IO, [FreeLeft (FL prim)])
removeOnePath (String -> FileType
ftf,Tree IO
recorded,Tree IO
unrecorded, []) [AnchoredPath]
files
                             case (String -> FileType, Tree IO, Tree IO, [FreeLeft (FL (PrimOf p))])
result of
                                 (String -> FileType
_, Tree IO
_, Tree IO
_, [FreeLeft (FL (PrimOf p))]
patches) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                                                         forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *)
       (q :: * -> * -> *) (r :: * -> * -> *).
Gap w =>
(forall wX wY wZ. p wX wY -> q wY wZ -> r wX wZ)
-> w p -> w q -> w r
joinGap forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
(+>+)) (forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX. p wX wX) -> w p
emptyGap forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [FreeLeft (FL (PrimOf p))]
patches
    where removeOnePath :: (String -> FileType, Tree IO, Tree IO, [FreeLeft (FL prim)])
-> AnchoredPath
-> IO (String -> FileType, Tree IO, Tree IO, [FreeLeft (FL prim)])
removeOnePath (String -> FileType
ftf, Tree IO
recorded, Tree IO
unrecorded, [FreeLeft (FL prim)]
patches) AnchoredPath
f = do
            let recorded' :: Tree IO
recorded' = forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> Maybe (TreeItem m) -> Tree m
T.modifyTree Tree IO
recorded AnchoredPath
f forall a. Maybe a
Nothing
                unrecorded' :: Tree IO
unrecorded' = forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> Maybe (TreeItem m) -> Tree m
T.modifyTree Tree IO
unrecorded AnchoredPath
f forall a. Maybe a
Nothing
            Maybe (FreeLeft (FL prim))
local <- forall (prim :: * -> * -> *).
PrimPatch prim =>
[DarcsFlag]
-> (String -> FileType)
-> Tree IO
-> Tree IO
-> Tree IO
-> AnchoredPath
-> IO (Maybe (FreeLeft (FL prim)))
makeRemoveGap [DarcsFlag]
opts String -> FileType
ftf Tree IO
recorded Tree IO
unrecorded Tree IO
unrecorded' AnchoredPath
f
            -- we can tell if the remove succeeded by looking if local is
            -- empty. If the remove succeeded, we should pass on updated
            -- recorded and unrecorded that reflect the removal
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (FreeLeft (FL prim))
local of
                       Just FreeLeft (FL prim)
gap -> (String -> FileType
ftf, Tree IO
recorded', Tree IO
unrecorded', FreeLeft (FL prim)
gap forall a. a -> [a] -> [a]
: [FreeLeft (FL prim)]
patches)
                       Maybe (FreeLeft (FL prim))
_        -> (String -> FileType
ftf, Tree IO
recorded, Tree IO
unrecorded, [FreeLeft (FL prim)]
patches)

-- | Takes a file path and returns the FL of patches to remove that, wrapped in
--   a 'Gap'.
--   Returns 'Nothing' in case the path cannot be removed (if it is not tracked,
--   or if it's a directory and it's not tracked).
--   The three 'Tree' arguments are the recorded state, the unrecorded state
--   excluding the removal of this file, and the unrecorded state including the
--   removal of this file.
makeRemoveGap :: PrimPatch prim => [DarcsFlag] -> (FilePath -> FileType)
                -> Tree IO -> Tree IO -> Tree IO -> AnchoredPath
                -> IO (Maybe (FreeLeft (FL prim)))
makeRemoveGap :: forall (prim :: * -> * -> *).
PrimPatch prim =>
[DarcsFlag]
-> (String -> FileType)
-> Tree IO
-> Tree IO
-> Tree IO
-> AnchoredPath
-> IO (Maybe (FreeLeft (FL prim)))
makeRemoveGap [DarcsFlag]
opts String -> FileType
ftf Tree IO
recorded Tree IO
unrecorded Tree IO
unrecorded' AnchoredPath
path =
    case (forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (TreeItem m)
T.find Tree IO
recorded AnchoredPath
path, forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (TreeItem m)
T.find Tree IO
unrecorded AnchoredPath
path) of
        (Just (SubTree Tree IO
_), Just (SubTree Tree IO
unrecordedChildren)) ->
            if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
T.list Tree IO
unrecordedChildren)
              then forall {a}. String -> IO (Maybe a)
skipAndWarn String
"it is not empty"
              else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
rmdir AnchoredPath
path forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
        (Just (File Blob IO
_), Just (File Blob IO
_)) -> do
            forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) (w :: (* -> * -> *) -> *)
       (prim :: * -> * -> *).
(Monad m, Gap w, PrimPatch prim) =>
DiffAlgorithm
-> (String -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff (PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String -> FileType
ftf Tree IO
unrecorded Tree IO
unrecorded'
        (Just (File Blob IO
_), Maybe (TreeItem IO)
_) ->
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
addfile AnchoredPath
path forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
rmfile AnchoredPath
path forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
        (Just (SubTree Tree IO
_), Maybe (TreeItem IO)
_) ->
            forall (m :: * -> *) a. Monad m => a -> m a
return  forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
adddir AnchoredPath
path forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
rmdir AnchoredPath
path forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
        (Maybe (TreeItem IO)
_, Maybe (TreeItem IO)
_) -> forall {a}. String -> IO (Maybe a)
skipAndWarn String
"it is not tracked by darcs"
  where skipAndWarn :: String -> IO (Maybe a)
skipAndWarn String
reason =
            do [DarcsFlag] -> Doc -> IO ()
putWarning [DarcsFlag]
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
"Can't remove " forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
displayPath AnchoredPath
path
                                        forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ String
reason forall a. [a] -> [a] -> [a]
++ String
")"
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing


rmDescription :: String
rmDescription :: String
rmDescription = String
"Help newbies find `darcs remove'."

rmHelp :: Doc
rmHelp :: Doc
rmHelp = String -> Doc
text forall a b. (a -> b) -> a -> b
$
 String
"The `darcs rm' command does nothing.\n" forall a. [a] -> [a] -> [a]
++
 String
"\n" forall a. [a] -> [a] -> [a]
++
 String
"The normal way to remove a file from version control is simply to\n" forall a. [a] -> [a] -> [a]
++
 String
"delete it from the working tree.  To remove a file from version\n" forall a. [a] -> [a] -> [a]
++
 String
"control WITHOUT affecting the working tree, see `darcs remove'.\n"

rm :: DarcsCommand
rm :: DarcsCommand
rm = String -> Doc -> String -> DarcsCommand -> DarcsCommand
commandStub String
"rm" Doc
rmHelp String
rmDescription DarcsCommand
remove

unadd :: DarcsCommand
unadd :: DarcsCommand
unadd = String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias String
"unadd" forall a. Maybe a
Nothing DarcsCommand
remove