module Darcs.Repository.Flags
    ( RemoteDarcs (..)
    , remoteDarcs
    , Reorder (..)
    , Verbosity (..)
    , UpdatePending (..)
    , UseCache (..)
    , DryRun (..)
    , UMask (..)
    , LookForAdds (..)
    , LookForReplaces (..)
    , DiffAlgorithm (..)
    , LookForMoves (..)
    , DiffOpts (..)
    , RunTest (..)
    , SetScriptsExecutable (..)
    , LeaveTestDir (..)
    , SetDefault (..)
    , InheritDefault (..)
    , UseIndex (..)
    , CloneKind (..)
    , AllowConflicts (..)
    , ResolveConflicts (..)
    , WorkRepo (..)
    , WantGuiPause (..)
    , WithPatchIndex (..)
    , WithWorkingDir (..)
    , ForgetParent (..)
    , PatchFormat (..)
    , WithPrefsTemplates (..)
    , OptimizeDeep (..)
    ) where

import Darcs.Prelude

import Darcs.Util.Diff ( DiffAlgorithm(..) )
import Darcs.Util.Global ( defaultRemoteDarcsCmd )

data Verbosity = Quiet | NormalVerbosity | Verbose
    deriving ( Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
/= :: Verbosity -> Verbosity -> Bool
Eq, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verbosity -> ShowS
showsPrec :: Int -> Verbosity -> ShowS
$cshow :: Verbosity -> String
show :: Verbosity -> String
$cshowList :: [Verbosity] -> ShowS
showList :: [Verbosity] -> ShowS
Show )

data WithPatchIndex = YesPatchIndex | NoPatchIndex
    deriving ( WithPatchIndex -> WithPatchIndex -> Bool
(WithPatchIndex -> WithPatchIndex -> Bool)
-> (WithPatchIndex -> WithPatchIndex -> Bool) -> Eq WithPatchIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WithPatchIndex -> WithPatchIndex -> Bool
== :: WithPatchIndex -> WithPatchIndex -> Bool
$c/= :: WithPatchIndex -> WithPatchIndex -> Bool
/= :: WithPatchIndex -> WithPatchIndex -> Bool
Eq, Int -> WithPatchIndex -> ShowS
[WithPatchIndex] -> ShowS
WithPatchIndex -> String
(Int -> WithPatchIndex -> ShowS)
-> (WithPatchIndex -> String)
-> ([WithPatchIndex] -> ShowS)
-> Show WithPatchIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WithPatchIndex -> ShowS
showsPrec :: Int -> WithPatchIndex -> ShowS
$cshow :: WithPatchIndex -> String
show :: WithPatchIndex -> String
$cshowList :: [WithPatchIndex] -> ShowS
showList :: [WithPatchIndex] -> ShowS
Show )

data RemoteDarcs = RemoteDarcs String
                 | DefaultRemoteDarcs
    deriving ( RemoteDarcs -> RemoteDarcs -> Bool
(RemoteDarcs -> RemoteDarcs -> Bool)
-> (RemoteDarcs -> RemoteDarcs -> Bool) -> Eq RemoteDarcs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteDarcs -> RemoteDarcs -> Bool
== :: RemoteDarcs -> RemoteDarcs -> Bool
$c/= :: RemoteDarcs -> RemoteDarcs -> Bool
/= :: RemoteDarcs -> RemoteDarcs -> Bool
Eq, Int -> RemoteDarcs -> ShowS
[RemoteDarcs] -> ShowS
RemoteDarcs -> String
(Int -> RemoteDarcs -> ShowS)
-> (RemoteDarcs -> String)
-> ([RemoteDarcs] -> ShowS)
-> Show RemoteDarcs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteDarcs -> ShowS
showsPrec :: Int -> RemoteDarcs -> ShowS
$cshow :: RemoteDarcs -> String
show :: RemoteDarcs -> String
$cshowList :: [RemoteDarcs] -> ShowS
showList :: [RemoteDarcs] -> ShowS
Show )

remoteDarcs :: RemoteDarcs -> String
remoteDarcs :: RemoteDarcs -> String
remoteDarcs RemoteDarcs
DefaultRemoteDarcs = String
defaultRemoteDarcsCmd
remoteDarcs (RemoteDarcs String
x) = String
x

