%  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}
{-# OPTIONS -fglasgow-exts #-}
#include "gadts.h"
module Darcs.Repository.Prefs ( 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,
                   okayHash, takeHash,
                   Cache, getCaches, unionCaches, cleanCaches,
                   fetchFileUsingCache, speculateFileUsingCache, writeFileUsingCache,
                   findFileMtimeUsingCache, setFileMtimeUsingCache, peekInCache,
                   repo2cache
                 ) where

import System.Posix ( setFileTimes )
import System.IO ( hPutStrLn, stderr )
import System.IO.Error ( isDoesNotExistError )
import System.Posix.Files ( linkCount, modificationTime, getSymbolicLinkStatus )
import System.Posix.Types ( EpochTime )
import Workaround ( getCurrentDirectory, createLink, createDirectoryIfMissing )
import System.Directory ( removeFile, doesFileExist, getDirectoryContents )
import Control.Monad ( liftM, unless, when, mplus, guard )
import Text.Regex ( Regex, mkRegex, matchRegex, )
import Data.Char ( toUpper )
import Data.Maybe ( isNothing, isJust, catMaybes, listToMaybe )
import Data.List ( nub )
import System ( getEnv )

import Stringalike ( Stringalike, sal_length )
import Darcs.SlurpDirectory ( undefined_time )
import Darcs.Flags ( DarcsFlag( NoSetDefault, DryRun, Ephemeral, NoCompress ) )
import Darcs.Utils ( withCurrentDirectory, catchall, stripCr )
import Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..) )
import FileName ( fp2fn )
import Darcs.Lock ( writeAtomicFilePS, gzWriteAtomicFilePS )
import Darcs.FilePathUtils ( unmake_relative )
import Darcs.URL ( is_file )
import Darcs.External ( gzFetchFilePS, fetchFilePS, speculateFileOrUrl, copyFileOrUrl,
                        Cachable( Cachable ) )
import Darcs.Progress ( progressList, debugMessage, debugFail )
import SHA1 ( sha1PS )
import Crypt.SHA256 ( sha256sum )
import FastPackedString ( PackedString, nilPS, unpackPS, gzWriteFilePS, lengthPS,
                          linesPS, dropPS )
