--  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, void )
import Darcs.UI.Commands
    ( DarcsCommand(..)
    , withStdOpts, nodefaults
    , commandAlias, commandStub
    , putWarning, putInfo
    , amInHashedRepository
    )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.Flags
    ( DarcsFlag, diffingOpts
    , useCache, umask, diffAlgorithm, pathsFromArgs )
import Darcs.UI.Options ( (^), parseFlags, (?) )
import qualified Darcs.UI.Options.All as O

import Darcs.Repository
    ( Repository
    , withRepoLock
    , RepoJob(..)
    , addToPending
    , finalizeRepositoryChanges
    , readPristineAndPending
    , readUnrecorded
    )
import Darcs.Repository.Diff( treeDiff )
import Darcs.Repository.State ( restrictSubpaths, applyTreeFilter )

import Darcs.Patch ( RepoPatch, PrimOf, PrimPatch, adddir, rmdir, addfile, rmfile,
                     listTouchedFiles )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Witnesses.Ordered ( FL(..), concatGapsFL, 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 (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
 String
"The `darcs remove` command exists primarily for symmetry with `darcs\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"add`, as the normal way to remove a file from version control is\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"simply to delete it from the working tree.  This command is only\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"useful in the unusual case where one wants to record a removal patch\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"WITHOUT deleting the copy in the working tree (which can be re-added).\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"Note that applying a removal patch to a repository (e.g. by pulling\n" String -> String -> String
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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
removeOpts
    }
  where
    removeBasicOpts :: OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> Bool -> a)
removeBasicOpts = PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) (Maybe String)
PrimDarcsOption (Maybe String)
O.repoDir PrimOptSpec DarcsOptDescr DarcsFlag (Bool -> a) (Maybe String)
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> Bool -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
PrimDarcsOption Bool
O.recursive
    removeAdvancedOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a UMask
removeAdvancedOpts = PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
O.umask
    removeOpts :: CommandOptions
removeOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> Bool -> a)
removeBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (UMask
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
PrimDarcsOption UMask
removeAdvancedOpts

removeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
removeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
removeCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [String]
relargs = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
relargs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Nothing specified, nothing removed."
    paths <- (AbsolutePath, AbsolutePath) -> [String] -> IO [AnchoredPath]
pathsFromArgs (AbsolutePath, AbsolutePath)
fps [String]
relargs
    when (any isRoot paths) $
        fail "Cannot remove a repository's root directory!"
    withRepoLock (useCache ? opts) (umask ? opts) $
      RepoJob $ \Repository 'RW p wU wR
repository -> do
        pathFilter <- Repository 'RW p wU wR -> [AnchoredPath] -> IO (TreeFilter IO)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR (m :: * -> *).
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> [AnchoredPath] -> IO (TreeFilter m)
restrictSubpaths Repository 'RW p wU wR
repository [AnchoredPath]
paths
        pristine <-
            T.expand =<<
            applyTreeFilter pathFilter <$> readPristineAndPending repository
        let exploded_paths =
              (if PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.recursive [DarcsFlag]
opts
                then [AnchoredPath] -> [AnchoredPath]
forall a. [a] -> [a]
reverse ([AnchoredPath] -> [AnchoredPath])
-> ([AnchoredPath] -> [AnchoredPath])
-> [AnchoredPath]
-> [AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree IO -> [AnchoredPath] -> [AnchoredPath]
explodePaths Tree IO
pristine
                else [AnchoredPath] -> [AnchoredPath]
forall a. a -> a
id) [AnchoredPath]
paths
        Sealed p <- makeRemovePatch opts repository exploded_paths pristine
        when (nullFL p && not (null paths)) $
            fail "No files were removed."
        addToPending repository (diffingOpts opts) p
        void $ finalizeRepositoryChanges repository
            (O.dryRun ? opts)
        putInfo opts $ vcat $ map text $ ["Will stop tracking:"] ++
            map displayPath (listTouchedFiles 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 wU wR
                -> [AnchoredPath] -> Tree IO -> IO (Sealed (FL (PrimOf p) wU))
makeRemovePatch :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository rt p wU wR
-> [AnchoredPath]
-> Tree IO
-> IO (Sealed (FL (PrimOf p) wU))
makeRemovePatch [DarcsFlag]
opts Repository rt p wU wR
repository [AnchoredPath]
files Tree IO
pristine = do
  unrecorded <- Repository rt p wU wR
-> UseIndex -> Maybe [AnchoredPath] -> IO (Tree IO)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR
-> UseIndex -> Maybe [AnchoredPath] -> IO (Tree IO)
readUnrecorded Repository rt p wU wR
repository (PrimOptSpec DarcsOptDescr DarcsFlag a UseIndex
PrimDarcsOption UseIndex
O.useIndex PrimDarcsOption UseIndex -> [DarcsFlag] -> UseIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (Maybe [AnchoredPath] -> IO (Tree IO))
-> Maybe [AnchoredPath] -> IO (Tree IO)
forall a b. (a -> b) -> a -> b
$ [AnchoredPath] -> Maybe [AnchoredPath]
forall a. a -> Maybe a
Just [AnchoredPath]
files
  ftf <- filetypeFunction
  result <- foldM removeOnePath (ftf, pristine, unrecorded, []) files
  case result of
    (String -> FileType
_, Tree IO
_, Tree IO
_, [FreeLeft (FL (PrimOf p))]
patches) ->
      Sealed (FL (PrimOf p) wU) -> IO (Sealed (FL (PrimOf p) wU))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL (PrimOf p) wU) -> IO (Sealed (FL (PrimOf p) wU)))
-> Sealed (FL (PrimOf p) wU) -> IO (Sealed (FL (PrimOf p) wU))
forall a b. (a -> b) -> a -> b
$
      FreeLeft (FL (PrimOf p)) -> Sealed (FL (PrimOf p) wU)
forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft (FreeLeft (FL (PrimOf p)) -> Sealed (FL (PrimOf p) wU))
-> FreeLeft (FL (PrimOf p)) -> Sealed (FL (PrimOf p) wU)
forall a b. (a -> b) -> a -> b
$ [FreeLeft (FL (PrimOf p))] -> FreeLeft (FL (PrimOf p))
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
[w (FL p)] -> w (FL p)
concatGapsFL ([FreeLeft (FL (PrimOf p))] -> FreeLeft (FL (PrimOf p)))
-> [FreeLeft (FL (PrimOf p))] -> FreeLeft (FL (PrimOf p))
forall a b. (a -> b) -> a -> b
$ [FreeLeft (FL (PrimOf p))] -> [FreeLeft (FL (PrimOf p))]
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' = Tree IO -> AnchoredPath -> Maybe (TreeItem IO) -> Tree IO
forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> Maybe (TreeItem m) -> Tree m
T.modifyTree Tree IO
recorded AnchoredPath
f Maybe (TreeItem IO)
forall a. Maybe a
Nothing
          unrecorded' :: Tree IO
unrecorded' = Tree IO -> AnchoredPath -> Maybe (TreeItem IO) -> Tree IO
forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> Maybe (TreeItem m) -> Tree m
T.modifyTree Tree IO
unrecorded AnchoredPath
f Maybe (TreeItem IO)
forall a. Maybe a
Nothing
      local <- [DarcsFlag]
-> (String -> FileType)
-> Tree IO
-> Tree IO
-> Tree IO
-> AnchoredPath
-> IO (Maybe (FreeLeft (FL prim)))
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
      return $
        case local of
          Just FreeLeft (FL prim)
gap -> (String -> FileType
ftf, Tree IO
recorded', Tree IO
unrecorded', FreeLeft (FL prim)
gap FreeLeft (FL prim) -> [FreeLeft (FL prim)] -> [FreeLeft (FL prim)]
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 (Tree IO -> AnchoredPath -> Maybe (TreeItem IO)
forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (TreeItem m)
T.find Tree IO
recorded AnchoredPath
path, Tree IO -> AnchoredPath -> Maybe (TreeItem IO)
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(AnchoredPath, TreeItem IO)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Tree IO -> [(AnchoredPath, TreeItem IO)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
T.list Tree IO
unrecordedChildren)
              then String -> IO (Maybe (FreeLeft (FL prim)))
forall {a}. String -> IO (Maybe a)
skipAndWarn String
"it is not empty"
              else Maybe (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim))))
-> Maybe (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim)))
forall a b. (a -> b) -> a -> b
$ FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim))
forall a. a -> Maybe a
Just (FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim)))
-> FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY. FL prim wX wY) -> FreeLeft (FL prim)
forall (p :: * -> * -> *). (forall wX wY. p wX wY) -> FreeLeft p
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> prim wX wY
forall wX wY. AnchoredPath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
rmdir AnchoredPath
path prim wX wY -> FL prim wY wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
        (Just (File Blob IO
_), Just (File Blob IO
_)) -> do
            FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim))
forall a. a -> Maybe a
Just (FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim)))
-> IO (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim)))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DiffAlgorithm
-> (String -> FileType)
-> Tree IO
-> Tree IO
-> IO (FreeLeft (FL prim))
forall (m :: * -> *) (w :: (* -> * -> *) -> *)
       (prim :: * -> * -> *).
(Monad m, Gap w, PrimPatch prim) =>
DiffAlgorithm
-> (String -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff (PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> 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)
_) ->
            Maybe (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim))))
-> Maybe (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim)))
forall a b. (a -> b) -> a -> b
$ FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim))
forall a. a -> Maybe a
Just (FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim)))
-> FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY. FL prim wX wY) -> FreeLeft (FL prim)
forall (p :: * -> * -> *). (forall wX wY. p wX wY) -> FreeLeft p
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> prim wX (ZonkAny 0)
forall wX wY. AnchoredPath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
addfile AnchoredPath
path prim wX (ZonkAny 0) -> FL prim (ZonkAny 0) wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: AnchoredPath -> prim (ZonkAny 0) wY
forall wX wY. AnchoredPath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
rmfile AnchoredPath
path prim (ZonkAny 0) wY -> FL prim wY wY -> FL prim (ZonkAny 0) wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
        (Just (SubTree Tree IO
_), Maybe (TreeItem IO)
_) ->
            Maybe (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return  (Maybe (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim))))
-> Maybe (FreeLeft (FL prim)) -> IO (Maybe (FreeLeft (FL prim)))
forall a b. (a -> b) -> a -> b
$ FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim))
forall a. a -> Maybe a
Just (FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim)))
-> FreeLeft (FL prim) -> Maybe (FreeLeft (FL prim))
forall a b. (a -> b) -> a -> b
$ (forall wX wY. FL prim wX wY) -> FreeLeft (FL prim)
forall (p :: * -> * -> *). (forall wX wY. p wX wY) -> FreeLeft p
forall (w :: (* -> * -> *) -> *) (p :: * -> * -> *).
Gap w =>
(forall wX wY. p wX wY) -> w p
freeGap (AnchoredPath -> prim wX (ZonkAny 1)
forall wX wY. AnchoredPath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
adddir AnchoredPath
path prim wX (ZonkAny 1) -> FL prim (ZonkAny 1) wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: AnchoredPath -> prim (ZonkAny 1) wY
forall wX wY. AnchoredPath -> prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> prim wX wY
rmdir AnchoredPath
path prim (ZonkAny 1) wY -> FL prim wY wY -> FL prim (ZonkAny 1) wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
        (Maybe (TreeItem IO)
_, Maybe (TreeItem IO)
_) -> String -> IO (Maybe (FreeLeft (FL prim)))
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 (Doc -> IO ()) -> (String -> Doc) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Can't remove " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
displayPath AnchoredPath
path
                                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
reason String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
               Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing


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

rmHelp :: Doc
rmHelp :: Doc
rmHelp = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
 String
"The `darcs rm' command does nothing.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"The normal way to remove a file from version control is simply to\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 String
"delete it from the working tree.  To remove a file from version\n" String -> String -> String
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" Maybe DarcsCommand
forall a. Maybe a
Nothing DarcsCommand
remove