data Reorder = NoReorder | Reorder
    deriving ( Reorder -> Reorder -> Bool
(Reorder -> Reorder -> Bool)
-> (Reorder -> Reorder -> Bool) -> Eq Reorder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reorder -> Reorder -> Bool
== :: Reorder -> Reorder -> Bool
$c/= :: Reorder -> Reorder -> Bool
/= :: Reorder -> Reorder -> Bool
Eq )

data UpdatePending = YesUpdatePending | NoUpdatePending
    deriving ( UpdatePending -> UpdatePending -> Bool
(UpdatePending -> UpdatePending -> Bool)
-> (UpdatePending -> UpdatePending -> Bool) -> Eq UpdatePending
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdatePending -> UpdatePending -> Bool
== :: UpdatePending -> UpdatePending -> Bool
$c/= :: UpdatePending -> UpdatePending -> Bool
/= :: UpdatePending -> UpdatePending -> Bool
Eq, Int -> UpdatePending -> ShowS
[UpdatePending] -> ShowS
UpdatePending -> String
(Int -> UpdatePending -> ShowS)
-> (UpdatePending -> String)
-> ([UpdatePending] -> ShowS)
-> Show UpdatePending
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdatePending -> ShowS
showsPrec :: Int -> UpdatePending -> ShowS
$cshow :: UpdatePending -> String
show :: UpdatePending -> String
$cshowList :: [UpdatePending] -> ShowS
showList :: [UpdatePending] -> ShowS
Show )

data UseCache = YesUseCache | NoUseCache
    deriving ( UseCache -> UseCache -> Bool
(UseCache -> UseCache -> Bool)
-> (UseCache -> UseCache -> Bool) -> Eq UseCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UseCache -> UseCache -> Bool
== :: UseCache -> UseCache -> Bool
$c/= :: UseCache -> UseCache -> Bool
/= :: UseCache -> UseCache -> Bool
Eq, Int -> UseCache -> ShowS
[UseCache] -> ShowS
UseCache -> String
(Int -> UseCache -> ShowS)
-> (UseCache -> String) -> ([UseCache] -> ShowS) -> Show UseCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UseCache -> ShowS
showsPrec :: Int -> UseCache -> ShowS
$cshow :: UseCache -> String
show :: UseCache -> String
$cshowList :: [UseCache] -> ShowS
showList :: [UseCache] -> ShowS
Show )

data DryRun = YesDryRun | NoDryRun
    deriving ( DryRun -> DryRun -> Bool
(DryRun -> DryRun -> Bool)
-> (DryRun -> DryRun -> Bool) -> Eq DryRun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DryRun -> DryRun -> Bool
== :: DryRun -> DryRun -> Bool
$c/= :: DryRun -> DryRun -> Bool
/= :: DryRun -> DryRun -> Bool
Eq, Int -> DryRun -> ShowS
[DryRun] -> ShowS
DryRun -> String
(Int -> DryRun -> ShowS)
-> (DryRun -> String) -> ([DryRun] -> ShowS) -> Show DryRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DryRun -> ShowS
showsPrec :: Int -> DryRun -> ShowS
$cshow :: DryRun -> String
show :: DryRun -> String
$cshowList :: [DryRun] -> ShowS
showList :: [DryRun] -> ShowS
Show )

data UMask = YesUMask String | NoUMask
    deriving ( UMask -> UMask -> Bool
(UMask -> UMask -> Bool) -> (UMask -> UMask -> Bool) -> Eq UMask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UMask -> UMask -> Bool
== :: UMask -> UMask -> Bool
$c/= :: UMask -> UMask -> Bool
/= :: UMask -> UMask -> Bool
Eq, Int -> UMask -> ShowS
[UMask] -> ShowS
UMask -> String
(Int -> UMask -> ShowS)
-> (UMask -> String) -> ([UMask] -> ShowS) -> Show UMask
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UMask -> ShowS
showsPrec :: Int -> UMask -> ShowS
$cshow :: UMask -> String
show :: UMask -> String
$cshowList :: [UMask] -> ShowS
showList :: [UMask] -> ShowS
Show )