\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{Darcs/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 <droundy@abridgegame.org>!.  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 not already managed by darcs and 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.
Note that once a file has been added to darcs, it is not considered
boring, even if it matches the boring file filter.

\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
                  "(^|/)\\.hg($|/)", -- Mercurial
                  "\\.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
                  "-darcs-backup[[:digit:]]+$", -- merge conflict backups
                  -- Common LISP output files for CLISP and CMUCL
                  "\\.(fas|fasl|sparcf|x86f)$",
                  "\\.part$", -- partial broken files (KIO copy operations)
                  -- WAF files. ( http://code.google.com/p/waf/ )
                  "(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+($|/)",
                  "(^|/)\\.lock-wscript$",
                  "^\\.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. Darcs automatically treats files containing
\verb!^Z\! or \verb!'\0'! as binary.
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 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 fail "Directory _darcs/ does not exist!"

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 [unmake_relative fix r]
                            _ -> return []

defaultrepo _ r = return r
set_defaultrepo r opts = do doit <- if (NoSetDefault `notElem` opts && DryRun `notElem` 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.

\begin{code}
data WritableOrNot = Writable | NotWritable deriving ( Show )
data CacheType = Repo | Directory deriving ( Eq, Show )
data CacheLoc = Cache !CacheType !WritableOrNot !String
newtype Cache = Ca [CacheLoc] -- abstract type for hiding cache

instance Eq CacheLoc where
    (Cache Repo _ a) == (Cache Repo _ b) = a == b
    (Cache Directory _ a) == (Cache Directory _ b) = a == b
    _ == _ = False
instance Show CacheLoc where
    show (Cache Repo Writable a) = "thisrepo:" ++ a
    show (Cache Repo NotWritable a) = "repo:" ++ a
    show (Cache Directory Writable a) = "cache:" ++ a
    show (Cache Directory NotWritable a) = "readonly:" ++ a
instance Show Cache where
    show (Ca cs) = unlines $ map show cs

unionCaches :: Cache -> Cache -> Cache
unionCaches (Ca a) (Ca b) = Ca (nub (a++b))

repo2cache :: String -> Cache
repo2cache r = Ca [Cache Repo NotWritable r]

okayHash :: Stringalike s => s -> Bool
okayHash s = sal_length s == 40 || sal_length s == 64 || sal_length s == 75

takeHash :: PackedString -> Maybe (String, PackedString)
takeHash ps = do h <- listToMaybe $ linesPS ps
                 guard $ okayHash h
                 Just (unpackPS h, dropPS (lengthPS h) ps)

checkHash :: String -> PackedString -> Bool
checkHash h s | length h == 40 = sha1PS s == h
              | length h == 64 = sha256sum s == h
              | length h == 75 = lengthPS s == read (take 10 h) && sha256sum s == drop 11 h
              | otherwise = False

getCaches :: [DarcsFlag] -> String -> IO Cache
getCaches opts repodir =
    do here <- parsehs `fmap` get_preffile "_darcs/prefs/sources"
       there <- (parsehs . lines . unpackPS) `fmap`
                (gzFetchFilePS (repodir ++ "/_darcs/prefs/sources") Cachable
                 `catchall` return nilPS)
       maincache <- parsehs `fmap` get_global "sources"
       thisdir <- getCurrentDirectory
       let thisrepo = if Ephemeral `elem` opts
                      then [Cache Repo NotWritable thisdir]
                      else [Cache Repo Writable thisdir]
       return $ Ca $ nub $ thisrepo ++ maincache ++ here ++
                  [Cache Repo NotWritable repodir] ++ there
      where parsehs = catMaybes . map readln . noncomments
            readln l | take 5 l == "repo:" = Just (Cache Repo NotWritable (drop 5 l))
                     | take 9 l == "thisrepo:" = Just (Cache Repo Writable (drop 9 l))
                     | take 6 l == "cache:" = Just (Cache Directory Writable (drop 6 l))
                     | take 9 l == "readonly:" = Just (Cache Directory NotWritable (drop 9 l))
                     | otherwise = Nothing

findFileMtimeUsingCache :: Cache -> String -> String -> IO EpochTime
findFileMtimeUsingCache (Ca cache) subdir f = mt cache
    where mt [] = return undefined_time
          mt (Cache Repo Writable r:_) = (modificationTime `fmap`
                                          getSymbolicLinkStatus (r++"/_darcs/"++subdir++"/"++f))
                                         `catchall` return undefined_time
          mt (_:cs) = mt cs

setFileMtimeUsingCache :: Cache -> String -> String -> EpochTime -> IO ()
setFileMtimeUsingCache (Ca cache) subdir f t = st cache
    where st [] = return ()
          st (Cache Repo Writable r:_) = setFileTimes (r++"/_darcs/"++subdir++"/"++f) t t
                                         `catchall` return ()
          st (_:cs) = st cs

fetchFileUsingCache :: Cache -> String -> String -> IO (String, PackedString)
fetchFileUsingCache = fetchFileUsingCachePrivate Anywhere

peekInCache :: Cache -> String -> String -> IO Bool
peekInCache (Ca cache) subdir f = cacheHasIt cache `catchall` return False
    where cacheHasIt [] = return False
          cacheHasIt (Cache _ NotWritable _:cs) = cacheHasIt cs
          cacheHasIt (Cache t Writable d:cs) = do ex <- doesFileExist (fn t d)
                                                  if ex then return True
                                                        else cacheHasIt cs
          fn Directory d = d ++ "/" ++ subdir ++ "/" ++ f
          fn Repo r = r ++ "/_darcs/" ++ subdir ++ "/" ++ f

speculateFileUsingCache :: Cache -> String -> String -> IO ()
speculateFileUsingCache c sd h = do debugMessage $ "Speculating on "++h
                                    copyFileUsingCache OnlySpeculate c sd h

data OrOnlySpeculate = ActuallyCopy | OnlySpeculate deriving ( Eq )

copyFileUsingCache :: OrOnlySpeculate -> Cache -> String -> String -> IO ()
copyFileUsingCache oos (Ca cache) subdir f =
    do debugMessage $ "I'm doing copyFileUsingCache on "++subdir++"/"++f
       Just stickItHere <- cacheLoc cache
       createDirectoryIfMissing False (reverse $ dropWhile (/='/') $ reverse stickItHere)
       sfuc cache stickItHere
    `catchall` return ()
    where cacheLoc [] = return Nothing
          cacheLoc (Cache _ NotWritable _:cs) = cacheLoc cs
          cacheLoc (Cache t Writable d:cs) =
              do ex <- doesFileExist (fn t d)
                 if ex then fail "Bug in darcs: This exception should be caught in speculateFileUsingCache"
                       else do othercache <- cacheLoc cs
                               case othercache of Just x -> return $ Just x
                                                  Nothing -> return $ Just (fn t d)
          sfuc [] _ = return ()
          sfuc (Cache t NotWritable d:_) out = if oos == OnlySpeculate
                                               then speculateFileOrUrl (fn t d) out
                                               else copyFileOrUrl [] (fn t d) out Cachable
          sfuc (_:cs) out = sfuc cs out
          fn Directory d = d ++ "/" ++ subdir ++ "/" ++ f
          fn Repo r = r ++ "/_darcs/" ++ subdir ++ "/" ++ f


data FromWhere = LocalOnly | Anywhere deriving ( Eq )

fetchFileUsingCachePrivate :: FromWhere -> Cache -> String -> String -> IO (String, PackedString)
fetchFileUsingCachePrivate fromWhere (Ca cache) subdir f =
    do when (fromWhere == Anywhere) $ copyFileUsingCache ActuallyCopy (Ca cache) subdir f
       ffuc cache
    `catchall` debugFail ("Couldn't fetch `"++f++"'\nin subdir "++subdir++
                          " from sources:\n\n"++show (Ca cache))
    where ffuc (Cache t NotWritable d:cs)
              | Anywhere == fromWhere || is_file (fn t d) =
              do debugMessage $ "In fetchFileUsingCachePrivate I'm going manually"
                 debugMessage $ "    getting "++f
                 debugMessage $ "    from "++fn t d
                 x <- gzFetchFilePS (fn t d) Cachable
                 if not $ checkHash f x
                    then do x' <- fetchFilePS (fn t d) Cachable
                            when (not $ checkHash f x') $
                                 do hPutStrLn stderr $ "Hash failure in "++d++" of hash "++f
                                    fail $ "Hash failure in "++d++" of hash "++f
                            return (fn t d, x')
                    else return (fn t d, x) -- FIXME: create links in caches
              `catchall` ffuc cs
          ffuc (Cache t Writable d:cs) =
              do x1 <- gzFetchFilePS (fn t d) Cachable
                 x <- if not $ checkHash f x1
                      then do x2 <- fetchFilePS (fn t d) Cachable
                              when (not $ checkHash f x2) $
                                 do hPutStrLn stderr $ "Hash failure in "++d++" of hash "++f
                                    removeFile (fn t d)
                                    fail $ "Hash failure in "++d++" of hash "++f
                              return x2
                      else return x1
                 mapM_ (tryLinking (fn t d)) cs
                 return (fn t d, x)
              `catchall` do (fname,x) <- ffuc cs
                            do createCache t d subdir
                               createLink fname (fn t d)
                               return (fn t d, x)
                             `catchall`
                             do gzWriteFilePS (fn t d) x `catchall` return ()
                                return (fname,x)
          ffuc (_:cs) = ffuc cs
          ffuc [] = debugFail $ "No sources from which to fetch file `"++f++"'\n"++ show (Ca cache)
          tryLinking ff (Cache Directory Writable d) =
              do createDirectoryIfMissing False (d++"/"++subdir)
                 createLink ff (fn Directory d)
              `catchall` return ()
          tryLinking _ _ = return ()
          fn Directory d = d ++ "/" ++ subdir ++ "/" ++ f
          fn Repo r = r ++ "/_darcs/" ++ subdir ++ "/" ++ f

createCache :: CacheType -> String -> String -> IO ()
createCache Directory d subdir = createDirectoryIfMissing True (d ++ "/" ++ subdir)
createCache _ _ _ = return ()

writeFileUsingCache :: Cache -> [DarcsFlag] -> String -> PackedString -> IO String
writeFileUsingCache (Ca cache) opts subdir ps =
    (fetchFileUsingCachePrivate LocalOnly (Ca cache) subdir hash >> return hash) `catchall`
    wfuc cache `catchall`
         debugFail ("Couldn't write `"++hash++"'\nin subdir "++subdir++" to sources:\n\n"++
                    show (Ca cache))
    where hash = case show (lengthPS ps) of
                 x | l > 10 -> sha256sum ps
                   | otherwise -> take (10-l) (repeat '0') ++ x ++'-':sha256sum ps
                                        where l = length x
          wfuc (Cache _ NotWritable _:cs) = wfuc cs
          wfuc (Cache t Writable d:_) =
              do createCache t d subdir
                 if NoCompress `elem` opts
                    then writeAtomicFilePS (fn t d) ps -- FIXME: create links in caches
                    else gzWriteAtomicFilePS (fn t d) ps -- FIXME: create links in caches
                 return hash
          wfuc [] = debugFail $ "No location to write file `" ++ subdir ++"/"++hash ++ "'"
          fn Directory d = d ++ "/" ++ subdir ++ "/" ++ hash
          fn Repo r = r ++ "/_darcs/" ++ subdir ++ "/" ++ hash

cleanCaches :: Cache -> String -> IO ()
cleanCaches (Ca cs) subdir = mapM_ cleanCache cs
    where cleanCache (Cache Directory Writable d) =
             (withCurrentDirectory (d++"/"++subdir) $
              do fs <- getDirectoryContents "."
                 mapM_ clean $ progressList ("Cleaning cache "++d++"/"++subdir) $
                       filter okayHash fs) `catchall` return ()
          cleanCache _ = return ()
          clean f = do lc <- linkCount `liftM` getSymbolicLinkStatus f
                       when (lc < 2) $ removeFile f
                    `catchall` return ()

\end{code}

\paragraph{sources}
The \verb!_darcs/prefs/sources! file is used to indicate alternative
locations from which to download patches when using a ``hashed''
repository.  This file contains lines such as:
\begin{verbatim}
cache:/home/droundy/.darcs/cache
readonly:/home/otheruser/.darcs/cache
repo:http://darcs.net
\end{verbatim}
This would indicate that darcs should first look in
\verb!/home/droundy/.darcs/cache! for patches that might be missing, and if
the patch isn't there, it should save a copy there for future use.  In that
case, darcs will look in \verb!/home/otheruser/.darcs/cache! to see if that
user might have downloaded a copy, but won't try to save a copy there, of
course.  Finally, it will look in \verb!http://darcs.net!.  Note that the
\verb!sources! file can also exist in \verb!~/.darcs/!.  Also note that the
sources mentioned in your \verb!sources! file will be tried \emph{before}
the repository you are pulling from.  This can be useful in avoiding
downloading patches multiple times when you pull from a remote repository
to more than one local repository.

We strongly advise that you enable a global cache directory, which will
allow darcs to avoid re-downloading patches (for example, when doing a
second darcs get of the same repository), and also allows darcs to use hard
links to reduce disk usage.  To do this, simply
\begin{verbatim}
mkdir -p $HOME/.darcs/cache
echo cache:$HOME/.darcs/cache > $HOME/.darcs/sources
\end{verbatim}
Note that the cache directory should reside on the same filesystem as your
repositories, so you may need to vary this.  You can also use multiple
cache directories on different filesystems, if you have several filesystems
on which you use darcs.
