src/Darcs/Repository/Prefs.lhs

   1 %  Copyright (C) 2002-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
  19 \begin{code}
  20 {-# OPTIONS_GHC -cpp -fglasgow-exts #-}
  21 {-# LANGUAGE CPP #-}
  22
  23 #include "gadts.h"
  24
  25 module Darcs.Repository.Prefs ( add_to_preflist, get_preflist, set_preflist,
  26                    get_global,
  27                    defaultrepo, set_defaultrepo,
  28                    get_prefval, set_prefval, change_prefval,
  29                    def_prefval,
  30                    write_default_prefs,
  31                    boring_file_filter, darcsdir_filter,
  32                    FileType(..), filetype_function,
  33                    getCaches,
  34                  ) where
  35
  36 import System.IO.Error ( isDoesNotExistError )
  37 import Control.Monad ( liftM, unless, when, mplus )
  38 import Text.Regex ( Regex, mkRegex, matchRegex, )
  39 import Data.Char ( toUpper )
  40 import Data.Maybe ( isNothing, isJust, catMaybes )
  41 import Data.List ( nub, isPrefixOf )
  42 import System.Directory ( getAppUserDataDirectory )
  43 import System.FilePath ( (</>) )
  44
  45 import Darcs.Flags ( DarcsFlag( NoCache, NoSetDefault, DryRun, Ephemeral, RemoteRepo ) )
  46 import Darcs.RepoPath ( AbsolutePath, ioAbsolute, makeRelative, toFilePath,
  47                         getCurrentDirectory )
  48 import Darcs.Utils ( catchall, stripCr )
  49 import Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..) )
  50 import Darcs.Patch.FileName ( fp2fn )
  51 import Darcs.External ( gzFetchFilePS, Cachable( Cachable ) )
  52 import qualified Data.ByteString.Char8 as BC ( unpack )
  53 import qualified Data.ByteString       as B  ( empty )
  54 import Darcs.Global ( darcsdir )
  55 import Darcs.Repository.Cache ( Cache(..), CacheType(..), CacheLoc(..),
  56                                 WritableOrNot(..) )
  57 import Darcs.URL ( is_file )
  58 \end{code}
  59
  60 \section{prefs}
  61
  62 The \verb!_darcs! directory contains a \verb!prefs!  directory.  This
  63 directory exists simply to hold user configuration settings specific to
  64 this repository.  The contents of this directory are intended to be
  65 modifiable by the user, although in some cases a mistake in such a
  66 modification may cause darcs to behave strangely.
  67
  68
  69
  70 \input{Darcs/ArgumentDefaults.lhs}
  71
  72 \begin{code}
  73 write_default_prefs :: IO ()
  74 write_default_prefs = do set_preflist "boring" default_boring
  75                          set_preflist "binaries" default_binaries
  76                          set_preflist "motd" []
  77 \end{code}
  78
  79 \paragraph{repos}
  80 The \verb!_darcs/prefs/repos! file contains a list of repositories you have
  81 pulled from or pushed to, and is used for autocompletion of pull and push
  82 commands in bash.  Feel free to delete any lines from this list that might
  83 get in there, or to delete the file as a whole.
  84
  85 \paragraph{author}\label{author_prefs}
  86 The \verb!_darcs/prefs/author! file contains the email address (or name) to
  87 be used as the author when patches are recorded in this repository,
  88 e.g.\ \verb!David Roundy <droundy@abridgegame.org>!.  This
  89 file overrides the contents of the environment variables
  90 \verb!$DARCS_EMAIL! and \verb!$EMAIL!.
  91
  92 \paragraph{boring}\label{boring}
  93 The \verb!_darcs/prefs/boring! file may contain a list of regular
  94 expressions describing files, such as object files, that you do not expect
  95 to add to your project.  As an example, the boring file that I use with
  96 my darcs repository is:
  97 \begin{verbatim}
  98 \.hi$
  99 \.o$
 100 ^\.[^/]
 101 ^_
 102 ~$
 103 (^|/)CVS($|/)
 104 \end{verbatim}
 105 A newly created repository has a longer boring file that
 106 includes many common source control, backup, temporary, and compiled files.
 107
 108 You may want to have the boring file under version
 109 control.  To do this you can use darcs setpref to set the value
 110 ``boringfile'' to the name of your desired boring file
 111 (e.g.\ \verb-darcs setpref boringfile .boring-, where \verb-.boring-
 112 is the repository path of a file
 113 that has been
 114 darcs added to your repository).  The boringfile preference overrides
 115 \verb!_darcs/prefs/boring!, so be sure to copy that file to the boringfile.
 116
 117 You can also set up a ``boring'' regexps
 118 file in your home directory, named \verb!~/.darcs/boring!, which will be
 119 used with all of your darcs repositories.
 120
 121 Any file not already managed by darcs and whose repository path (such
 122 as \verb!manual/index.html!) matches any of
 123 the boring regular expressions is considered boring.  The boring file is
 124 used to filter the files provided to darcs add, to allow you to use a
 125 simple \verb-darcs add newdir newdir/*-
 126 without accidentally adding a bunch of
 127 object files.  It is also used when the \verb!--look-for-adds! flag is
 128 given to whatsnew or record.
 129 Note that once a file has been added to darcs, it is not considered
 130 boring, even if it matches the boring file filter.
 131
 132 \begin{code}
 133 {-# NOINLINE default_boring #-}
 134 default_boring :: [String]
 135 default_boring = ["# Boring file regexps:",
 136                   "",
 137                   "### compiler and interpreter intermediate files",
 138                   "# haskell (ghc) interfaces",
 139                   "\\.hi$", "\\.hi-boot$", "\\.o-boot$",
 140                   "# object files",
 141                   "\\.o$","\\.o\\.cmd$",
 142                   "# profiling haskell",
 143                   "\\.p_hi$", "\\.p_o$",
 144                   "# haskell program coverage resp. profiling info",
 145                   "\\.tix$", "\\.prof$",
 146                   "# fortran module files",
 147                   "\\.mod$",
 148                   "# linux kernel",
 149                   "\\.ko\\.cmd$","\\.mod\\.c$",
 150                   "(^|/)\\.tmp_versions($|/)",
 151                   "# *.ko files aren't boring by default because they might",
 152                   "# be Korean translations rather than kernel modules",
 153                   "# \\.ko$",
 154                   "# python, emacs, java byte code",
 155                   "\\.py[co]$", "\\.elc$","\\.class$",
 156                   "# objects and libraries; lo and la are libtool things",
 157                   "\\.(obj|a|exe|so|lo|la)$",
 158                   "# compiled zsh configuration files",
 159                   "\\.zwc$",
 160                   "# Common LISP output files for CLISP and CMUCL",
 161                   "\\.(fas|fasl|sparcf|x86f)$",
 162                   "",
 163                   "### build and packaging systems",
 164                   "# cabal intermediates",
 165                   "\\.installed-pkg-config",
 166                   "\\.setup-config",
 167                   "# standard cabal build dir, might not be boring for everybody",
 168                   "# ^dist(/|$)",
 169                   "# autotools",
 170                   "(^|/)autom4te\\.cache($|/)", "(^|/)config\\.(log|status)$",
 171                   "# microsoft web expression, visual studio metadata directories",
 172                   "\\_vti_cnf$",
 173                   "\\_vti_pvt$",
 174                   "# gentoo tools",
 175                   "\\.revdep-rebuild.*",
 176                   "# generated dependencies",
 177                   "^\\.depend$",
 178                   "",
 179                   "### version control systems",
 180                   "# cvs",
 181                   "(^|/)CVS($|/)","\\.cvsignore$",
 182                   "# cvs, emacs locks",
 183                   "^\\.#",
 184                   "# rcs",
 185                   "(^|/)RCS($|/)", ",v$",
 186                   "# subversion",
 187                   "(^|/)\\.svn($|/)",
 188                   "# mercurial",
 189                   "(^|/)\\.hg($|/)",
 190                   "# git",
 191                   "(^|/)\\.git($|/)",
 192                   "# bzr",
 193                   "\\.bzr$",
 194                   "# sccs",
 195                   "(^|/)SCCS($|/)",
 196                   "# darcs",
 197                   "(^|/)"++darcsdir++"($|/)", "(^|/)\\.darcsrepo($|/)",
 198                   "^\\.darcs-temp-mail$",
 199                   "-darcs-backup[[:digit:]]+$",
 200                   "# gnu arch",
 201                   "(^|/)(\\+|,)",
 202                   "(^|/)vssver\\.scc$",
 203                   "\\.swp$","(^|/)MT($|/)",
 204                   "(^|/)\\{arch\\}($|/)","(^|/).arch-ids($|/)",
 205                   "# bitkeeper",
 206                   "(^|/)BitKeeper($|/)","(^|/)ChangeSet($|/)",
 207                   "",
 208                   "### miscellaneous",
 209                   "# backup files",
 210                   "~$","\\.bak$","\\.BAK$",
 211                   "# patch originals and rejects",
 212                   "\\.orig$", "\\.rej$",
 213                   "# X server",
 214                   "\\..serverauth.*",
 215                   "# image spam",
 216                   "\\#", "(^|/)Thumbs\\.db$",
 217                   "# vi, emacs tags",
 218                   "(^|/)(tags|TAGS)$",
 219                   "#(^|/)\\.[^/]",
 220                   "# core dumps",
 221                   "(^|/|\\.)core$",
 222                   "# partial broken files (KIO copy operations)",
 223                   "\\.part$",
 224                   "# waf files, see http://code.google.com/p/waf/",
 225                   "(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+($|/)",
 226                   "(^|/)\\.lock-wscript$",
 227                   "# mac os finder",
 228                   "(^|/)\\.DS_Store$" ]
 229
 230 darcsdir_filter :: [FilePath] -> [FilePath]
 231 darcsdir_filter = filter (not.is_darcsdir)
 232 is_darcsdir :: FilePath -> Bool
 233 is_darcsdir ('.':'/':f) = is_darcsdir f
 234 is_darcsdir "." = True
 235 is_darcsdir "" = True
 236 is_darcsdir ".." = True
 237 is_darcsdir "../" = True
 238 is_darcsdir fp = darcsdir `isPrefixOf` fp
 239 boring_file_filter :: IO ([FilePath] -> [FilePath])
 240
 241 global_prefs_dir :: IO (Maybe FilePath)
 242 global_prefs_dir = (getAppUserDataDirectory "darcs" >>= return.Just)
 243                    `catchall` (return Nothing)
 244
 245 get_global f = do
 246   dir <- global_prefs_dir
 247   case dir of
 248     (Just d) -> get_preffile $ d </> f
 249     Nothing -> return []
 250
 251 global_cache_dir :: IO (Maybe FilePath)
 252 global_cache_dir = global_prefs_dir >>= return.(maybe Nothing (Just.(</> "cache")))
 253
 254 boring_file_filter = do
 255     borefile <- def_prefval "boringfile" (darcsdir ++ "/prefs/boring")
 256     bores <- get_lines borefile `catchall` return []
 257     gbs <- get_global "boring"
 258     return $ actual_boring_file_filter $ map mkRegex (bores++gbs)
 259
 260 noncomments :: [String] -> [String]
 261 noncomments ss = filter is_ok ss
 262                  where is_ok "" = False
 263                        is_ok ('#':_) = False
 264                        is_ok _ = True
 265
 266 get_lines :: ReadableDirectory m => FilePath -> m [String]
 267 get_lines f = (notconflicts . noncomments . map stripCr . lines)
 268               `liftM` mReadBinFile (fp2fn f)
 269     where notconflicts = filter nc
 270           startswith [] _ = True
 271           startswith (x:xs) (y:ys) | x == y = startswith xs ys
 272           startswith _ _ = False
 273           nc l | startswith "v v v v v v v" l = False
 274           nc l | startswith "*************" l = False
 275           nc l | startswith "^ ^ ^ ^ ^ ^ ^" l = False
 276           nc _ = True
 277
 278 actual_boring_file_filter :: [Regex] -> [FilePath] -> [FilePath]
 279 actual_boring_file_filter regexps fs =
 280     filter (abf (not.is_darcsdir) regexps . normalize) fs
 281     where
 282     abf fi (r:rs) = abf (\f -> fi f && isNothing (matchRegex r f)) rs
 283     abf fi [] = fi
 284 \end{code}
 285
 286 \begin{code}
 287 normalize :: FilePath -> FilePath
 288 normalize ('.':'/':f) = normalize f
 289 normalize f = normalize_helper $ reverse f
 290               where
 291               normalize_helper ('/':rf) = normalize_helper rf
 292               normalize_helper rf = reverse rf
 293 \end{code}
 294
 295 \paragraph{binaries}
 296 The \verb!_darcs/prefs/binaries! file may contain a list of regular
 297 expressions describing files that should be treated as binary files rather
 298 than text files. Darcs automatically treats files containing
 299 \verb!^Z\! or \verb!'\0'! within the first 4096 bytes as being binary files.
 300 You probably will want to have the binaries file under
 301 version control.  To do this you can use darcs setpref to set the value
 302 ``binariesfile'' to the name of your desired binaries file
 303 (e.g.\ \verb'darcs setpref binariesfile ./.binaries', where
 304 \verb'.binaries' is a file that has been
 305 darcs added to your repository).  As with the boring file, you can also set
 306 up a \verb!~/.darcs/binaries! file if you like.
 307
 308 \begin{code}
 309 data FileType = BinaryFile | TextFile
 310                 deriving (Eq)
 311
 312 {-# NOINLINE default_binaries #-}
 313 default_binaries :: [String]
 314 default_binaries =
 315     "# Binary file regexps:" :
 316     ext_regexes ["png","gz","pdf","jpg","jpeg","gif","tif",
 317                  "tiff","pnm","pbm","pgm","ppm","bmp","mng",
 318                  "tar","bz2","z","zip","jar","so","a",
 319                  "tgz","mpg","mpeg","iso","exe","doc",
 320                  "elc", "pyc"]
 321     where ext_regexes exts = concat $ map ext_regex exts
 322           ext_regex e = ["\\."++e++"$", "\\."++map toUpper e++"$"]
 323
 324 filetype_function :: IO (FilePath -> FileType)
 325 filetype_function = do
 326     binsfile <- def_prefval "binariesfile" (darcsdir ++ "/prefs/binaries")
 327     bins <- get_lines binsfile `catch`
 328              (\e-> if isDoesNotExistError e then return [] else ioError e)
 329     gbs <- get_global "binaries"
 330     regexes <- return (map (\r -> mkRegex r) (bins ++ gbs))
 331     let isbin f = or $ map (\r -> isJust $ matchRegex r f) regexes
 332         ftf f = if isbin $ normalize f then BinaryFile else TextFile
 333         in
 334         return ftf
 335 \end{code}
 336
 337 \begin{code}
 338 add_to_preflist :: WriteableDirectory m => String -> String -> m ()
 339 get_preflist :: ReadableDirectory m => String -> m [String]
 340 set_preflist :: WriteableDirectory m => String -> [String] -> m ()
 341 get_global :: String -> IO [String]
 342
 343 set_defaultrepo :: String -> [DarcsFlag] -> IO ()
 344 \end{code}
 345
 346 \begin{code}
 347 -- this avoids a circular dependency with Repository
 348 prefsDirectory :: ReadableDirectory m => m String
 349 prefsDirectory =
 350     do darcs <- mDoesDirectoryExist $ fp2fn darcsdir
 351        if darcs
 352           then return $ darcsdir ++ "/prefs/"
 353           else fail $ "Directory " ++ darcsdir ++ "/ does not exist!"
 354
 355 withPrefsDirectory :: ReadableDirectory m => (String -> m ()) -> m ()
 356 withPrefsDirectory j = do prefs <- prefsDirectory `mplus` return "x"
 357                           when (prefs /= "x") $ j prefs
 358
 359 add_to_preflist p s = withPrefsDirectory $ \prefs -> do
 360   hasprefs <- mDoesDirectoryExist $ fp2fn prefs
 361   unless hasprefs $ mCreateDirectory $ fp2fn prefs
 362   pl <- get_preflist p
 363   mWriteBinFile (fp2fn $ prefs ++ p) $ unlines $ add_to_list s pl
 364 get_preflist p = do prefs <- prefsDirectory `mplus` return "x"
 365                     if (prefs /= "x") then get_preffile $ prefs ++ p
 366                                       else return []
 367 get_preffile :: ReadableDirectory m => FilePath -> m [String]
 368 get_preffile f = do
 369   hasprefs <- mDoesFileExist (fp2fn f)
 370   if hasprefs
 371     then get_lines f
 372     else return []
 373
 374 set_preflist p ls = withPrefsDirectory $ \prefs -> do
 375   haspref <- mDoesDirectoryExist $ fp2fn prefs
 376   if haspref
 377      then mWriteBinFile (fp2fn $ prefs ++ p) (unlines ls)
 378      else return ()
 379
 380 add_to_list :: Eq a => a -> [a] -> [a]
 381 add_to_list s [] = [s]
 382 add_to_list s (s':ss) = if s == s' then (s:ss) else s': add_to_list s ss
 383 \end{code}
 384
 385 \begin{code}
 386 set_prefval :: WriteableDirectory m => String -> String -> m ()
 387 get_prefval :: ReadableDirectory m => String -> m (Maybe String)
 388 def_prefval :: String -> String -> IO String
 389 def_prefval p d = do
 390   pv <- get_prefval p
 391   case pv of Nothing -> return d
 392              Just v -> return v
 393 get_prefval p =
 394     do pl <- get_preflist "prefs"
 395        case map snd $ filter ((==p).fst) $ map (break (==' ')) pl of
 396            [val] -> case words val of
 397                [] -> return Nothing
 398                _ -> return $ Just $ tail val
 399            _ -> return Nothing
 400 set_prefval p v = do pl <- get_preflist "prefs"
 401                      set_preflist "prefs" $
 402                        filter ((/=p).fst.(break (==' '))) pl ++ [p++" "++v]
 403 change_prefval :: WriteableDirectory m => String -> String -> String -> m ()
 404 change_prefval p f t =
 405     do pl <- get_preflist "prefs"
 406        ov <- get_prefval p
 407        newval <- case ov of
 408                  Nothing -> return t
 409                  Just old -> if old == f then return t else return old
 410        set_preflist "prefs" $
 411                     filter ((/=p).fst.(break(==' '))) pl ++ [p++" "++newval]
 412 \end{code}
 413
 414 \begin{code}
 415 defaultrepo :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
 416 defaultrepo opts orig [] =
 417   do let fixR r | not (is_file r) = return r
 418                 | otherwise = do absr <- ioAbsolute r
 419                                  return $ toFilePath $ makeRelative orig absr
 420      case [r | RemoteRepo r <- opts] of
 421        [] -> do defrepo <- get_preflist "defaultrepo"
 422                 case defrepo of
 423                   [r] -> (:[]) `fmap` fixR r
 424                   _ -> return []
 425        rs -> mapM fixR rs
 426 defaultrepo _ _ r = return r
 427 set_defaultrepo r opts = do doit <- if (NoSetDefault `notElem` opts && DryRun `notElem` opts && r_is_not_tmp)
 428                                     then return True
 429                                     else do olddef <-
 430                                                 get_preflist "defaultrepo"
 431                                             return (olddef == [])
 432                             when doit
 433                                 (set_preflist "defaultrepo" [r])
 434                             add_to_preflist "repos" r
 435                          `catchall` return () -- we don't care if this fails!
 436  where
 437   r_is_not_tmp = not $ r `elem` [x | RemoteRepo x <- opts]
 438 \end{code}
 439
 440 \paragraph{email}
 441 The \verb!_darcs/prefs/email! file is used to provide the e-mail address for your
 442 repository that others will use when they \verb!darcs send! a patch back to you.
 443 The contents of the file should simply be an e-mail address.
 444
 445
 446 \paragraph{sources}
 447 The \verb!_darcs/prefs/sources! file is used to indicate alternative
 448 locations from which to download patches when using a ``hashed''
 449 repository.  This file contains lines such as:
 450 \begin{verbatim}
 451 cache:/home/droundy/.darcs/cache
 452 readonly:/home/otheruser/.darcs/cache
 453 repo:http://darcs.net
 454 \end{verbatim}
 455 This would indicate that darcs should first look in
 456 \verb!/home/droundy/.darcs/cache! for patches that might be missing, and if
 457 the patch isn't there, it should save a copy there for future use.  In that
 458 case, darcs will look in \verb!/home/otheruser/.darcs/cache! to see if that
 459 user might have downloaded a copy, but won't try to save a copy there, of
 460 course.  Finally, it will look in \verb!http://darcs.net!.  Note that the
 461 \verb!sources! file can also exist in \verb!~/.darcs/!.  Also note that the
 462 sources mentioned in your \verb!sources! file will be tried \emph{before}
 463 the repository you are pulling from.  This can be useful in avoiding
 464 downloading patches multiple times when you pull from a remote repository
 465 to more than one local repository.
 466
 467 We strongly advise that you enable a global cache directory, which will
 468 allow darcs to avoid re-downloading patches (for example, when doing a
 469 second darcs get of the same repository), and also allows darcs to use hard
 470 links to reduce disk usage.  To do this, simply
 471 \begin{verbatim}
 472 mkdir -p $HOME/.darcs/cache
 473 echo cache:$HOME/.darcs/cache > $HOME/.darcs/sources
 474 \end{verbatim}
 475 Note that the cache directory should reside on the same filesystem as your
 476 repositories, so you may need to vary this.  You can also use multiple
 477 cache directories on different filesystems, if you have several filesystems
 478 on which you use darcs.
 479
 480 \begin{code}
 481 getCaches :: [DarcsFlag] -> String -> IO Cache
 482 getCaches opts repodir =
 483     do here <- parsehs `fmap` get_preffile (darcsdir ++ "/prefs/sources")
 484        there <- (parsehs . lines . BC.unpack) `fmap`
 485                 (gzFetchFilePS (repodir ++ "/" ++ darcsdir ++ "/prefs/sources") Cachable
 486                  `catchall` return B.empty)
 487        globalcachedir <- global_cache_dir
 488        let globalcache = case (nocache,globalcachedir) of
 489                            (True,_) -> []
 490                            (_,Just d) -> [Cache Directory Writable d]
 491                            _ -> []
 492        globalsources <- parsehs `fmap` get_global "sources"
 493        thisdir <- getCurrentDirectory
 494        let thisrepo = if Ephemeral `elem` opts
 495                       then [Cache Repo NotWritable $ toFilePath thisdir]
 496                       else [Cache Repo Writable $ toFilePath thisdir]
 497        return $ Ca $ nub $ thisrepo ++ globalcache ++ globalsources ++
 498                   here ++ [Cache Repo NotWritable repodir] ++ there
 499       where
 500             parsehs = catMaybes . map readln . noncomments
 501             readln l | take 5 l == "repo:" = Just (Cache Repo NotWritable (drop 5 l))
 502                      | take 9 l == "thisrepo:" = Just (Cache Repo Writable (drop 9 l))
 503                      | nocache = Nothing
 504                      | take 6 l == "cache:" = Just (Cache Directory Writable (drop 6 l))
 505                      | take 9 l == "readonly:" = Just (Cache Directory NotWritable (drop 9 l))
 506                      | otherwise = Nothing
 507             nocache = NoCache `elem` opts
 508
 509 \end{code}
 510