data LookForAdds = NoLookForAdds | YesLookForAdds | EvenLookForBoring
    deriving ( LookForAdds -> LookForAdds -> Bool
(LookForAdds -> LookForAdds -> Bool)
-> (LookForAdds -> LookForAdds -> Bool) -> Eq LookForAdds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LookForAdds -> LookForAdds -> Bool
== :: LookForAdds -> LookForAdds -> Bool
$c/= :: LookForAdds -> LookForAdds -> Bool
/= :: LookForAdds -> LookForAdds -> Bool
Eq, Int -> LookForAdds -> ShowS
[LookForAdds] -> ShowS
LookForAdds -> String
(Int -> LookForAdds -> ShowS)
-> (LookForAdds -> String)
-> ([LookForAdds] -> ShowS)
-> Show LookForAdds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LookForAdds -> ShowS
showsPrec :: Int -> LookForAdds -> ShowS
$cshow :: LookForAdds -> String
show :: LookForAdds -> String
$cshowList :: [LookForAdds] -> ShowS
showList :: [LookForAdds] -> ShowS
Show )

data LookForReplaces = YesLookForReplaces | NoLookForReplaces
    deriving ( LookForReplaces -> LookForReplaces -> Bool
(LookForReplaces -> LookForReplaces -> Bool)
-> (LookForReplaces -> LookForReplaces -> Bool)
-> Eq LookForReplaces
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LookForReplaces -> LookForReplaces -> Bool
== :: LookForReplaces -> LookForReplaces -> Bool
$c/= :: LookForReplaces -> LookForReplaces -> Bool
/= :: LookForReplaces -> LookForReplaces -> Bool
Eq, Int -> LookForReplaces -> ShowS
[LookForReplaces] -> ShowS
LookForReplaces -> String
(Int -> LookForReplaces -> ShowS)
-> (LookForReplaces -> String)
-> ([LookForReplaces] -> ShowS)
-> Show LookForReplaces
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LookForReplaces -> ShowS
showsPrec :: Int -> LookForReplaces -> ShowS
$cshow :: LookForReplaces -> String
show :: LookForReplaces -> String
$cshowList :: [LookForReplaces] -> ShowS
showList :: [LookForReplaces] -> ShowS
Show )

data LookForMoves = YesLookForMoves | NoLookForMoves
    deriving ( LookForMoves -> LookForMoves -> Bool
(LookForMoves -> LookForMoves -> Bool)
-> (LookForMoves -> LookForMoves -> Bool) -> Eq LookForMoves
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LookForMoves -> LookForMoves -> Bool
== :: LookForMoves -> LookForMoves -> Bool
$c/= :: LookForMoves -> LookForMoves -> Bool
/= :: LookForMoves -> LookForMoves -> Bool
Eq, Int -> LookForMoves -> ShowS
[LookForMoves] -> ShowS
LookForMoves -> String
(Int -> LookForMoves -> ShowS)
-> (LookForMoves -> String)
-> ([LookForMoves] -> ShowS)
-> Show LookForMoves
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LookForMoves -> ShowS
showsPrec :: Int -> LookForMoves -> ShowS
$cshow :: LookForMoves -> String
show :: LookForMoves -> String
$cshowList :: [LookForMoves] -> ShowS
showList :: [LookForMoves] -> ShowS
Show )

data DiffOpts = DiffOpts
  { DiffOpts -> UseIndex
withIndex :: UseIndex
  , DiffOpts -> LookForAdds
lookForAdds :: LookForAdds
  , DiffOpts -> LookForReplaces
lookForReplaces :: LookForReplaces
  , DiffOpts -> LookForMoves
lookForMoves :: LookForMoves
  , DiffOpts -> DiffAlgorithm
diffAlg :: DiffAlgorithm
  } deriving Int -> DiffOpts -> ShowS
[DiffOpts] -> ShowS
DiffOpts -> String
(Int -> DiffOpts -> ShowS)
-> (DiffOpts -> String) -> ([DiffOpts] -> ShowS) -> Show DiffOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiffOpts -> ShowS
showsPrec :: Int -> DiffOpts -> ShowS
$cshow :: DiffOpts -> String
show :: DiffOpts -> String
$cshowList :: [DiffOpts] -> ShowS
showList :: [DiffOpts] -> ShowS
Show

data RunTest = YesRunTest | NoRunTest
    deriving ( RunTest -> RunTest -> Bool
(RunTest -> RunTest -> Bool)
-> (RunTest -> RunTest -> Bool) -> Eq RunTest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunTest -> RunTest -> Bool
== :: RunTest -> RunTest -> Bool
$c/= :: RunTest -> RunTest -> Bool
/= :: RunTest -> RunTest -> Bool
Eq, Int -> RunTest -> ShowS
[RunTest] -> ShowS
RunTest -> String
(Int -> RunTest -> ShowS)
-> (RunTest -> String) -> ([RunTest] -> ShowS) -> Show RunTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunTest -> ShowS
showsPrec :: Int -> RunTest -> ShowS
$cshow :: RunTest -> String
show :: RunTest -> String
$cshowList :: [RunTest] -> ShowS
showList :: [RunTest] -> ShowS
Show )

data SetScriptsExecutable = YesSetScriptsExecutable | NoSetScriptsExecutable
    deriving ( SetScriptsExecutable -> SetScriptsExecutable -> Bool
(SetScriptsExecutable -> SetScriptsExecutable -> Bool)
-> (SetScriptsExecutable -> SetScriptsExecutable -> Bool)
-> Eq SetScriptsExecutable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetScriptsExecutable -> SetScriptsExecutable -> Bool
== :: SetScriptsExecutable -> SetScriptsExecutable -> Bool
$c/= :: SetScriptsExecutable -> SetScriptsExecutable -> Bool
/= :: SetScriptsExecutable -> SetScriptsExecutable -> Bool
Eq, Int -> SetScriptsExecutable -> ShowS
[SetScriptsExecutable] -> ShowS
SetScriptsExecutable -> String
(Int -> SetScriptsExecutable -> ShowS)
-> (SetScriptsExecutable -> String)
-> ([SetScriptsExecutable] -> ShowS)
-> Show SetScriptsExecutable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetScriptsExecutable -> ShowS
showsPrec :: Int -> SetScriptsExecutable -> ShowS
$cshow :: SetScriptsExecutable -> String
show :: SetScriptsExecutable -> String
$cshowList :: [SetScriptsExecutable] -> ShowS
showList :: [SetScriptsExecutable] -> ShowS
Show )

data LeaveTestDir = YesLeaveTestDir | NoLeaveTestDir
    deriving ( LeaveTestDir -> LeaveTestDir -> Bool
(LeaveTestDir -> LeaveTestDir -> Bool)
-> (LeaveTestDir -> LeaveTestDir -> Bool) -> Eq LeaveTestDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeaveTestDir -> LeaveTestDir -> Bool
== :: LeaveTestDir -> LeaveTestDir -> Bool
$c/= :: LeaveTestDir -> LeaveTestDir -> Bool
/= :: LeaveTestDir -> LeaveTestDir -> Bool
Eq, Int -> LeaveTestDir -> ShowS
[LeaveTestDir] -> ShowS
LeaveTestDir -> String
(Int -> LeaveTestDir -> ShowS)
-> (LeaveTestDir -> String)
-> ([LeaveTestDir] -> ShowS)
-> Show LeaveTestDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeaveTestDir -> ShowS
showsPrec :: Int -> LeaveTestDir -> ShowS
$cshow :: LeaveTestDir -> String
show :: LeaveTestDir -> String
$cshowList :: [LeaveTestDir] -> ShowS
showList :: [LeaveTestDir] -> ShowS
Show )

data SetDefault = YesSetDefault Bool | NoSetDefault Bool
    deriving ( SetDefault -> SetDefault -> Bool
(SetDefault -> SetDefault -> Bool)
-> (SetDefault -> SetDefault -> Bool) -> Eq SetDefault
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetDefault -> SetDefault -> Bool
== :: SetDefault -> SetDefault -> Bool
$c/= :: SetDefault -> SetDefault -> Bool
/= :: SetDefault -> SetDefault -> Bool
Eq, Int -> SetDefault -> ShowS
[SetDefault] -> ShowS
SetDefault -> String
(Int -> SetDefault -> ShowS)
-> (SetDefault -> String)
-> ([SetDefault] -> ShowS)
-> Show SetDefault
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetDefault -> ShowS
showsPrec :: Int -> SetDefault -> ShowS
$cshow :: SetDefault -> String
show :: SetDefault -> String
$cshowList :: [SetDefault] -> ShowS
showList :: [SetDefault] -> ShowS
Show )

data InheritDefault = YesInheritDefault | NoInheritDefault
    deriving ( InheritDefault -> InheritDefault -> Bool
(InheritDefault -> InheritDefault -> Bool)
-> (InheritDefault -> InheritDefault -> Bool) -> Eq InheritDefault
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InheritDefault -> InheritDefault -> Bool
== :: InheritDefault -> InheritDefault -> Bool
$c/= :: InheritDefault -> InheritDefault -> Bool
/= :: InheritDefault -> InheritDefault -> Bool
Eq, Int -> InheritDefault -> ShowS
[InheritDefault] -> ShowS
InheritDefault -> String
(Int -> InheritDefault -> ShowS)
-> (InheritDefault -> String)
-> ([InheritDefault] -> ShowS)
-> Show InheritDefault
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InheritDefault -> ShowS
showsPrec :: Int -> InheritDefault -> ShowS
$cshow :: InheritDefault -> String
show :: InheritDefault -> String
$cshowList :: [InheritDefault] -> ShowS
showList :: [InheritDefault] -> ShowS
Show )

data UseIndex = UseIndex | IgnoreIndex deriving ( UseIndex -> UseIndex -> Bool
(UseIndex -> UseIndex -> Bool)
-> (UseIndex -> UseIndex -> Bool) -> Eq UseIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UseIndex -> UseIndex -> Bool
== :: UseIndex -> UseIndex -> Bool
$c/= :: UseIndex -> UseIndex -> Bool
/= :: UseIndex -> UseIndex -> Bool
Eq, Int -> UseIndex -> ShowS
[UseIndex] -> ShowS
UseIndex -> String
(Int -> UseIndex -> ShowS)
-> (UseIndex -> String) -> ([UseIndex] -> ShowS) -> Show UseIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UseIndex -> ShowS
showsPrec :: Int -> UseIndex -> ShowS
$cshow :: UseIndex -> String
show :: UseIndex -> String
$cshowList :: [UseIndex] -> ShowS
showList :: [UseIndex] -> ShowS
Show )

-- Various kinds of getting repositories
data CloneKind = LazyClone       -- ^Just copy pristine and inventories
               | NormalClone     -- ^First do a lazy clone then copy everything
               | CompleteClone   -- ^Same as Normal but omit telling user they can interrumpt
    deriving ( CloneKind -> CloneKind -> Bool
(CloneKind -> CloneKind -> Bool)
-> (CloneKind -> CloneKind -> Bool) -> Eq CloneKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloneKind -> CloneKind -> Bool
== :: CloneKind -> CloneKind -> Bool
$c/= :: CloneKind -> CloneKind -> Bool
/= :: CloneKind -> CloneKind -> Bool
Eq, Int -> CloneKind -> ShowS
[CloneKind] -> ShowS
CloneKind -> String
(Int -> CloneKind -> ShowS)
-> (CloneKind -> String)
-> ([CloneKind] -> ShowS)
-> Show CloneKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloneKind -> ShowS
showsPrec :: Int -> CloneKind -> ShowS
$cshow :: CloneKind -> String
show :: CloneKind -> String
$cshowList :: [CloneKind] -> ShowS
showList :: [CloneKind] -> ShowS
Show )

data AllowConflicts = NoAllowConflicts | YesAllowConflicts ResolveConflicts
    deriving ( AllowConflicts -> AllowConflicts -> Bool
(AllowConflicts -> AllowConflicts -> Bool)
-> (AllowConflicts -> AllowConflicts -> Bool) -> Eq AllowConflicts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllowConflicts -> AllowConflicts -> Bool
== :: AllowConflicts -> AllowConflicts -> Bool
$c/= :: AllowConflicts -> AllowConflicts -> Bool
/= :: AllowConflicts -> AllowConflicts -> Bool
Eq, Int -> AllowConflicts -> ShowS
[AllowConflicts] -> ShowS
AllowConflicts -> String
(Int -> AllowConflicts -> ShowS)
-> (AllowConflicts -> String)
-> ([AllowConflicts] -> ShowS)
-> Show AllowConflicts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllowConflicts -> ShowS
showsPrec :: Int -> AllowConflicts -> ShowS
$cshow :: AllowConflicts -> String
show :: AllowConflicts -> String
$cshowList :: [AllowConflicts] -> ShowS
showList :: [AllowConflicts] -> ShowS
Show )

data ResolveConflicts = NoResolveConflicts | MarkConflicts | ExternalMerge String
    deriving ( ResolveConflicts -> ResolveConflicts -> Bool
(ResolveConflicts -> ResolveConflicts -> Bool)
-> (ResolveConflicts -> ResolveConflicts -> Bool)
-> Eq ResolveConflicts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResolveConflicts -> ResolveConflicts -> Bool
== :: ResolveConflicts -> ResolveConflicts -> Bool
$c/= :: ResolveConflicts -> ResolveConflicts -> Bool
/= :: ResolveConflicts -> ResolveConflicts -> Bool
Eq, Int -> ResolveConflicts -> ShowS
[ResolveConflicts] -> ShowS
ResolveConflicts -> String
(Int -> ResolveConflicts -> ShowS)
-> (ResolveConflicts -> String)
-> ([ResolveConflicts] -> ShowS)
-> Show ResolveConflicts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResolveConflicts -> ShowS
showsPrec :: Int -> ResolveConflicts -> ShowS
$cshow :: ResolveConflicts -> String
show :: ResolveConflicts -> String
$cshowList :: [ResolveConflicts] -> ShowS
showList :: [ResolveConflicts] -> ShowS
Show )

data WorkRepo = WorkRepoDir String | WorkRepoPossibleURL String | WorkRepoCurrentDir
    deriving ( WorkRepo -> WorkRepo -> Bool
(WorkRepo -> WorkRepo -> Bool)
-> (WorkRepo -> WorkRepo -> Bool) -> Eq WorkRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkRepo -> WorkRepo -> Bool
== :: WorkRepo -> WorkRepo -> Bool
$c/= :: WorkRepo -> WorkRepo -> Bool
/= :: WorkRepo -> WorkRepo -> Bool
Eq, Int -> WorkRepo -> ShowS
[WorkRepo] -> ShowS
WorkRepo -> String
(Int -> WorkRepo -> ShowS)
-> (WorkRepo -> String) -> ([WorkRepo] -> ShowS) -> Show WorkRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkRepo -> ShowS
showsPrec :: Int -> WorkRepo -> ShowS
$cshow :: WorkRepo -> String
show :: WorkRepo -> String
$cshowList :: [WorkRepo] -> ShowS
showList :: [WorkRepo] -> ShowS
Show )

data WantGuiPause = YesWantGuiPause | NoWantGuiPause
    deriving ( WantGuiPause -> WantGuiPause -> Bool
(WantGuiPause -> WantGuiPause -> Bool)
-> (WantGuiPause -> WantGuiPause -> Bool) -> Eq WantGuiPause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WantGuiPause -> WantGuiPause -> Bool
== :: WantGuiPause -> WantGuiPause -> Bool
$c/= :: WantGuiPause -> WantGuiPause -> Bool
/= :: WantGuiPause -> WantGuiPause -> Bool
Eq, Int -> WantGuiPause -> ShowS
[WantGuiPause] -> ShowS
WantGuiPause -> String
(Int -> WantGuiPause -> ShowS)
-> (WantGuiPause -> String)
-> ([WantGuiPause] -> ShowS)
-> Show WantGuiPause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WantGuiPause -> ShowS
showsPrec :: Int -> WantGuiPause -> ShowS
$cshow :: WantGuiPause -> String
show :: WantGuiPause -> String
$cshowList :: [WantGuiPause] -> ShowS
showList :: [WantGuiPause] -> ShowS
Show )

data WithWorkingDir = WithWorkingDir | NoWorkingDir
    deriving ( WithWorkingDir -> WithWorkingDir -> Bool
(WithWorkingDir -> WithWorkingDir -> Bool)
-> (WithWorkingDir -> WithWorkingDir -> Bool) -> Eq WithWorkingDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WithWorkingDir -> WithWorkingDir -> Bool
== :: WithWorkingDir -> WithWorkingDir -> Bool
$c/= :: WithWorkingDir -> WithWorkingDir -> Bool
/= :: WithWorkingDir -> WithWorkingDir -> Bool
Eq, Int -> WithWorkingDir -> ShowS
[WithWorkingDir] -> ShowS
WithWorkingDir -> String
(Int -> WithWorkingDir -> ShowS)
-> (WithWorkingDir -> String)
-> ([WithWorkingDir] -> ShowS)
-> Show WithWorkingDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WithWorkingDir -> ShowS
showsPrec :: Int -> WithWorkingDir -> ShowS
$cshow :: WithWorkingDir -> String
show :: WithWorkingDir -> String
$cshowList :: [WithWorkingDir] -> ShowS
showList :: [WithWorkingDir] -> ShowS
Show )

