{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands
( CommandControl ( CommandData, HiddenCommand, GroupName )
, DarcsCommand(..)
, commandAlias
, commandStub
, commandOptions
, commandAlloptions
, withStdOpts
, disambiguateCommands
, CommandArgs(..)
, getSubcommands
, extractCommands
, extractAllCommands
, normalCommand
, hiddenCommand
, commandGroup
, superName
, nodefaults
, putInfo
, putVerbose
, putWarning
, putVerboseWarning
, putFinished
, abortRun
, setEnvDarcsPatches
, setEnvDarcsFiles
, defaultRepo
, amInHashedRepository
, amInRepository
, amNotInRepository
, findRepository
) where
import Control.Monad ( when, unless )
import Data.List ( sort, isPrefixOf )
import System.Console.GetOpt ( OptDescr )
import System.IO ( stderr )
import System.IO.Error ( catchIOError )
import System.Environment ( setEnv )
import Darcs.Prelude
import Darcs.Patch ( listTouchedFiles )
import Darcs.Patch ( RepoPatch )
import Darcs.Patch.Info ( toXml )
import Darcs.Patch.Inspect ( PatchInspect )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )
import Darcs.Patch.Witnesses.Ordered ( FL, mapFL )
import qualified Darcs.Repository as R ( amInHashedRepository, amInRepository
, amNotInRepository, findRepository )
import Darcs.Repository.Flags ( WorkRepo(..) )
import Darcs.Repository.Prefs ( defaultrepo )
import Darcs.UI.Options ( DarcsOption, DarcsOptDescr, (^), optDescr, odesc, parseFlags, (?) )
import Darcs.UI.Options.All
( StdCmdAction, stdCmdActions, debugging, UseCache, useCache, HooksConfig, hooks
, Verbosity(..), DryRun(..), dryRun, newRepo, verbosity
)
import Darcs.UI.Flags ( DarcsFlag, remoteRepos, workRepo, quiet, verbose )
import Darcs.UI.External ( viewDoc )
import Darcs.UI.PrintPatch ( showWithSummary )
import Darcs.Util.ByteString ( decodeLocale, packStringToUTF8 )
import Darcs.Util.Path ( AbsolutePath, anchorPath )
import Darcs.Util.Printer
( Doc, text, (<+>), ($$), ($+$), hsep, vcat
, putDocLnWith, hPutDocLn, renderString
)
import Darcs.Util.Printer.Color ( fancyPrinters, ePutDocLn )
import Darcs.Util.Progress
( debugMessage, beginTedious, endTedious, tediousSize, finishedOneIO )
extractCommands :: [CommandControl] -> [DarcsCommand]
extractCommands :: [CommandControl] -> [DarcsCommand]
extractCommands [CommandControl]
ccl = [ DarcsCommand
cmd | CommandData DarcsCommand
cmd <- [CommandControl]
ccl ]
extractHiddenCommands :: [CommandControl] -> [DarcsCommand]
extractHiddenCommands :: [CommandControl] -> [DarcsCommand]
extractHiddenCommands [CommandControl]
ccl = [ DarcsCommand
cmd | HiddenCommand DarcsCommand
cmd <- [CommandControl]
ccl ]
extractAllCommands :: [CommandControl] -> [DarcsCommand]
extractAllCommands :: [CommandControl] -> [DarcsCommand]
extractAllCommands [CommandControl]
ccl = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DarcsCommand -> [DarcsCommand]
flatten ([CommandControl] -> [DarcsCommand]
extractCommands [CommandControl]
ccl forall a. [a] -> [a] -> [a]
++ [CommandControl] -> [DarcsCommand]
extractHiddenCommands [CommandControl]
ccl)
where flatten :: DarcsCommand -> [DarcsCommand]
flatten c :: DarcsCommand
c@(DarcsCommand {}) = [DarcsCommand
c]
flatten c :: DarcsCommand
c@(SuperCommand { commandSubCommands :: DarcsCommand -> [CommandControl]
commandSubCommands = [CommandControl]
scs }) = DarcsCommand
c forall a. a -> [a] -> [a]
: [CommandControl] -> [DarcsCommand]
extractAllCommands [CommandControl]
scs
normalCommand :: DarcsCommand -> CommandControl
normalCommand :: DarcsCommand -> CommandControl
normalCommand DarcsCommand
c = DarcsCommand -> CommandControl
CommandData DarcsCommand
c
hiddenCommand :: DarcsCommand -> CommandControl
hiddenCommand :: DarcsCommand -> CommandControl
hiddenCommand DarcsCommand
c = DarcsCommand -> CommandControl
HiddenCommand DarcsCommand
c
commandGroup :: String -> CommandControl
commandGroup :: [Char] -> CommandControl
commandGroup = [Char] -> CommandControl
GroupName
data CommandControl
= CommandData DarcsCommand
| HiddenCommand DarcsCommand
| GroupName String
data DarcsCommand =
DarcsCommand
{ DarcsCommand -> [Char]
commandProgramName
, DarcsCommand -> [Char]
commandName :: String
, DarcsCommand -> Doc
commandHelp :: Doc
, DarcsCommand -> [Char]
commandDescription :: String
, DarcsCommand -> Int
commandExtraArgs :: Int
, DarcsCommand -> [[Char]]
commandExtraArgHelp :: [String]
, DarcsCommand
-> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
commandCommand ::
(AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO ()
, DarcsCommand -> [DarcsFlag] -> IO (Either [Char] ())
commandPrereq :: [DarcsFlag] -> IO (Either String ())
, DarcsCommand
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [[Char]]
-> IO [[Char]]
commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
, DarcsCommand
-> [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String]
-> IO [String]
, DarcsCommand -> [DarcsOptDescr DarcsFlag]
commandBasicOptions :: [DarcsOptDescr DarcsFlag]
, DarcsCommand -> [DarcsOptDescr DarcsFlag]
commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
, DarcsCommand -> [DarcsFlag]
commandDefaults :: [DarcsFlag]
, DarcsCommand -> [DarcsFlag] -> [[Char]]
commandCheckOptions :: [DarcsFlag] -> [String]
}
| SuperCommand
{ commandProgramName
, commandName :: String
, commandHelp :: Doc
, commandDescription :: String
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
, DarcsCommand -> [CommandControl]
commandSubCommands :: [CommandControl]
}
withStdOpts :: DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
withStdOpts :: forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
withStdOpts DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
basicOpts DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
advancedOpts =
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
basicOpts forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe StdCmdAction)
stdCmdActions forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
advancedOpts forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UseCache
useCache 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 (HooksConfig -> a)
hooks 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 (Bool -> Bool -> Bool -> a)
debugging
commandAlloptions :: DarcsCommand -> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
commandAlloptions :: DarcsCommand
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
commandAlloptions DarcsCommand { commandBasicOptions :: DarcsCommand -> [DarcsOptDescr DarcsFlag]
commandBasicOptions = [DarcsOptDescr DarcsFlag]
opts1
, commandAdvancedOptions :: DarcsCommand -> [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = [DarcsOptDescr DarcsFlag]
opts2 } =
( [DarcsOptDescr DarcsFlag]
opts1 forall a. [a] -> [a] -> [a]
++ forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc PrimDarcsOption (Maybe StdCmdAction)
stdCmdActions
, forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc PrimDarcsOption Verbosity
verbosity forall a. [a] -> [a] -> [a]
++ [DarcsOptDescr DarcsFlag]
opts2 forall a. [a] -> [a] -> [a]
++ forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc PrimDarcsOption UseCache
useCache forall a. [a] -> [a] -> [a]
++ forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall a. DarcsOption a (HooksConfig -> a)
hooks forall a. [a] -> [a] -> [a]
++ forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall a. DarcsOption a (Bool -> Bool -> Bool -> a)
debugging
)
commandAlloptions SuperCommand { } = (forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc PrimDarcsOption (Maybe StdCmdAction)
stdCmdActions, [])
commandOptions :: AbsolutePath -> DarcsCommand -> [OptDescr DarcsFlag]
commandOptions :: AbsolutePath -> DarcsCommand -> [OptDescr DarcsFlag]
commandOptions AbsolutePath
cwd = forall a b. (a -> b) -> [a] -> [b]
map (forall f. AbsolutePath -> DarcsOptDescr f -> OptDescr f
optDescr AbsolutePath
cwd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DarcsCommand
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
commandAlloptions
nodefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults :: [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
nodefaults [DarcsFlag]
_ AbsolutePath
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
getSubcommands :: DarcsCommand -> [CommandControl]
getSubcommands :: DarcsCommand -> [CommandControl]
getSubcommands c :: DarcsCommand
c@(SuperCommand {}) = [Char] -> CommandControl
commandGroup [Char]
"Subcommands:" forall a. a -> [a] -> [a]
: DarcsCommand -> [CommandControl]
commandSubCommands DarcsCommand
c
getSubcommands DarcsCommand
_ = []
commandAlias :: String -> Maybe (DarcsCommand) -> DarcsCommand -> DarcsCommand
commandAlias :: [Char] -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias [Char]
alias Maybe DarcsCommand
msuper DarcsCommand
command =
DarcsCommand
command
{ commandName :: [Char]
commandName = [Char]
alias
, commandDescription :: [Char]
commandDescription = [Char]
"Alias for `" forall a. [a] -> [a] -> [a]
++ [Char]
prog forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
cmdName forall a. [a] -> [a] -> [a]
++ [Char]
"'."
, commandHelp :: Doc
commandHelp =
[Doc] -> Doc
hsep
[ Doc
"The"
, Doc
"`" forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
prog Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
alias forall a. Semigroup a => a -> a -> a
<> Doc
"`"
, Doc
"command is an alias for"
, Doc
"`" forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
prog Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
cmdName forall a. Semigroup a => a -> a -> a
<> Doc
"`"
]
Doc -> Doc -> Doc
$+$ Doc
"See description of `" forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
prog Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
cmdName forall a. Semigroup a => a -> a -> a
<> Doc
"` for details."
}
where
prog :: [Char]
prog = DarcsCommand -> [Char]
commandProgramName DarcsCommand
command
cmdName :: [Char]
cmdName = [[Char]] -> [Char]
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map DarcsCommand -> [Char]
commandName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe DarcsCommand
msuper forall a b. (a -> b) -> a -> b
$ [DarcsCommand
command]
commandStub :: String -> Doc -> String -> DarcsCommand -> DarcsCommand
commandStub :: [Char] -> Doc -> [Char] -> DarcsCommand -> DarcsCommand
commandStub [Char]
n Doc
h [Char]
d DarcsCommand
c = DarcsCommand
c { commandName :: [Char]
commandName = [Char]
n
, commandHelp :: Doc
commandHelp = Doc
h
, commandDescription :: [Char]
commandDescription = [Char]
d
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
commandCommand = \(AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [[Char]]
_ -> Doc -> IO ()
viewDoc Doc
h
}
superName :: Maybe (DarcsCommand) -> String
superName :: Maybe DarcsCommand -> [Char]
superName Maybe DarcsCommand
Nothing = [Char]
""
superName (Just DarcsCommand
x) = DarcsCommand -> [Char]
commandName DarcsCommand
x forall a. [a] -> [a] -> [a]
++ [Char]
" "
data CommandArgs
= CommandOnly DarcsCommand
| SuperCommandOnly DarcsCommand
| SuperCommandSub DarcsCommand DarcsCommand
disambiguateCommands :: [CommandControl] -> String -> [String]
-> Either String (CommandArgs, [String])
disambiguateCommands :: [CommandControl]
-> [Char] -> [[Char]] -> Either [Char] (CommandArgs, [[Char]])
disambiguateCommands [CommandControl]
allcs [Char]
cmd [[Char]]
args = do
DarcsCommand
c <- [Char] -> [CommandControl] -> Either [Char] DarcsCommand
extract [Char]
cmd [CommandControl]
allcs
case (DarcsCommand -> [CommandControl]
getSubcommands DarcsCommand
c, [[Char]]
args) of
([], [[Char]]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (DarcsCommand -> CommandArgs
CommandOnly DarcsCommand
c, [[Char]]
args)
([CommandControl]
_, []) -> forall (m :: * -> *) a. Monad m => a -> m a
return (DarcsCommand -> CommandArgs
SuperCommandOnly DarcsCommand
c, [[Char]]
args)
([CommandControl]
subcs, [Char]
a : [[Char]]
as) -> case [Char] -> [CommandControl] -> Either [Char] DarcsCommand
extract [Char]
a [CommandControl]
subcs of
Left [Char]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (DarcsCommand -> CommandArgs
SuperCommandOnly DarcsCommand
c, [[Char]]
args)
Right DarcsCommand
sc -> forall (m :: * -> *) a. Monad m => a -> m a
return (DarcsCommand -> DarcsCommand -> CommandArgs
SuperCommandSub DarcsCommand
c DarcsCommand
sc, [[Char]]
as)
extract :: String -> [CommandControl] -> Either String DarcsCommand
[Char]
cmd [CommandControl]
cs = case [DarcsCommand]
potentials of
[] -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"No such command '" forall a. [a] -> [a] -> [a]
++ [Char]
cmd forall a. [a] -> [a] -> [a]
++ [Char]
"'\n"
[DarcsCommand
c] -> forall a b. b -> Either a b
Right DarcsCommand
c
[DarcsCommand]
cs' -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [ [Char]
"Ambiguous command..."
, [Char]
""
, [Char]
"The command '" forall a. [a] -> [a] -> [a]
++ [Char]
cmd forall a. [a] -> [a] -> [a]
++ [Char]
"' could mean one of:"
, [[Char]] -> [Char]
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map DarcsCommand -> [Char]
commandName forall a b. (a -> b) -> a -> b
$ [DarcsCommand]
cs'
]
where
potentials :: [DarcsCommand]
potentials = [DarcsCommand
c | DarcsCommand
c <- [CommandControl] -> [DarcsCommand]
extractCommands [CommandControl]
cs, [Char]
cmd forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` DarcsCommand -> [Char]
commandName DarcsCommand
c]
forall a. [a] -> [a] -> [a]
++ [DarcsCommand
h | DarcsCommand
h <- [CommandControl] -> [DarcsCommand]
extractHiddenCommands [CommandControl]
cs, [Char]
cmd forall a. Eq a => a -> a -> Bool
== DarcsCommand -> [Char]
commandName DarcsCommand
h]
putVerbose :: [DarcsFlag] -> Doc -> IO ()
putVerbose :: [DarcsFlag] -> Doc -> IO ()
putVerbose [DarcsFlag]
flags = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([DarcsFlag] -> Bool
verbose [DarcsFlag]
flags) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters
putInfo :: [DarcsFlag] -> Doc -> IO ()
putInfo :: [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
flags = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([DarcsFlag] -> Bool
quiet [DarcsFlag]
flags) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters
putFinished :: [DarcsFlag] -> String -> IO ()
putFinished :: [DarcsFlag] -> [Char] -> IO ()
putFinished [DarcsFlag]
flags [Char]
what =
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
flags forall a b. (a -> b) -> a -> b
$ Doc
"Finished" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
what forall a. Semigroup a => a -> a -> a
<> Doc
"."
putWarning :: [DarcsFlag] -> Doc -> IO ()
putWarning :: [DarcsFlag] -> Doc -> IO ()
putWarning [DarcsFlag]
flags = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([DarcsFlag] -> Bool
quiet [DarcsFlag]
flags) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> IO ()
ePutDocLn
putVerboseWarning :: [DarcsFlag] -> Doc -> IO ()
putVerboseWarning :: [DarcsFlag] -> Doc -> IO ()
putVerboseWarning [DarcsFlag]
flags = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([DarcsFlag] -> Bool
verbose [DarcsFlag]
flags) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Doc -> IO ()
hPutDocLn Handle
stderr
abortRun :: [DarcsFlag] -> Doc -> IO ()
abortRun :: [DarcsFlag] -> Doc -> IO ()
abortRun [DarcsFlag]
flags Doc
msg = if forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption DryRun
dryRun [DarcsFlag]
flags forall a. Eq a => a -> a -> Bool
== DryRun
YesDryRun
then [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
flags forall a b. (a -> b) -> a -> b
$ Doc
"NOTE:" Doc -> Doc -> Doc
<+> Doc
msg
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
renderString Doc
msg
setEnvDarcsPatches :: RepoPatch p => FL (PatchInfoAnd rt p) wX wY -> IO ()
setEnvDarcsPatches :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
FL (PatchInfoAnd rt p) wX wY -> IO ()
setEnvDarcsPatches FL (PatchInfoAnd rt p) wX wY
ps = do
let k :: [Char]
k = [Char]
"Defining set of chosen patches"
let filepaths :: [[Char]]
filepaths = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> AnchoredPath -> [Char]
anchorPath [Char]
".") (forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL (PatchInfoAnd rt p) wX wY
ps)
[Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines ([Char]
"setEnvDarcsPatches:" forall a. a -> [a] -> [a]
: [[Char]]
filepaths)
[Char] -> IO ()
beginTedious [Char]
k
[Char] -> Int -> IO ()
tediousSize [Char]
k Int
3
[Char] -> [Char] -> IO ()
finishedOneIO [Char]
k [Char]
"DARCS_PATCHES"
[Char] -> [Char] -> IO ()
setEnvCautiously [Char]
"DARCS_PATCHES" (Doc -> [Char]
renderString forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
showWithSummary FL (PatchInfoAnd rt p) wX wY
ps)
[Char] -> [Char] -> IO ()
finishedOneIO [Char]
k [Char]
"DARCS_PATCHES_XML"
[Char] -> [Char] -> IO ()
setEnvCautiously [Char]
"DARCS_PATCHES_XML" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Char]
renderString forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
"<patches>" Doc -> Doc -> Doc
$$
[Doc] -> Doc
vcat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (PatchInfo -> Doc
toXml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) FL (PatchInfoAnd rt p) wX wY
ps) Doc -> Doc -> Doc
$$
[Char] -> Doc
text [Char]
"</patches>"
[Char] -> [Char] -> IO ()
finishedOneIO [Char]
k [Char]
"DARCS_FILES"
[Char] -> [Char] -> IO ()
setEnvCautiously [Char]
"DARCS_FILES" forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [[Char]]
filepaths
[Char] -> IO ()
endTedious [Char]
k
setEnvDarcsFiles :: (PatchInspect p) => p wX wY -> IO ()
setEnvDarcsFiles :: forall (p :: * -> * -> *) wX wY. PatchInspect p => p wX wY -> IO ()
setEnvDarcsFiles p wX wY
ps = do
let filepaths :: [[Char]]
filepaths = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> AnchoredPath -> [Char]
anchorPath [Char]
".") (forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles p wX wY
ps)
[Char] -> [Char] -> IO ()
setEnvCautiously [Char]
"DARCS_FILES" forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [[Char]]
filepaths
setEnvCautiously :: String -> String -> IO ()
setEnvCautiously :: [Char] -> [Char] -> IO ()
setEnvCautiously [Char]
e [Char]
v
| forall a. Int -> [a] -> Bool
toobig (Int
10 forall a. Num a => a -> a -> a
* Int
1024) [Char]
v = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise =
[Char] -> [Char] -> IO ()
setEnv [Char]
e [Char]
v forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\IOError
_ -> [Char] -> [Char] -> IO ()
setEnv [Char]
e (ByteString -> [Char]
decodeLocale ([Char] -> ByteString
packStringToUTF8 [Char]
v)))
where
toobig :: Int -> [a] -> Bool
toobig :: forall a. Int -> [a] -> Bool
toobig Int
0 [a]
_ = Bool
True
toobig Int
_ [] = Bool
False
toobig Int
n (a
_ : [a]
xs) = forall a. Int -> [a] -> Bool
toobig (Int
n forall a. Num a => a -> a -> a
- Int
1) [a]
xs
defaultRepo :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
defaultRepo :: [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
defaultRepo [DarcsFlag]
fs = RemoteRepos -> AbsolutePath -> [[Char]] -> IO [[Char]]
defaultrepo (PrimDarcsOption RemoteRepos
remoteRepos forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
fs)
amInHashedRepository :: [DarcsFlag] -> IO (Either String ())
amInHashedRepository :: [DarcsFlag] -> IO (Either [Char] ())
amInHashedRepository [DarcsFlag]
fs = WorkRepo -> IO (Either [Char] ())
R.amInHashedRepository ([DarcsFlag] -> WorkRepo
workRepo [DarcsFlag]
fs)
amInRepository :: [DarcsFlag] -> IO (Either String ())
amInRepository :: [DarcsFlag] -> IO (Either [Char] ())
amInRepository [DarcsFlag]
fs = WorkRepo -> IO (Either [Char] ())
R.amInRepository ([DarcsFlag] -> WorkRepo
workRepo [DarcsFlag]
fs)
amNotInRepository :: [DarcsFlag] -> IO (Either String ())
amNotInRepository :: [DarcsFlag] -> IO (Either [Char] ())
amNotInRepository [DarcsFlag]
fs =
WorkRepo -> IO (Either [Char] ())
R.amNotInRepository (forall b a. b -> (a -> b) -> Maybe a -> b
maybe WorkRepo
WorkRepoCurrentDir [Char] -> WorkRepo
WorkRepoDir (PrimDarcsOption (Maybe [Char])
newRepo forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
fs))
findRepository :: [DarcsFlag] -> IO (Either String ())
findRepository :: [DarcsFlag] -> IO (Either [Char] ())
findRepository [DarcsFlag]
fs = WorkRepo -> IO (Either [Char] ())
R.findRepository ([DarcsFlag] -> WorkRepo
workRepo [DarcsFlag]
fs)