--  Copyright (C) 2002-2003 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 OverloadedStrings #-}

module Darcs.UI.Commands.Record
    ( record
    , commit
    ) where

import Darcs.Prelude

import Control.Exception ( handleJust )
import Control.Monad ( unless, void, when )
import Data.Char ( ord )
import Data.Foldable ( traverse_ )
import System.Directory ( removeFile )
import System.Exit ( ExitCode(..), exitFailure, exitSuccess )

import Darcs.Patch ( PrimOf, RepoPatch, canonizeFL, summaryFL )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Depends ( contextPatches )
import Darcs.Patch.Info ( PatchInfo, patchinfo )
import Darcs.Patch.Named ( adddeps, infopatch )
import Darcs.Patch.PatchInfoAnd ( n2pia )
import Darcs.Patch.Progress ( progressFL )
import Darcs.Patch.Split ( primSplitter )
import Darcs.Patch.Witnesses.Ordered ( (:>)(..), FL(..), nullFL, (+>+) )
import Darcs.Repository
    ( RepoJob(..)
    , Repository
    , AccessType(..)
    , finalizeRepositoryChanges
    , readPendingAndWorking
    , readPristine
    , readPatches
    , tentativelyAddPatch
    , tentativelyRemoveFromPW
    , withRepoLock
    )
import Darcs.Repository.Flags ( UpdatePending(..) )
import Darcs.UI.Commands
    ( DarcsCommand(..)
    , amInHashedRepository
    , commandAlias
    , nodefaults
    , setEnvDarcsFiles
    , setEnvDarcsPatches
    , withStdOpts
    )
import Darcs.UI.Commands.Util
    ( announceFiles
    , filterExistingPaths
    , testTentativeAndMaybeExit
    )
import Darcs.UI.Completion ( modifiedFileArgs )
import Darcs.UI.Flags
    ( DarcsFlag
    , diffingOpts
    , fileHelpAuthor
    , getAuthor
    , getDate
    , pathSetFromArgs
    )
import Darcs.UI.Options ( Config, (?), (^) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.PatchHeader ( getLog )
import Darcs.UI.SelectChanges
    ( WhichChanges(..)
    , askAboutDepends
    , runInvertibleSelection
    , selectionConfigPrim
    )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) )
import Darcs.Util.Exception ( clarifyErrors )
import Darcs.Util.Global ( darcsLastMessage )
import Darcs.Util.Path ( AbsolutePath, AnchoredPath, displayPath )
import Darcs.Util.Printer
    ( Doc
    , formatWords
    , pathlist
    , putDocLn
    , text
    , vcat
    , vsep
    , ($+$)
    , (<+>)
    )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.Tree ( Tree )

recordHelp :: Doc
recordHelp :: Doc
recordHelp =
  [Doc] -> Doc
