{-# 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 :: 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
Maybe [AnchoredPath]
existing_files <- do
Maybe [AnchoredPath]
files <- (AbsolutePath, AbsolutePath)
-> [String] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [String]
args
Maybe ([AnchoredPath], [AnchoredPath])
files' <-
([AnchoredPath] -> IO ([AnchoredPath], [AnchoredPath]))
-> Maybe [AnchoredPath]
-> IO (Maybe ([AnchoredPath], [AnchoredPath]))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse
(Repository 'RW p wU wR
-> Verbosity
-> DiffOpts
-> [AnchoredPath]
-> IO ([AnchoredPath], [AnchoredPath])
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR
-> Verbosity
-> DiffOpts
-> [AnchoredPath]
-> IO ([AnchoredPath], [AnchoredPath])
filterExistingPaths Repository 'RW p wU wR
repository (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) ([DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
cfg)) Maybe [AnchoredPath]
files
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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 Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
/= Verbosity
O.Quiet) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(([AnchoredPath], [AnchoredPath]) -> IO ())
-> Maybe ([AnchoredPath], [AnchoredPath]) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (LookForAdds -> ([AnchoredPath], [AnchoredPath]) -> IO ()
reportNonExisting (PrimOptSpec DarcsOptDescr DarcsFlag a LookForAdds
PrimDarcsOption LookForAdds
O.lookforadds PrimDarcsOption LookForAdds -> [DarcsFlag] -> LookForAdds
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg)) Maybe ([AnchoredPath], [AnchoredPath])
files'
let files'' :: Maybe [AnchoredPath]
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'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe [AnchoredPath]
files'' Maybe [AnchoredPath] -> Maybe [AnchoredPath] -> Bool
forall a. Eq a => a -> a -> Bool
== [AnchoredPath] -> Maybe [AnchoredPath]
forall a. a -> Maybe a
Just []) (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
"None of the files you specified exist."
Maybe [AnchoredPath] -> IO (Maybe [AnchoredPath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [AnchoredPath]
files''
Verbosity -> Maybe [AnchoredPath] -> String -> IO ()
announceFiles (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) Maybe [AnchoredPath]
existing_files String
"Recording changes in"
String -> IO ()
debugMessage String
"About to get the unrecorded changes."
(:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
changes <-
DiffOpts
-> Repository 'RW p wU wR
-> Maybe [AnchoredPath]
-> IO ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU)
readPendingAndWorking ([DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
cfg) Repository 'RW p wU wR
repository Maybe [AnchoredPath]
existing_files
case (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
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
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
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
Bool
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?"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Okay, aborting the record." IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
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."
String
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)
String
my_author <- Maybe String -> Bool -> IO String
getAuthor (PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
PrimDarcsOption (Maybe String)
O.author PrimDarcsOption (Maybe String) -> [DarcsFlag] -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg) (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 ()
debugMessage String
"I'm slurping the repository."
String -> IO ()
debugMessage String
"About to select changes..."
let da :: DiffAlgorithm
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
(FL (PrimOf p) wR wZ
chs :> FL (PrimOf p) wZ wU
_ ) <- FL (PrimOf p) wR wU
-> SelectionConfig (PrimOf p)
-> IO ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU)
forall (p :: * -> * -> *) wX wY.
(Invert p, MatchableRP p, ShowPatch p, ShowContextPatch p,
ApplyState p ~ Tree) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runInvertibleSelection (DiffAlgorithm -> FL (PrimOf p) wR wU -> FL (PrimOf p) wR wU
forall (prim :: * -> * -> *) wX wY.
(IsHunk prim, PrimCoalesce prim, PrimConstruct prim) =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da (FL (PrimOf p) wR wU -> FL (PrimOf p) wR wU)
-> FL (PrimOf p) wR wU -> FL (PrimOf p) wR wU
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wR wZ
pending FL (PrimOf p) wR wZ -> FL (PrimOf p) wZ wU -> FL (PrimOf p) wR wU
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PrimOf p) wZ wU
working) (SelectionConfig (PrimOf p)
-> IO ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU))
-> SelectionConfig (PrimOf p)
-> IO ((:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU)
forall a b. (a -> b) -> a -> b
$
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PrimOf p))
-> Maybe [AnchoredPath]
-> SelectionConfig (PrimOf p)
forall (prim :: * -> * -> *).
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter prim)
-> Maybe [AnchoredPath]
-> SelectionConfig prim
selectionConfigPrim
WhichChanges
First String
"record" ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
cfg)
(Splitter (PrimOf p) -> Maybe (Splitter (PrimOf p))
forall a. a -> Maybe a
Just (DiffAlgorithm -> Splitter (PrimOf p)
forall (p :: * -> * -> *).
PrimPatch p =>
DiffAlgorithm -> Splitter p
primSplitter (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)))
Maybe [AnchoredPath]
files
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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) Bool -> Bool -> Bool
&& FL (PrimOf p) wR wZ -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PrimOf p) wR wZ
chs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do String -> IO ()
putStrLn String
"Ok, if you don't want to record anything, that's fine!"
IO ()
forall a. IO a
exitSuccess
(ExitCode -> Maybe ()) -> (() -> IO ()) -> IO () -> IO ()
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust ExitCode -> Maybe ()
onlySuccessfulExits (\()
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do [PatchInfo]
deps <- if 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
then do
PatchSet p Origin wZ
_ :> RL (PatchInfoAnd p) wZ wR
patches <- PatchSet p Origin wR
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wR
forall (p :: * -> * -> *) wX wY.
PatchSet p wX wY -> (:>) (PatchSet p) (RL (PatchInfoAnd p)) wX wY
contextPatches (PatchSet p Origin wR
-> (:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wR)
-> IO (PatchSet p Origin wR)
-> IO ((:>) (PatchSet p) (RL (PatchInfoAnd p)) Origin wR)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository 'RW p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository 'RW p wU wR
repository
RL (PatchInfoAnd p) wZ wR
-> FL (PrimOf p) wR wZ
-> PatchSelectionOptions
-> [PatchInfo]
-> IO [PatchInfo]
forall (p :: * -> * -> *) wX wR wT.
(RepoPatch p, ApplyState p ~ Tree) =>
RL (PatchInfoAnd p) wX wR
-> FL (PrimOf p) wR wT
-> PatchSelectionOptions
-> [PatchInfo]
-> IO [PatchInfo]
askAboutDepends RL (PatchInfoAnd p) wZ wR
patches FL (PrimOf p) wR wZ
chs ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
cfg) []
else [PatchInfo] -> IO [PatchInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
debugMessage String
"I've asked about dependencies."
if FL (PrimOf p) wR wZ -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PrimOf p) wR wZ
chs Bool -> Bool -> Bool
&& [PatchInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PatchInfo]
deps
then String -> IO ()
putStrLn String
"Ok, if you don't want to record anything, that's fine!"
else do FL (PrimOf p) wR wZ -> IO ()
forall (p :: * -> * -> *) wX wY. PatchInspect p => p wX wY -> IO ()
setEnvDarcsFiles FL (PrimOf p) wR wZ
chs
(String
name, [String]
my_log, Maybe String
logf) <-
Maybe String
-> Bool
-> Logfile
-> Maybe AskLongComment
-> Maybe (String, [String])
-> Doc
-> IO (String, [String], Maybe String)
getLog (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) (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)
(PrimOptSpec DarcsOptDescr DarcsFlag a Logfile
PrimDarcsOption Logfile
O.logfile PrimDarcsOption Logfile -> [DarcsFlag] -> Logfile
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg) (PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AskLongComment)
PrimDarcsOption (Maybe AskLongComment)
O.askLongComment PrimDarcsOption (Maybe AskLongComment)
-> [DarcsFlag] -> Maybe AskLongComment
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg)
Maybe (String, [String])
forall a. Maybe a
Nothing (FL (PrimOf p) wR wZ -> Doc
forall wX wY. FL (PrimOf p) wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => FL p wX wY -> Doc
summaryFL FL (PrimOf p) wR wZ
chs)
String -> IO ()
debugMessage (String
"Patch name as received from getLog: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show ((Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
ord String
name))
Repository 'RW p wU wR
-> [DarcsFlag]
-> String
-> String
-> String
-> [String]
-> Maybe String
-> [PatchInfo]
-> FL (PrimOf p) wR wZ
-> (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
-> IO ()
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 wZ
chs (:>) (FL (PrimOf p)) (FL (PrimOf p)) wR wU
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..."
PatchInfo
myinfo <- String -> String -> String -> [String] -> IO PatchInfo
patchinfo String
date String
name String
my_author [String]
my_log
let mypatch :: Named p wR wX
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 :: PatchInfoAndG (Named p) wR wX
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 'RW p wU wX
_repository <-
Repository 'RW p wU wR
-> UpdatePending
-> PatchInfoAndG (Named p) wR wX
-> IO (Repository 'RW p wU wX)
forall (p :: * -> * -> *) wU wR wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR
-> UpdatePending
-> PatchInfoAnd p wR wY
-> IO (Repository 'RW p wU wY)
tentativelyAddPatch Repository 'RW p wU wR
_repository UpdatePending
NoUpdatePending PatchInfoAndG (Named p) wR wX
pia
Tree IO
tp <- Repository 'RW p wU wX -> IO (Tree IO)
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO (Tree IO)
readPristine Repository 'RW p wU wX
_repository
Tree IO -> [DarcsFlag] -> String -> String -> Maybe String -> IO ()
testTentativeAndMaybeExit Tree IO
tp [DarcsFlag]
cfg
(String
"you have a bad patch: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'")
String
"record it" (String -> Maybe String
forall a. a -> Maybe a
Just String
failuremessage)
Repository 'RW p wU wX
-> FL (PrimOf p) wR wX
-> FL (PrimOf p) wR wZ
-> FL (PrimOf p) wZ wU
-> IO ()
forall (p :: * -> * -> *) wR wO wP wU.
RepoPatch p =>
Repository 'RW p wU wR
-> FL (PrimOf p) wO wR
-> FL (PrimOf p) wO wP
-> FL (PrimOf p) wP wU
-> IO ()
tentativelyRemoveFromPW Repository 'RW p wU wX
_repository FL (PrimOf p) wR wX
chs FL (PrimOf p) wR wZ
pending FL (PrimOf p) wZ wU
working
Repository 'RO p wU wX
_repository <-
Repository 'RW p wU wX -> DryRun -> IO (Repository 'RO p wU wX)
forall (p :: * -> * -> *) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RW p wU wR -> DryRun -> IO (Repository 'RO p wU wR)
finalizeRepositoryChanges Repository 'RW p wU wX
_repository (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
cfg)
IO (Repository 'RO p wU wX)
-> String -> IO (Repository 'RO p wU wX)
forall a. IO a -> String -> IO a
`clarifyErrors` String
failuremessage
String -> IO ()
debugMessage String
"Syncing timestamps..."
Maybe String -> IO ()
removeLogFile Maybe String
logf
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (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 Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
O.Quiet) (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
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Finished recording patch '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
FL (PatchInfoAnd p) wR wX -> IO ()
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
FL (PatchInfoAnd p) wX wY -> IO ()
setEnvDarcsPatches (PatchInfoAndG (Named p) wR wX
pia PatchInfoAndG (Named p) wR wX
-> FL (PatchInfoAnd p) wX wX -> FL (PatchInfoAnd p) wR wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (PatchInfoAnd p) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
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
, withSummary :: WithSummary
S.withSummary = WithSummary
O.NoSummary
}
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)