data ForgetParent = YesForgetParent | NoForgetParent
    deriving ( ForgetParent -> ForgetParent -> Bool
(ForgetParent -> ForgetParent -> Bool)
-> (ForgetParent -> ForgetParent -> Bool) -> Eq ForgetParent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForgetParent -> ForgetParent -> Bool
== :: ForgetParent -> ForgetParent -> Bool
$c/= :: ForgetParent -> ForgetParent -> Bool
/= :: ForgetParent -> ForgetParent -> Bool
Eq, Int -> ForgetParent -> ShowS
[ForgetParent] -> ShowS
ForgetParent -> String
(Int -> ForgetParent -> ShowS)
-> (ForgetParent -> String)
-> ([ForgetParent] -> ShowS)
-> Show ForgetParent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForgetParent -> ShowS
showsPrec :: Int -> ForgetParent -> ShowS
$cshow :: ForgetParent -> String
show :: ForgetParent -> String
$cshowList :: [ForgetParent] -> ShowS
showList :: [ForgetParent] -> ShowS
Show )

data PatchFormat = PatchFormat1 | PatchFormat2 | PatchFormat3
    deriving ( PatchFormat -> PatchFormat -> Bool
(PatchFormat -> PatchFormat -> Bool)
-> (PatchFormat -> PatchFormat -> Bool) -> Eq PatchFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatchFormat -> PatchFormat -> Bool
== :: PatchFormat -> PatchFormat -> Bool
$c/= :: PatchFormat -> PatchFormat -> Bool
/= :: PatchFormat -> PatchFormat -> Bool
Eq, Int -> PatchFormat -> ShowS
[PatchFormat] -> ShowS
PatchFormat -> String
(Int -> PatchFormat -> ShowS)
-> (PatchFormat -> String)
-> ([PatchFormat] -> ShowS)
-> Show PatchFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatchFormat -> ShowS
showsPrec :: Int -> PatchFormat -> ShowS
$cshow :: PatchFormat -> String
show :: PatchFormat -> String
$cshowList :: [PatchFormat] -> ShowS
showList :: [PatchFormat] -> ShowS
Show )

data WithPrefsTemplates =  WithPrefsTemplates | NoPrefsTemplates
    deriving ( WithPrefsTemplates -> WithPrefsTemplates -> Bool
(WithPrefsTemplates -> WithPrefsTemplates -> Bool)
-> (WithPrefsTemplates -> WithPrefsTemplates -> Bool)
-> Eq WithPrefsTemplates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WithPrefsTemplates -> WithPrefsTemplates -> Bool
== :: WithPrefsTemplates -> WithPrefsTemplates -> Bool
$c/= :: WithPrefsTemplates -> WithPrefsTemplates -> Bool
/= :: WithPrefsTemplates -> WithPrefsTemplates -> Bool
Eq, Int -> WithPrefsTemplates -> ShowS
[WithPrefsTemplates] -> ShowS
WithPrefsTemplates -> String
(Int -> WithPrefsTemplates -> ShowS)
-> (WithPrefsTemplates -> String)
-> ([WithPrefsTemplates] -> ShowS)
-> Show WithPrefsTemplates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WithPrefsTemplates -> ShowS
showsPrec :: Int -> WithPrefsTemplates -> ShowS
$cshow :: WithPrefsTemplates -> String
show :: WithPrefsTemplates -> String
$cshowList :: [WithPrefsTemplates] -> ShowS
showList :: [WithPrefsTemplates] -> ShowS
Show )

data OptimizeDeep = OptimizeShallow | OptimizeDeep
    deriving ( OptimizeDeep -> OptimizeDeep -> Bool
(OptimizeDeep -> OptimizeDeep -> Bool)
-> (OptimizeDeep -> OptimizeDeep -> Bool) -> Eq OptimizeDeep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptimizeDeep -> OptimizeDeep -> Bool
== :: OptimizeDeep -> OptimizeDeep -> Bool
$c/= :: OptimizeDeep -> OptimizeDeep -> Bool
/= :: OptimizeDeep -> OptimizeDeep -> Bool
Eq, Int -> OptimizeDeep -> ShowS
[OptimizeDeep] -> ShowS
OptimizeDeep -> String
(Int -> OptimizeDeep -> ShowS)
-> (OptimizeDeep -> String)
-> ([OptimizeDeep] -> ShowS)
-> Show OptimizeDeep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptimizeDeep -> ShowS
showsPrec :: Int -> OptimizeDeep -> ShowS
$cshow :: OptimizeDeep -> String
show :: OptimizeDeep -> String
$cshowList :: [OptimizeDeep] -> ShowS
showList :: [OptimizeDeep] -> ShowS
Show )