% Copyright (C) 2002-2003 David Roundy % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2, or (at your option) % any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; see the file COPYING. If not, write to % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, % Boston, MA 02110-1301, USA. \begin{code} module RepoPrefs ( add_to_preflist, get_preflist, set_preflist, get_global, defaultrepo, set_defaultrepo, get_prefval, set_prefval, change_prefval, def_prefval, write_default_prefs, boring_file_filter, darcsdir_filter, FileType(..), filetype_function, ) where import IO ( isDoesNotExistError ) import Monad ( liftM, unless, when, mplus ) import Text.Regex ( Regex, mkRegex, matchRegex, ) import Char ( toUpper ) import Maybe ( isNothing, isJust ) import System ( getEnv ) import DarcsFlags ( DarcsFlag( NoSetDefault ) ) import DarcsUtils ( catchall, stripCr ) import DarcsIO ( ReadableDirectory(..), WriteableDirectory(..) ) import FileName ( fp2fn ) import FilePathUtils ( unfix_maybe_absolute ) \end{code} \section{prefs} The \verb!_darcs! directory contains a \verb!prefs! directory. This directory exists simply to hold user configuration settings specific to this repository. The contents of this directory are intended to be modifiable by the user, although in some cases a mistake in such a modification may cause darcs to behave strangely. \input{ArgumentDefaults.lhs} \begin{code} write_default_prefs :: IO () write_default_prefs = do sequence_ [default_boring, default_binaries] set_preflist "motd" [] \end{code} \paragraph{repos} The \verb!_darcs/prefs/repos! file contains a list of repositories you have pulled from or pushed to, and is used for autocompletion of pull and push commands in bash. Feel free to delete any lines from this list that might get in there, or to delete the file as a whole. \paragraph{author}\label{author_prefs} The \verb!_darcs/prefs/author! file contains the email address (or name) to be used as the author when patches are recorded in this repository, e.g.\ \verb!David Roundy !. This file overrides the contents of the environment variables \verb!$DARCS_EMAIL! and \verb!$EMAIL!. \paragraph{boring}\label{boring} The \verb!_darcs/prefs/boring! file may contain a list of regular expressions describing files, such as object files, that you do not expect to add to your project. As an example, the boring file that I use with my darcs repository is: \begin{verbatim} \.hi$ \.o$ ^\.[^/] ^_ ~$ (^|/)CVS($|/) \end{verbatim} A newly created repository has a longer boring file that includes many common source control, backup, temporary, and compiled files. You may want to have the boring file under version control. To do this you can use darcs setpref to set the value ``boringfile'' to the name of your desired boring file (e.g.\ \verb-darcs setpref boringfile .boring-, where \verb-.boring- is the repository path of a file that has been darcs added to your repository). The boringfile preference overrides \verb!_darcs/prefs/boring!, so be sure to copy that file to the boringfile. You can also set up a ``boring'' regexps file in your home directory, named \verb!~/.darcs/boring!, which will be used with all of your darcs repositories. Any file whose repository path (such as \verb!manual/index.html!) matches any of the boring regular expressions is considered boring. The boring file is used to filter the files provided to darcs add, to allow you to use a simple \verb-darcs add newdir newdir/*- without accidentally adding a bunch of object files. It is also used when the \verb!--look-for-adds! flag is given to whatsnew or record. \begin{code} default_boring :: IO () default_boring = set_preflist "boring" $ "# Boring file regexps:" : ["\\.hi$", "\\.hi-boot$", "\\.o-boot$", -- Haskell interfaces "\\.o$","\\.o\\.cmd$", -- object files "# *.ko files aren't boring by default because they might", "# be Korean translations rather than kernel modules.", "# \\.ko$", "\\.ko\\.cmd$","\\.mod\\.c$", "(^|/)\\.tmp_versions($|/)", "(^|/)CVS($|/)","\\.cvsignore$", -- CVS "^\\.#", -- CVS, Emacs locks "(^|/)RCS($|/)", ",v$", -- RCS "(^|/)\\.svn($|/)", -- Subversion admin directory "\\.bzr$", "(^|/)SCCS($|/)", -- bzr, SCCS "~$", -- Emacs (and other) backups "(^|/)_darcs($|/)", -- darcs admin directory "\\.bak$","\\.BAK$", -- editor backups(?) "\\.orig$", "\\.rej$", -- patch originals and rejects "(^|/)vssver\\.scc$", "\\.swp$","(^|/)MT($|/)", "(^|/)\\{arch\\}($|/)","(^|/).arch-ids($|/)", -- GNU Arch "(^|/),","\\.prof$","(^|/)\\.DS_Store$", "(^|/)BitKeeper($|/)","(^|/)ChangeSet($|/)", -- Python, Emacs, Java byte code: "\\.py[co]$", "\\.elc$","\\.class$", "\\#", "(^|/)Thumbs\\.db$", -- autotools stuff: "(^|/)autom4te\\.cache($|/)", "(^|/)config\\.(log|status)$", "^\\.depend$", -- generated dependencies "(^|/)(tags|TAGS)$", -- vi, Emacs tags "#(^|/)\\.[^/]", "(^|/|\\.)core$", -- core dumps -- objects and libraries; lo and la are libtool things "\\.(obj|a|exe|so|lo|la)$", "^\\.darcs-temp-mail$" -- darcs editor file ] darcsdir_filter :: [FilePath] -> [FilePath] darcsdir_filter = filter (not.is_darcsdir) is_darcsdir :: FilePath -> Bool is_darcsdir ('.':'/':f) = is_darcsdir f is_darcsdir "." = True is_darcsdir "" = True is_darcsdir ".." = True is_darcsdir "../" = True is_darcsdir "_darcs" = True is_darcsdir ('_':'d':'a':'r':'c':'s':'/':_) = True is_darcsdir _ = False boring_file_filter :: IO ([FilePath] -> [FilePath]) get_global f = (getEnv "HOME" >>= get_preffile.(++("/.darcs/"++f))) `catchall` return [] boring_file_filter = do borefile <- def_prefval "boringfile" "_darcs/prefs/boring" bores <- get_lines borefile `catchall` return [] gbs <- get_global "boring" return $ actual_boring_file_filter $ map mkRegex (bores++gbs) noncomments :: [String] -> [String] noncomments ss = filter is_ok ss where is_ok "" = False is_ok ('#':_) = False is_ok _ = True get_lines :: ReadableDirectory m => FilePath -> m [String] get_lines f = (notconflicts . noncomments . map stripCr . lines) `liftM` mReadBinFile (fp2fn f) where notconflicts = filter nc startswith [] _ = True startswith (x:xs) (y:ys) | x == y = startswith xs ys startswith _ _ = False nc l | startswith "v v v v v v v" l = False nc l | startswith "*************" l = False nc l | startswith "^ ^ ^ ^ ^ ^ ^" l = False nc _ = True actual_boring_file_filter :: [Regex] -> [FilePath] -> [FilePath] actual_boring_file_filter regexps fs = filter (abf (not.is_darcsdir) regexps . normalize) fs where abf fi (r:rs) = abf (\f -> fi f && isNothing (matchRegex r f)) rs abf fi [] = fi \end{code} \begin{code} normalize :: FilePath -> FilePath normalize ('.':'/':f) = normalize f normalize f = normalize_helper $ reverse f where normalize_helper ('/':rf) = normalize_helper rf normalize_helper rf = reverse rf \end{code} \paragraph{binaries} The \verb!_darcs/prefs/binaries! file may contain a list of regular expressions describing files that should be treated as binary files rather than text files. You probably will want to have the binaries file under version control. To do this you can use darcs setpref to set the value ``binariesfile'' to the name of your desired binaries file (e.g.\ \verb'darcs setpref binariesfile ./.binaries', where \verb'.binaries' is a file that has been darcs added to your repository). As with the boring file, you can also set up a \verb!~/.darcs/binaries! file if you like. \begin{code} data FileType = BinaryFile | TextFile deriving (Eq) default_binaries :: IO () default_binaries = set_preflist "binaries" $ "# Binary file regexps:" : ext_regexes ["png","gz","pdf","jpg","jpeg","gif","tif", "tiff","pnm","pbm","pgm","ppm","bmp","mng", "tar","bz2","z","zip","jar","so","a", "tgz","mpg","mpeg","iso","exe","doc", "elc", "pyc"] where ext_regexes exts = concat $ map ext_regex exts ext_regex e = ["\\."++e++"$", "\\."++map Char.toUpper e++"$"] filetype_function :: IO (FilePath -> FileType) filetype_function = do binsfile <- def_prefval "binariesfile" "_darcs/prefs/binaries" bins <- get_lines binsfile `catch` (\e-> if isDoesNotExistError e then return [] else ioError e) gbs <- get_global "binaries" regexes <- return (map (\r -> mkRegex r) (bins ++ gbs)) let isbin f = or $ map (\r -> isJust $ matchRegex r f) regexes ftf f = if isbin $ normalize f then BinaryFile else TextFile in return ftf \end{code} \begin{code} add_to_preflist :: WriteableDirectory m => String -> String -> m () get_preflist :: ReadableDirectory m => String -> m [String] set_preflist :: WriteableDirectory m => String -> [String] -> m () get_global :: String -> IO [String] set_defaultrepo :: String -> [DarcsFlag] -> IO () \end{code} \begin{code} -- this avoids a circular dependency with Repository prefsDirectory :: ReadableDirectory m => m String prefsDirectory = do darcs <- mDoesDirectoryExist $ fp2fn "_darcs" if darcs then return "_darcs/prefs/" else do git <- mDoesDirectoryExist $ fp2fn ".git" if git then return ".git/darcs-prefs/" else fail "Neither _darcs/ not .git/" withPrefsDirectory :: ReadableDirectory m => (String -> m ()) -> m () withPrefsDirectory j = do prefs <- prefsDirectory `mplus` return "x" when (prefs /= "x") $ j prefs add_to_preflist p s = withPrefsDirectory $ \prefs -> do hasprefs <- mDoesDirectoryExist $ fp2fn prefs unless hasprefs $ mCreateDirectory $ fp2fn prefs pl <- get_preflist p mWriteBinFile (fp2fn $ prefs ++ p) $ unlines $ add_to_list s pl get_preflist p = do prefs <- prefsDirectory `mplus` return "x" if (prefs /= "x") then get_preffile $ prefs ++ p else return [] get_preffile :: ReadableDirectory m => FilePath -> m [String] get_preffile f = do hasprefs <- mDoesFileExist (fp2fn f) if hasprefs then get_lines f else return [] set_preflist p ls = withPrefsDirectory $ \prefs -> do haspref <- mDoesDirectoryExist $ fp2fn prefs if haspref then mWriteBinFile (fp2fn $ prefs ++ p) (unlines ls) else return () add_to_list :: Eq a => a -> [a] -> [a] add_to_list s [] = [s] add_to_list s (s':ss) = if s == s' then (s:ss) else s': add_to_list s ss \end{code} \begin{code} set_prefval :: WriteableDirectory m => String -> String -> m () get_prefval :: ReadableDirectory m => String -> m (Maybe String) def_prefval :: String -> String -> IO String def_prefval p d = do pv <- get_prefval p case pv of Nothing -> return d Just v -> return v get_prefval p = do pl <- get_preflist "prefs" case map snd $ filter ((==p).fst) $ map (break (==' ')) pl of [val] -> case words val of [] -> return Nothing _ -> return $ Just $ tail val _ -> return Nothing set_prefval p v = do pl <- get_preflist "prefs" set_preflist "prefs" $ filter ((/=p).fst.(break (==' '))) pl ++ [p++" "++v] change_prefval :: WriteableDirectory m => String -> String -> String -> m () change_prefval p f t = do pl <- get_preflist "prefs" ov <- get_prefval p newval <- case ov of Nothing -> return t Just old -> if old == f then return t else return old set_preflist "prefs" $ filter ((/=p).fst.(break(==' '))) pl ++ [p++" "++newval] \end{code} \begin{code} defaultrepo :: FilePath -> [String] -> IO [String] defaultrepo fix [] = do defrepo <- get_preflist "defaultrepo" case defrepo of [r] -> return [unfix_maybe_absolute fix r] _ -> return [] defaultrepo _ r = return r set_defaultrepo r opts = do doit <- if not (NoSetDefault `elem` opts) then return True else do olddef <- get_preflist "defaultrepo" return (olddef == []) when doit (set_preflist "defaultrepo" [r]) add_to_preflist "repos" r \end{code} \paragraph{email} The \verb!_darcs/prefs/email! file is used to provide the e-mail address for your repository that others will use when they \verb!darcs send! a patch back to you. The contents of the file should simply be an e-mail address.