1 %  Copyright (C) 2003 David Roundy
    2 %
    3 %  This program is free software; you can redistribute it and/or modify
    4 %  it under the terms of the GNU General Public License as published by
    5 %  the Free Software Foundation; either version 2, or (at your option)
    6 %  any later version.
    7 %
    8 %  This program is distributed in the hope that it will be useful,
    9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 %  GNU General Public License for more details.
   12 %
   13 %  You should have received a copy of the GNU General Public License
   14 %  along with this program; see the file COPYING.  If not, write to
   15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 %  Boston, MA 02110-1301, USA.
   17 
   18 \darcsCommand{setpref}
   19 \begin{code}
   20 {-# OPTIONS_GHC -cpp #-}
   21 {-# LANGUAGE CPP #-}
   22 
   23 module Darcs.Commands.SetPref ( setpref ) where
   24 
   25 import System.Exit ( exitWith, ExitCode(..) )
   26 import Control.Monad (when)
   27 
   28 import Darcs.Commands ( DarcsCommand(..), nodefaults )
   29 import Darcs.Arguments ( DarcsFlag, working_repo_dir, umask_option )
   30 import Darcs.Repository ( amInRepository, add_to_pending, withRepoLock, ($-) )
   31 import Darcs.Patch ( changepref )
   32 import Darcs.Ordered ( FL(..) )
   33 import Darcs.Repository.Prefs ( get_prefval, change_prefval, )
   34 import English ( orClauses )
   35 #include "impossible.h"
   36 
   37 -- | A list of all valid preferences for @_darcs/prefs/prefs@.
   38 valid_pref_data :: [(String, String)] -- ^ (name, one line description)
   39 valid_pref_data =
   40     [("test", "a shell command that runs regression tests"),
   41      ("predist", "a shell command to run before `darcs dist'"),
   42      ("boringfile", "the path to a version-controlled boring file"),
   43      ("binariesfile", "the path to a version-controlled binaries file")]
   44 
   45 valid_prefs :: [String]
   46 valid_prefs = map fst valid_pref_data
   47 
   48 setpref_description :: String
   49 setpref_description =
   50     "Set a preference (" ++ orClauses valid_prefs ++ ")."
   51 
   52 setpref_help :: String
   53 setpref_help =
   54  "When working on project with multiple repositories and contributors,\n" ++
   55  "it is sometimes desirable for a preference to be set consistently\n" ++
   56  "project-wide.  This is achieved by treating a preference set with\n" ++
   57  "`darcs setpref' as an unrecorded change, which can then be recorded\n" ++
   58  "and then treated like any other patch.\n" ++
   59  "\n" ++
   60  "Valid preferences are:\n" ++
   61  "\n" ++
   62  unlines ["  "++x++" -- "++y | (x,y) <- valid_pref_data] ++
   63  "\n" ++
   64  "For example, a project using GNU autotools, with a `make test' target\n" ++
   65  "to perform regression tests, might enable Darcs' integrated regression\n" ++
   66  "testing with the following command:\n" ++
   67  "\n" ++
   68  "  darcs setpref test 'autoconf && ./configure && make && make test'\n" ++
   69  "\n" ++
   70  "Note that merging is not currently implemented for preferences: if two\n" ++
   71  "patches attempt to set the same preference, the last patch applied to\n" ++
   72  "the repository will always take precedence.  This is considered a\n" ++
   73  "low-priority bug, because preferences are seldom set.\n"
   74 
   75 setpref :: DarcsCommand
   76 setpref = DarcsCommand {command_name = "setpref",
   77                         command_help = setpref_help,
   78                         command_description = setpref_description,
   79                         command_extra_args = 2,
   80                         command_extra_arg_help = ["<PREF>",
   81                                                   "<VALUE>"],
   82                         command_command = setpref_cmd,
   83                         command_prereq = amInRepository,
   84                         command_get_arg_possibilities = return valid_prefs,
   85                         command_argdefaults = nodefaults,
   86                         command_advanced_options = [umask_option],
   87                         command_basic_options =
   88                             [working_repo_dir]}
   89 
   90 setpref_cmd :: [DarcsFlag] -> [String] -> IO ()
   91 setpref_cmd opts [pref,val] = withRepoLock opts $- \repository -> do
   92   when (' ' `elem` pref) $ do
   93     putStrLn $ "'"++pref++
   94                "' is not a valid preference name:  no spaces allowed!"
   95     exitWith $ ExitFailure 1
   96   when (not $ pref `elem` valid_prefs) $ do
   97     putStrLn $ "'"++pref++"' is not a valid preference name!"
   98     putStrLn $ "Try one of: " ++ unwords valid_prefs
   99     exitWith $ ExitFailure 1
  100   oval <- get_prefval pref
  101   old <- case oval of Just v -> return v
  102                       Nothing -> return ""
  103   change_prefval pref old val
  104   putStrLn $ "Changing value of "++pref++" from '"++old++"' to '"++val++"'"
  105   add_to_pending repository (changepref pref old val :>: NilFL)
  106 setpref_cmd _ _ = impossible                                                                                                           
  107 \end{code}
  108