{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands.MarkConflicts ( markconflicts ) where
import Darcs.Prelude
import System.Exit ( exitSuccess )
import Data.List.Ordered ( nubSort, isect )
import Control.Monad ( when, unless, void )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.SignalHandler ( withSignalsBlocked )
import Darcs.Util.Path ( AbsolutePath, AnchoredPath, anchorPath )
import Darcs.Util.Printer
( Doc, pathlist, putDocLnWith, text, redText, debugDocLn, vsep, (<+>), ($$) )
import Darcs.Util.Printer.Color ( fancyPrinters )
import Darcs.UI.Commands
( DarcsCommand(..)
, withStdOpts
, nodefaults
, amInHashedRepository
, putInfo
, putFinished
)
import Darcs.UI.Commands.Util ( filterExistingPaths )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.Flags
( DarcsFlag, diffingOpts, verbosity, dryRun, umask
, useCache, pathSetFromArgs )
import Darcs.UI.Options ( (^), odesc, ocheck, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.Flags ( UpdatePending (..) )
import Darcs.Repository
( withRepoLock
, RepoJob(..)
, addToPending
, applyToWorking
, readRepo
, unrecordedChanges )
import Darcs.Patch ( invert, listTouchedFiles, effectOnPaths )
import Darcs.Patch.Show
import Darcs.Patch.TouchesFiles ( chooseTouching )
import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed) )
import Darcs.Repository.Resolution
( StandardResolution(..)
, patchsetConflictResolutions
, warnUnmangled
)
markconflictsDescription :: String
markconflictsDescription :: String
markconflictsDescription =
String
"Mark unresolved conflicts in working tree, for manual resolution."
markconflictsHelp :: Doc
markconflictsHelp :: Doc
markconflictsHelp = String -> Doc
text forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[String
"Darcs requires human guidance to unify changes to the same part of a"
,String
"source file. When a conflict first occurs, darcs will add the"
,String
"initial state and both choices to the working tree, delimited by the"
,String
"markers `v v v`, `=====`, `* * *` and `^ ^ ^`, as follows:"
,String
""
,String
" v v v v v v v"
,String
" Initial state."
,String
" ============="
,String
" First choice."
,String
" *************"
,String
" Second choice."
,String
" ^ ^ ^ ^ ^ ^ ^"
,String
""
,String
"However, you might revert or manually delete these markers without"
,String
"actually resolving the conflict. In this case, `darcs mark-conflicts`"
,String
"is useful to show where are the unresolved conflicts. It is also"
,String
"useful if `darcs apply` or `darcs pull` is called with"
,String
"`--allow-conflicts`, where conflicts aren't marked initially."
,String
""
,String
"Unless you use the `--dry-run` flag, any unrecorded changes to the"
,String
"affected files WILL be lost forever when you run this command!"
,String
"You will be prompted for confirmation before this takes place."
]
markconflicts :: DarcsCommand
markconflicts :: DarcsCommand
markconflicts = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"mark-conflicts"
, commandHelp :: Doc
commandHelp = Doc
markconflictsHelp
, commandDescription :: String
commandDescription = String
markconflictsDescription
, commandExtraArgs :: Int
commandExtraArgs = -Int
1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[FILE or DIRECTORY]..."]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
markconflictsCmd
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
knownFileArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a UMask
markconflictsAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Maybe String -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
markconflictsBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(UseIndex
-> Maybe String
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
markconflictsOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(UseIndex
-> Maybe String
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
markconflictsOpts
}
where
markconflictsBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Maybe String -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
markconflictsBasicOpts
= PrimDarcsOption UseIndex
O.useIndex
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe String)
O.repoDir
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption DiffAlgorithm
O.diffAlgorithm
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
markconflictsAdvancedOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a UMask
markconflictsAdvancedOpts = forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a UMask
O.umask
markconflictsOpts :: DarcsOption
a
(UseIndex
-> Maybe String
-> DiffAlgorithm
-> DryRun
-> XmlOutput
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
markconflictsOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(UseIndex
-> Maybe String -> DiffAlgorithm -> DryRun -> XmlOutput -> a)
markconflictsBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a UMask
markconflictsAdvancedOpts
markconflictsCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
markconflictsCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
markconflictsCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [String]
args = do
Only [AnchoredPath]
paths <- forall a. Maybe a -> Only a
maybeToOnly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AbsolutePath, AbsolutePath)
-> [String] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [String]
args
Doc -> IO ()
debugDocLn forall a b. (a -> b) -> a -> b
$ Doc
"::: paths =" Doc -> Doc -> Doc
<+> (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Only [AnchoredPath]
paths
forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) UpdatePending
YesUpdatePending (forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob forall a b. (a -> b) -> a -> b
$ \Repository rt p wR wU wR
_repository -> do
let (UseIndex
useidx, ScanKnown
scan, DiffAlgorithm
_) = [DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts [DarcsFlag]
opts
verb :: Verbosity
verb = PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
Only ([AnchoredPath], [AnchoredPath])
classified_paths <-
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> Verbosity
-> UseIndex
-> ScanKnown
-> LookForMoves
-> [AnchoredPath]
-> IO ([AnchoredPath], [AnchoredPath])
filterExistingPaths Repository rt p wR wU wR
_repository Verbosity
verb UseIndex
useidx ScanKnown
scan LookForMoves
O.NoLookForMoves) Only [AnchoredPath]
paths
FL (PrimOf p) wR wU
unrecorded <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges ([DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts [DarcsFlag]
opts)
LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces
Repository rt p wR wU wR
_repository (forall a. Only a -> Maybe a
fromOnly forall a. Only a
Everything)
let forward_renames :: [AnchoredPath] -> [AnchoredPath]
forward_renames = forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths FL (PrimOf p) wR wU
unrecorded
backward_renames :: [AnchoredPath] -> [AnchoredPath]
backward_renames = forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wR wU
unrecorded)
existing_paths :: Only [AnchoredPath]
existing_paths = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Only ([AnchoredPath], [AnchoredPath])
classified_paths
pre_pending_paths :: Only [AnchoredPath]
pre_pending_paths = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [AnchoredPath] -> [AnchoredPath]
backward_renames Only [AnchoredPath]
existing_paths
Doc -> IO ()
debugDocLn forall a b. (a -> b) -> a -> b
$ Doc
"::: pre_pending_paths =" Doc -> Doc -> Doc
<+> (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Only [AnchoredPath]
pre_pending_paths
PatchSet rt p Origin wR
r <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
_repository
Sealed FL (PrimOf p) wR wX
res <- case forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
PatchSet rt p Origin wX -> StandardResolution (PrimOf p) wX
patchsetConflictResolutions PatchSet rt p Origin wR
r of
StandardResolution (PrimOf p) wR
conflicts -> do
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
StandardResolution prim wX -> IO ()
warnUnmangled StandardResolution (PrimOf p) wR
conflicts
Sealed FL (PrimOf p) wR wX
mangled_res <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX.
StandardResolution prim wX -> Mangled prim wX
mangled StandardResolution (PrimOf p) wR
conflicts
let raw_res_paths :: Only [AnchoredPath]
raw_res_paths = forall a. Ord a => [a] -> PathSet a
pathSet forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL (PrimOf p) wR wX
mangled_res
Doc -> IO ()
debugDocLn forall a b. (a -> b) -> a -> b
$ Doc
"::: raw_res_paths =" Doc -> Doc -> Doc
<+> (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Only [AnchoredPath]
raw_res_paths
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
Maybe [AnchoredPath] -> FL p wX wY -> Sealed (FL p wX)
chooseTouching (forall a. Only a -> Maybe a
fromOnly Only [AnchoredPath]
pre_pending_paths) FL (PrimOf p) wR wX
mangled_res
let res_paths :: Only [AnchoredPath]
res_paths = forall a. Ord a => [a] -> PathSet a
pathSet forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL (PrimOf p) wR wX
res
Doc -> IO ()
debugDocLn forall a b. (a -> b) -> a -> b
$ Doc
"::: res_paths =" Doc -> Doc -> Doc
<+> (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Only [AnchoredPath]
res_paths
let affected_paths :: Only [AnchoredPath]
affected_paths = Only [AnchoredPath]
res_paths forall a. Ord a => PathSet a -> PathSet a -> PathSet a
`isectPathSet` Only [AnchoredPath]
pre_pending_paths
Doc -> IO ()
debugDocLn forall a b. (a -> b) -> a -> b
$ Doc
"::: affected_paths =" Doc -> Doc -> Doc
<+> (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Only [AnchoredPath]
affected_paths
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Only [AnchoredPath]
affected_paths forall a. Eq a => a -> a -> Bool
== forall a. a -> Only a
Only []) forall a b. (a -> b) -> a -> b
$ do
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
"No conflicts to mark."
forall a. IO a
exitSuccess
FL (PrimOf p) wR wU
to_revert <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges ([DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts [DarcsFlag]
opts)
LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces
Repository rt p wR wU wR
_repository (forall a. Only a -> Maybe a
fromOnly Only [AnchoredPath]
affected_paths)
let post_pending_affected_paths :: Only [AnchoredPath]
post_pending_affected_paths = [AnchoredPath] -> [AnchoredPath]
forward_renames forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Only [AnchoredPath]
affected_paths
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ Doc
"Marking conflicts in:" Doc -> Doc -> Doc
<+> Only [AnchoredPath] -> Doc
showPathSet Only [AnchoredPath]
post_pending_affected_paths forall a. Semigroup a => a -> a -> a
<> Doc
"."
Doc -> IO ()
debugDocLn forall a b. (a -> b) -> a -> b
$ Doc
"::: to_revert =" Doc -> Doc -> Doc
$$ [Doc] -> Doc
vsep (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimOf p) wR wU
to_revert)
Doc -> IO ()
debugDocLn forall a b. (a -> b) -> a -> b
$ Doc
"::: res = " Doc -> Doc -> Doc
$$ [Doc] -> Doc
vsep (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimOf p) wR wX
res)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. YesNo a => a -> Bool
O.yes (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)) forall a b. (a -> b) -> a -> b
$ do
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ Doc
"Conflicts will not be marked: this is a dry run."
forall a. IO a
exitSuccess
Repository rt p wR wR wR
_repository <- case FL (PrimOf p) wR wU
to_revert of
FL (PrimOf p) wR wU
NilFL -> forall (m :: * -> *) a. Monad m => a -> m a
return Repository rt p wR wU wR
_repository
FL (PrimOf p) wR wU
_ -> do
Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters forall a b. (a -> b) -> a -> b
$
Doc
"Warning: This will revert all unrecorded changes in:"
Doc -> Doc -> Doc
<+> Only [AnchoredPath] -> Doc
showPathSet Only [AnchoredPath]
post_pending_affected_paths forall a. Semigroup a => a -> a -> a
<> Doc
"."
Doc -> Doc -> Doc
$$ String -> Doc
redText String
"These changes will be LOST."
Bool
confirmed <- String -> IO Bool
promptYorn String
"Are you sure? "
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed forall a. IO a
exitSuccess
let to_add :: FL (PrimOf p) wU wR
to_add = forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (PrimOf p) wR wU
to_revert
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> UseIndex -> FL (PrimOf p) wU wY -> IO ()
addToPending Repository rt p wR wU wR
_repository (PrimDarcsOption UseIndex
O.useIndex forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wU wR
to_add
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository rt p wR wU wR
_repository (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wU wR
to_add
forall a. IO a -> IO a
withSignalsBlocked forall a b. (a -> b) -> a -> b
$
do forall (p :: * -> * -> *) (rt :: RepoType) wR wU wY.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> UseIndex -> FL (PrimOf p) wU wY -> IO ()
addToPending Repository rt p wR wR wR
_repository (PrimDarcsOption UseIndex
O.useIndex forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wR wX
res
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository rt p wR wR wR
_repository (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) FL (PrimOf p) wR wX
res
[DarcsFlag] -> String -> IO ()
putFinished [DarcsFlag]
opts String
"marking conflicts"
data Only a = Everything | Only a deriving (Only a -> Only a -> Bool
forall a. Eq a => Only a -> Only a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Only a -> Only a -> Bool
$c/= :: forall a. Eq a => Only a -> Only a -> Bool
== :: Only a -> Only a -> Bool
$c== :: forall a. Eq a => Only a -> Only a -> Bool
Eq, Only a -> Only a -> Bool
Only a -> Only a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Only a)
forall a. Ord a => Only a -> Only a -> Bool
forall a. Ord a => Only a -> Only a -> Ordering
forall a. Ord a => Only a -> Only a -> Only a
min :: Only a -> Only a -> Only a
$cmin :: forall a. Ord a => Only a -> Only a -> Only a
max :: Only a -> Only a -> Only a
$cmax :: forall a. Ord a => Only a -> Only a -> Only a
>= :: Only a -> Only a -> Bool
$c>= :: forall a. Ord a => Only a -> Only a -> Bool
> :: Only a -> Only a -> Bool
$c> :: forall a. Ord a => Only a -> Only a -> Bool
<= :: Only a -> Only a -> Bool
$c<= :: forall a. Ord a => Only a -> Only a -> Bool
< :: Only a -> Only a -> Bool
$c< :: forall a. Ord a => Only a -> Only a -> Bool
compare :: Only a -> Only a -> Ordering
$ccompare :: forall a. Ord a => Only a -> Only a -> Ordering
Ord, Int -> Only a -> ShowS
forall a. Show a => Int -> Only a -> ShowS
forall a. Show a => [Only a] -> ShowS
forall a. Show a => Only a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Only a] -> ShowS
$cshowList :: forall a. Show a => [Only a] -> ShowS
show :: Only a -> String
$cshow :: forall a. Show a => Only a -> String
showsPrec :: Int -> Only a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Only a -> ShowS
Show)
instance Functor Only where
fmap :: forall a b. (a -> b) -> Only a -> Only b
fmap a -> b
_ Only a
Everything = forall a. Only a
Everything
fmap a -> b
f (Only a
x) = forall a. a -> Only a
Only (a -> b
f a
x)
instance Foldable Only where
foldMap :: forall m a. Monoid m => (a -> m) -> Only a -> m
foldMap a -> m
_ Only a
Everything = forall a. Monoid a => a
mempty
foldMap a -> m
f (Only a
x) = a -> m
f a
x
instance Traversable Only where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b)
traverse a -> f b
_ Only a
Everything = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Only a
Everything
traverse a -> f b
f (Only a
x) = forall a. a -> Only a
Only forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
fromOnly :: Only a -> Maybe a
fromOnly :: forall a. Only a -> Maybe a
fromOnly Only a
Everything = forall a. Maybe a
Nothing
fromOnly (Only a
x) = forall a. a -> Maybe a
Just a
x
maybeToOnly :: Maybe a -> Only a
maybeToOnly :: forall a. Maybe a -> Only a
maybeToOnly Maybe a
Nothing = forall a. Only a
Everything
maybeToOnly (Just a
x) = forall a. a -> Only a
Only a
x
type PathSet a = Only [a]
isectPathSet :: Ord a => PathSet a -> PathSet a -> PathSet a
isectPathSet :: forall a. Ord a => PathSet a -> PathSet a -> PathSet a
isectPathSet Only [a]
Everything Only [a]
ys = Only [a]
ys
isectPathSet Only [a]
xs Only [a]
Everything = Only [a]
xs
isectPathSet (Only [a]
xs) (Only [a]
ys) = forall a. a -> Only a
Only (forall a. Ord a => [a] -> [a] -> [a]
isect [a]
xs [a]
ys)
pathSet :: Ord a => [a] -> PathSet a
pathSet :: forall a. Ord a => [a] -> PathSet a
pathSet = forall a. a -> Only a
Only forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
nubSort
showPathSet :: PathSet AnchoredPath -> Doc
showPathSet :: Only [AnchoredPath] -> Doc
showPathSet Only [AnchoredPath]
Everything = String -> Doc
text String
"all paths"
showPathSet (Only [AnchoredPath]
xs) = [String] -> Doc
pathlist (forall a b. (a -> b) -> [a] -> [b]
map (String -> AnchoredPath -> String
anchorPath String
"") [AnchoredPath]
xs)