vsep (([String] -> Doc) -> [[String]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> Doc
formatWords
  [ [ String
"The `darcs record` command is used to create a patch from changes in"
    , String
"the working tree.  If you specify a set of files and directories,"
    , String
"changes to other files will be skipped."
    ]
  , [ String
"Every patch has a name, an optional description, an author and a date."
    ]
  , [ String
"Darcs will launch a text editor (see `darcs help environment`) after the"
    , String
"interactive selection, to let you enter the patch name (first line) and"
    , String
"the patch description (subsequent lines)."
    ]
  , [ String
"You can supply the patch name in advance with the `-m` option, in which"
    , String
"case no text editor is launched, unless you use `--edit-long-comment`."
    ]
  , [ String
"The patch description is an optional block of free-form text.  It is"
    , String
"used to supply additional information that doesn't fit in the patch"
    , String
"name.  For example, it might include a rationale of WHY the change was"
    , String
"necessary."
    ]
  , [ String
"A technical difference between patch name and patch description, is"
    , String
"that matching with the flag `-p` is only done on patch names."
    ]
  , [ String
"Finally, the `--logfile` option allows you to supply a file that already"
    , String
"contains the patch name and description.  This is useful if a previous"
    , String
"record failed and left a `_darcs/patch_description.txt` file."
    ]
  , [String]
fileHelpAuthor
  , [ String
"If you want to manually define any explicit dependencies for your patch,"
    , String
"you can use the `--ask-deps` flag. Some dependencies may be automatically"
    , String
"inferred from the patch's content and cannot be removed. A patch with"
    , String
"specific dependencies can be empty."
    ]
  , [ String
"The patch date is generated automatically.  It can only be spoofed by"
    , String
"using the `--pipe` option."
    ]
  , [ String
"If you run record with the `--pipe` option, you will be prompted for"
    , String
"the patch date, author, and the long comment. The long comment will extend"
    , String
"until the end of file or stdin is reached. This interface is intended for"
    , String
"scripting darcs, in particular for writing repository conversion scripts."
    , String
"The prompts are intended mostly as a useful guide (since scripts won't"
    , String
"need them), to help you understand the input format. Here's an example of"
    , String
"what the `--pipe` prompts look like:"
    ]
  ])
  Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat
    [ Doc
"    What is the date? Mon Nov 15 13:38:01 EST 2004"
    , Doc
"    Who is the author? David Roundy"
    , Doc
"    What is the log? One or more comment lines"
    ]
  Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vsep (([String] -> Doc) -> [[String]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> Doc
formatWords
  [ [ String
"If a test command has been defined with `darcs setpref`, attempting to"
    , String
"record a patch will cause the test command to be run in a clean copy"
    , String
"of the working tree (that is, including only recorded changes).  If"
    , String
"the test fails, you will be offered to abort the record operation."
    ]
  , [ String
"The `--set-scripts-executable` option causes scripts to be made"
    , String
"executable in the clean copy of the working tree, prior to running the"
    , String
"test.  See `darcs clone` for an explanation of the script heuristic."
    ]
  , [ String
"If your test command is tediously slow (e.g. `make all`) and you are"
    , String
"recording several patches in a row, you may wish to use `--no-test` to"
    , String
"skip all but the final test."
    ]
  , [ String
"To see some context (unchanged lines) around each change, use the"
    , String
"`--unified` option."
    ]
  ])

record :: DarcsCommand
record :: DarcsCommand
record = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"record"
    , commandHelp :: Doc
commandHelp = Doc
recordHelp
    , commandDescription :: String
commandDescription = String
"Create a patch from unrecorded changes."
    , commandExtraArgs :: Int
commandExtraArgs = -Int
1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[FILE or DIRECTORY]..."]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
recordCmd
    , 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]
modifiedFileArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
allOpts
    }
  where
    basicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
basicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe String)
PrimDarcsOption (Maybe String)
O.patchname
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe String)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
PrimDarcsOption (Maybe String)
O.author
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
PrimDarcsOption TestChanges
O.testChanges
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
PrimDarcsOption Bool
O.pipe
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
PrimDarcsOption Bool
O.askDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
PrimDarcsOption (Maybe AskLongComment)
O.askLongComment
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForReplaces
      -> LookForMoves -> Maybe String -> DiffAlgorithm -> a)
     (LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForReplaces
      -> LookForMoves -> Maybe String -> DiffAlgorithm -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (LookForReplaces
   -> LookForMoves -> Maybe String -> DiffAlgorithm -> a)
  (LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
PrimDarcsOption LookForAdds
O.lookforadds
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForReplaces
   -> LookForMoves -> Maybe String -> DiffAlgorithm -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForMoves -> Maybe String -> DiffAlgorithm -> a)
     (LookForReplaces
      -> LookForMoves -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (LookForMoves -> Maybe String -> DiffAlgorithm -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (LookForMoves -> Maybe String -> DiffAlgorithm -> a)
  (LookForReplaces
   -> LookForMoves -> Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption LookForReplaces
O.lookforreplaces
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (LookForMoves -> Maybe String -> DiffAlgorithm -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> DiffAlgorithm -> a)
     (LookForMoves -> Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> DiffAlgorithm -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (Maybe String -> DiffAlgorithm -> a)
  (LookForMoves -> Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption LookForMoves
O.lookformoves
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> DiffAlgorithm -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Maybe String -> DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DiffAlgorithm -> a)
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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
  (DiffAlgorithm -> a)
  (Maybe String -> DiffAlgorithm -> a)
PrimDarcsOption (Maybe String)
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DiffAlgorithm -> a)
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Maybe String
      -> Maybe String
      -> TestChanges
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Maybe AskLongComment
      -> LookForAdds
      -> LookForReplaces
      -> LookForMoves
      -> Maybe String
      -> DiffAlgorithm
      -> 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 (DiffAlgorithm -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
    advancedOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Logfile -> UMask -> SetScriptsExecutable -> a)
advancedOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> SetScriptsExecutable -> a)
  Logfile
PrimDarcsOption Logfile
O.logfile
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> SetScriptsExecutable -> a)
  Logfile
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SetScriptsExecutable -> a)
     (UMask -> SetScriptsExecutable -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SetScriptsExecutable -> a)
     (Logfile -> UMask -> SetScriptsExecutable -> 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
  (SetScriptsExecutable -> a)
  (UMask -> SetScriptsExecutable -> a)
PrimDarcsOption UMask
O.umask
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (SetScriptsExecutable -> a)
  (Logfile -> UMask -> SetScriptsExecutable -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (SetScriptsExecutable -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Logfile -> UMask -> SetScriptsExecutable -> 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 (SetScriptsExecutable -> a)
PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable
    allOpts :: CommandOptions
allOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Logfile
   -> UMask
   -> SetScriptsExecutable
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> Logfile
   -> UMask
   -> SetScriptsExecutable
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> a)
basicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Logfile
   -> UMask
   -> SetScriptsExecutable
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe String
   -> Maybe String
   -> TestChanges
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Maybe AskLongComment
   -> LookForAdds
   -> LookForReplaces
   -> LookForMoves
   -> Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> Logfile
   -> UMask
   -> SetScriptsExecutable
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (Logfile
      -> UMask
      -> SetScriptsExecutable
      -> 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])
  (Logfile
   -> UMask
   -> SetScriptsExecutable
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Logfile -> UMask -> SetScriptsExecutable -> a)
advancedOpts

-- | commit is an alias for record
commit :: DarcsCommand
commit :: DarcsCommand
commit = String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias String
"commit" Maybe DarcsCommand
forall a. Maybe a
Nothing DarcsCommand
record

reportNonExisting :: O.LookForAdds -> ([AnchoredPath], [AnchoredPath]) -> IO ()
reportNonExisting :: LookForAdds -> ([AnchoredPath], [AnchoredPath]) -> IO ()
reportNonExisting LookForAdds
lfa ([AnchoredPath]
paths_only_in_working, [AnchoredPath]
_) = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LookForAdds
lfa LookForAdds -> LookForAdds -> Bool
forall a. Eq a => a -> a -> Bool
/= LookForAdds
O.NoLookForAdds Bool -> Bool -> Bool
|| [AnchoredPath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnchoredPath]
paths_only_in_working) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$  Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
    Doc
"These paths are not yet in the repository and will be added:" Doc -> Doc -> Doc
<+>
    [String] -> Doc
pathlist ((AnchoredPath -> String) -> [AnchoredPath] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AnchoredPath -> String
displayPath [AnchoredPath]
paths_only_in_working)

recordCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
recordCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
recordCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
cfg [String]
args = do
    Maybe String -> Bool -> IO ()
checkNameIsNotOption (PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
PrimDarcsOption (Maybe String)
O.patchname PrimDarcsOption (Maybe String) -> [DarcsFlag] -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg) ([DarcsFlag] -> Bool
isInteractive [DarcsFlag]
cfg)
    UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
O.useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
O.umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$ \(Repository 'RW p wU wR
repository :: Repository 'RW p wU wR) -> do
      existing_files <- do
        files <- (AbsolutePath, AbsolutePath)
-> [String] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [String]
args
        files' <-
          traverse
            (filterExistingPaths repository (O.verbosity ? cfg) (diffingOpts cfg)) files
        when (O.verbosity ? cfg /= O.Quiet) $
            traverse_ (reportNonExisting (O.lookforadds ? cfg)) files'
        let files'' = (([AnchoredPath], [AnchoredPath]) -> [AnchoredPath])
-> Maybe ([AnchoredPath], [AnchoredPath]) -> Maybe [AnchoredPath]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([AnchoredPath], [AnchoredPath]) -> [AnchoredPath]
forall a b. (a, b) -> b
snd Maybe ([AnchoredPath], [AnchoredPath])
files'
        when (files'' == Just []) $
            fail "None of the files you specified exist."
        return files''
      announceFiles (O.verbosity ? cfg) existing_files "Recording changes in"
      debugMessage "About to get the unrecorded changes."
      changes <-
        readPendingAndWorking (diffingOpts cfg) repository existing_files
      case changes of
          FL (PrimOf p) wR wZ
NilFL :> FL (PrimOf p) wZ wU
NilFL | Bool -> Bool
not (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.askDeps PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg) -> do
              -- We need to grab any input waiting for us, since we
              -- might break scripts expecting to send it to us; we
              -- don't care what that input is, though.
              IO String -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Bool -> IO String
getDate (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.pipe PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg))
              String -> IO ()
putStrLn String
"No changes!"
              IO ()
forall a. IO a
exitFailure
          (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
_ -> Repository 'RW p wU wR
-> [DarcsFlag]
-> Maybe [AnchoredPath]
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
-> IO ()
forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR
-> [DarcsFlag]
-> Maybe [AnchoredPath]
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
-> IO ()
doRecord Repository 'RW p wU wR
repository [DarcsFlag]
cfg Maybe [AnchoredPath]
existing_files (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
changes

-- | Check user specified patch name is not accidentally a command line flag
checkNameIsNotOption :: Maybe String -> Bool -> IO ()
checkNameIsNotOption :: Maybe String -> Bool -> IO ()
checkNameIsNotOption Maybe String
Nothing     Bool
_      = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkNameIsNotOption Maybe String
_           Bool
False  = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkNameIsNotOption (Just String
name) Bool
True   =
  case String
name of
    [Char
_] -> IO ()
warnPatchName
    (Char
'-':String
_) -> IO ()
warnPatchName
    String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    warnPatchName :: IO ()
warnPatchName = do
        confirmed <- String -> IO Bool
promptYorn (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
"You specified " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" as the patch name. Is that really what you want?"
        unless confirmed $ putStrLn "Okay, aborting the record." >> exitFailure

doRecord :: (RepoPatch p, ApplyState p ~ Tree)
         => Repository 'RW p wU wR -> Config -> Maybe [AnchoredPath]
         -> (FL (PrimOf p) :> FL (PrimOf p)) wR wU -> IO ()
doRecord :: forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR
-> [DarcsFlag]
-> Maybe [AnchoredPath]
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
-> IO ()
doRecord Repository 'RW p wU wR
repository [DarcsFlag]
cfg Maybe [AnchoredPath]
files pw :: (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
pw@(FL (PrimOf p) wR wZ
pending :> FL (PrimOf p) wZ wU
working) = do
    String -> IO ()
debugMessage String
"I've got unrecorded changes."
    date <- Bool -> IO String
getDate (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.pipe PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg)
    my_author <- getAuthor (O.author ? cfg) (O.pipe ? cfg)
    debugMessage "I'm slurping the repository."
    debugMessage "About to select changes..."
    let da = PrimOptSpec DarcsOptDescr DarcsFlag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm PrimDarcsOption DiffAlgorithm -> [DarcsFlag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg
    (chs :> _ ) <- runInvertibleSelection (canonizeFL da $ pending +>+ working) $
                      selectionConfigPrim
                          First "record" (patchSelOpts cfg)
                          (Just (primSplitter (O.diffAlgorithm ? cfg)))
                          files
    when (not (O.askDeps ? cfg) && nullFL chs) $
              do putStrLn "Ok, if you don't want to record anything, that's fine!"
                 exitSuccess
    handleJust onlySuccessfulExits (\()
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) $
             do deps <- if O.askDeps ? cfg
                        then do
                          _ :> patches <- contextPatches <$> readPatches repository
                          askAboutDepends patches chs (patchSelOpts cfg) []
                        else return []
                when (O.askDeps ? cfg) $ debugMessage "I've asked about dependencies."
                if nullFL chs && null deps
                  then putStrLn "Ok, if you don't want to record anything, that's fine!"
                  else do setEnvDarcsFiles chs
                          (name, my_log, logf) <-
                            getLog (O.patchname ? cfg) (O.pipe ? cfg)
                              (O.logfile ? cfg) (O.askLongComment ? cfg)
                              Nothing (summaryFL chs)
                          debugMessage ("Patch name as received from getLog: " ++ show (map ord name))
                          doActualRecord repository cfg name date my_author my_log logf deps chs pw

doActualRecord :: (RepoPatch p, ApplyState p ~ Tree)
               => Repository 'RW p wU wR
               -> Config
               -> String -> String -> String
               -> [String] -> Maybe String
               -> [PatchInfo] -> FL (PrimOf p) wR wX
               -> (FL (PrimOf p) :> FL (PrimOf p)) wR wU -> IO ()
doActualRecord :: forall (p :: * -> * -> *) wU wR wX.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR
-> [DarcsFlag]
-> String
-> String
-> String
-> [String]
-> Maybe String
-> [PatchInfo]
-> FL (PrimOf p) wR wX
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
-> IO ()
doActualRecord Repository 'RW p wU wR
_repository [DarcsFlag]
cfg String
name String
date String
my_author [String]
my_log Maybe String
logf [PatchInfo]
deps FL (PrimOf p) wR wX
chs
      (FL (PrimOf p) wR wZ
pending :> FL (PrimOf p) wZ wU
working) = do
    String -> IO ()
debugMessage String
"Writing the patch file..."
    myinfo <- String -> String -> String -> [String] -> IO PatchInfo
patchinfo String
date String
name String
my_author [String]
my_log
    let mypatch = PatchInfo -> FL (PrimOf p) wR wX -> Named p wR wX
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
myinfo (FL (PrimOf p) wR wX -> Named p wR wX)
-> FL (PrimOf p) wR wX -> Named p wR wX
forall a b. (a -> b) -> a -> b
$ String -> FL (PrimOf p) wR wX -> FL (PrimOf p) wR wX
forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL String
"Writing changes" FL (PrimOf p) wR wX
chs
    let pia = Named p wR wX -> PatchInfoAndG (Named p) wR wX
forall (p :: * -> * -> *) wX wY.
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG p wX wY
n2pia (Named p wR wX -> PatchInfoAndG (Named p) wR wX)
-> Named p wR wX -> PatchInfoAndG (Named p) wR wX
forall a b. (a -> b) -> a -> b
$ Named p wR wX -> [PatchInfo] -> Named p wR wX
forall (p :: * -> * -> *) wX wY.
Named p wX wY -> [PatchInfo] -> Named p wX wY
adddeps Named p wR wX
mypatch [PatchInfo]
deps
    _repository <-
      tentativelyAddPatch _repository NoUpdatePending pia
    tp <- readPristine _repository
    testTentativeAndMaybeExit tp cfg
      ("you have a bad patch: '" ++ name ++ "'")
      "record it" (Just failuremessage)
    tentativelyRemoveFromPW _repository chs pending working
    _repository <-
      finalizeRepositoryChanges _repository (O.dryRun ? cfg)
      `clarifyErrors` failuremessage
    debugMessage "Syncing timestamps..."
    removeLogFile logf
    unless (O.verbosity ? cfg == O.Quiet) $
      putDocLn $ text $ "Finished recording patch '" ++ name ++ "'"
    setEnvDarcsPatches (pia :>: NilFL)
  where
    removeLogFile :: Maybe String -> IO ()
    removeLogFile :: Maybe String -> IO ()
removeLogFile Maybe String
Nothing = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    removeLogFile (Just String
lf)
      | String
lf String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
darcsLastMessage = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> IO ()
removeFile String
lf
    failuremessage :: String
failuremessage =
      String
"Failed to record patch '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++
        case Maybe String
logf of
          Just String
lf -> String
"\nLogfile left in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
          Maybe String
Nothing -> String
""

onlySuccessfulExits :: ExitCode -> Maybe ()
onlySuccessfulExits :: ExitCode -> Maybe ()
onlySuccessfulExits ExitCode
ExitSuccess = () -> Maybe ()
forall a. a -> Maybe a
Just ()
onlySuccessfulExits ExitCode
_ = Maybe ()
forall a. Maybe a
Nothing

patchSelOpts :: Config -> S.PatchSelectionOptions
patchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
cfg = S.PatchSelectionOptions
    { verbosity :: Verbosity
S.verbosity = PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
O.verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg
    , matchFlags :: [MatchFlag]
S.matchFlags = []
    , interactive :: Bool
S.interactive = [DarcsFlag] -> Bool
isInteractive [DarcsFlag]
cfg
    , selectDeps :: SelectDeps
S.selectDeps = SelectDeps
O.PromptDeps -- option not supported, use default
    , withSummary :: WithSummary
S.withSummary = WithSummary
O.NoSummary -- option not supported, use default
    }

isInteractive :: Config -> Bool
isInteractive :: [DarcsFlag] -> Bool
isInteractive [DarcsFlag]
cfg = Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Bool -> Bool
forall a. a -> a
id (PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe Bool)
PrimDarcsOption (Maybe Bool)
O.interactive PrimDarcsOption (Maybe Bool) -> [DarcsFlag] -> Maybe Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg)