module Darcs.UI.Commands.SetPref ( setpref ) where
import Darcs.Prelude
import System.Exit ( exitWith, ExitCode(..) )
import Control.Monad ( when )
import Data.Maybe ( fromMaybe )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository )
import Darcs.UI.Flags ( DarcsFlag, useCache, dryRun, umask)
import Darcs.UI.Options
( odesc, ocheck, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.Flags ( UpdatePending (..) )
import Darcs.Repository ( addToPending, withRepoLock, RepoJob(..) )
import Darcs.Patch ( changepref )
import Darcs.Patch.Witnesses.Ordered ( FL(..) )
import Darcs.Repository.Prefs ( getPrefval, changePrefval )
import Darcs.Util.English ( orClauses )
import Darcs.Util.Path ( AbsolutePath )
import Darcs.Util.Printer ( Doc, text )
validPrefData :: [(String, String)]
validPrefData :: [(String, String)]
validPrefData =
[(String
"test", String
"a shell command that runs regression tests"),
(String
"predist", String
"a shell command to run before `darcs dist'"),
(String
"boringfile", String
"the path to a version-controlled boring file"),
(String
"binariesfile", String
"the path to a version-controlled binaries file")]
validPrefs :: [String]
validPrefs :: [String]
validPrefs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, String)]
validPrefData
setprefDescription :: String
setprefDescription :: String
setprefDescription =
String
"Set a preference (" forall a. [a] -> [a] -> [a]
++ [String] -> String
orClauses [String]
validPrefs forall a. [a] -> [a] -> [a]
++ String
")."
setprefHelp :: Doc
setprefHelp :: Doc
setprefHelp = String -> Doc
text forall a b. (a -> b) -> a -> b
$
String
"When working on project with multiple repositories and contributors,\n" forall a. [a] -> [a] -> [a]
++
String
"it is sometimes desirable for a preference to be set consistently\n" forall a. [a] -> [a] -> [a]
++
String
"project-wide. This is achieved by treating a preference set with\n" forall a. [a] -> [a] -> [a]
++
String
"`darcs setpref` as an unrecorded change, which can then be recorded\n" forall a. [a] -> [a] -> [a]
++
String
"and then treated like any other patch.\n" forall a. [a] -> [a] -> [a]
++
String
"\n" forall a. [a] -> [a] -> [a]
++
String
"Valid preferences are:\n" forall a. [a] -> [a] -> [a]
++
String
"\n" forall a. [a] -> [a] -> [a]
++
[String] -> String
unlines [String
"* "forall a. [a] -> [a] -> [a]
++String
xforall a. [a] -> [a] -> [a]
++String
" -- "forall a. [a] -> [a] -> [a]
++String
y | (String
x,String
y) <- [(String, String)]
validPrefData] forall a. [a] -> [a] -> [a]
++
String
"\n" forall a. [a] -> [a] -> [a]
++
String
"For example, a project using GNU autotools, with a `make test` target\n" forall a. [a] -> [a] -> [a]
++
String
"to perform regression tests, might enable Darcs' integrated regression\n" forall a. [a] -> [a] -> [a]
++
String
"testing with the following command:\n" forall a. [a] -> [a] -> [a]
++
String
"\n" forall a. [a] -> [a] -> [a]
++
String
" darcs setpref test 'autoconf && ./configure && make && make test'\n" forall a. [a] -> [a] -> [a]
++
String
"\n" forall a. [a] -> [a] -> [a]
++
String
"Note that merging is not currently implemented for preferences: if two\n" forall a. [a] -> [a] -> [a]
++
String
"patches attempt to set the same preference, the last patch applied to\n" forall a. [a] -> [a] -> [a]
++
String
"the repository will always take precedence. This is considered a\n" forall a. [a] -> [a] -> [a]
++
String
"low-priority bug, because preferences are seldom set.\n"
setpref :: DarcsCommand
setpref :: DarcsCommand
setpref = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"setpref"
, commandHelp :: Doc
commandHelp = Doc
setprefHelp
, commandDescription :: String
commandDescription = String
setprefDescription
, commandExtraArgs :: Int
commandExtraArgs = Int
2
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"<PREF>", String
"<VALUE>"]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
setprefCmd
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = forall {m :: * -> *} {p} {p} {a}.
Monad m =>
p -> p -> [a] -> m [String]
completeArgs
, 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
setprefAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
setprefBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(Maybe String
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
setprefOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(Maybe String
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
setprefOpts
}
where
setprefBasicOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
setprefBasicOpts = forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
O.repoDir
setprefAdvancedOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a UMask
setprefAdvancedOpts = forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a UMask
O.umask
setprefOpts :: DarcsOption
a
(Maybe String
-> Maybe StdCmdAction
-> Verbosity
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
setprefOpts = forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
setprefBasicOpts 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
setprefAdvancedOpts
completeArgs :: p -> p -> [a] -> m [String]
completeArgs p
_ p
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return [String]
validPrefs
completeArgs p
_ p
_ [a]
_args = forall (m :: * -> *) a. Monad m => a -> m a
return []
setprefCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
setprefCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
setprefCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [String
pref,String
val] =
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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
' ' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
pref) forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"'"forall a. [a] -> [a] -> [a]
++String
prefforall a. [a] -> [a] -> [a]
++
String
"' is not a valid preference name: no spaces allowed!"
forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
pref forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
validPrefs) forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"'"forall a. [a] -> [a] -> [a]
++String
prefforall a. [a] -> [a] -> [a]
++String
"' is not a valid preference name!"
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Try one of: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
validPrefs
forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
Maybe String
oval <- String -> IO (Maybe String)
getPrefval String
pref
let old :: String
old = forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
oval
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
'\n' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
val) forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
val forall a. [a] -> [a] -> [a]
++ String
"is not a valid preference value: newlines forbidden!"
forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
String -> String -> String -> IO ()
changePrefval String
pref String
old String
val
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Changing value of "forall a. [a] -> [a] -> [a]
++String
prefforall a. [a] -> [a] -> [a]
++String
" from '"forall a. [a] -> [a] -> [a]
++String
oldforall a. [a] -> [a] -> [a]
++String
"' to '"forall a. [a] -> [a] -> [a]
++String
valforall a. [a] -> [a] -> [a]
++String
"'"
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) (forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
String -> String -> String -> prim wX wY
changepref String
pref String
old String
val forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
setprefCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [String]
_ = forall a. HasCallStack => String -> a
error String
"impossible case"