module Darcs.Repository.Prefs
( addToPreflist
, deleteSources
, getPreflist
, setPreflist
, getGlobal
, environmentHelpHome
, defaultrepo
, getDefaultRepoPath
, addRepoSource
, getPrefval
, setPrefval
, changePrefval
, defPrefval
, writeDefaultPrefs
, boringRegexps
, boringFileFilter
, darcsdirFilter
, FileType(..)
, filetypeFunction
, getCaches
, globalCacheDir
, globalPrefsDirDoc
, globalPrefsDir
, getMotd
, showMotd
, prefsUrl
, prefsDirPath
, prefsFilesHelp
) where
import Prelude ()
import Darcs.Prelude
import Control.Exception ( catch )
import Control.Monad ( unless, when, liftM )
import Data.Char ( toUpper )
import Data.List ( nub, isPrefixOf, union, sortBy, lookup )
import Data.Maybe ( isJust, fromMaybe, mapMaybe, catMaybes, maybeToList )
import qualified Control.Exception as C
import qualified Data.ByteString as B ( empty, null, hPut, ByteString )
import qualified Data.ByteString.Char8 as BC ( unpack )
import System.Directory ( getAppUserDataDirectory, doesDirectoryExist,
createDirectory, doesFileExist )
import System.Environment ( getEnvironment )
import System.FilePath.Posix ( normalise, dropTrailingPathSeparator, (</>) )
import System.IO.Error ( isDoesNotExistError )
import System.IO ( stdout, stderr )
import System.Info ( os )
import Text.Regex ( Regex, mkRegex, matchRegex )
import Darcs.Repository.Cache ( Cache(..), CacheType(..), CacheLoc(..),
WritableOrNot(..), compareByLocality )
import Darcs.Util.External ( gzFetchFilePS , fetchFilePS, Cachable(..))
import Darcs.Repository.Flags( UseCache (..), DryRun (..), SetDefault (..),
RemoteRepos (..) )
import Darcs.Util.Lock( readTextFile, writeTextFile )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Path ( AbsolutePath, ioAbsolute, toFilePath,
getCurrentDirectory )
import Darcs.Util.Printer( hPutDocLn, text )
import Darcs.Util.URL ( isValidLocalPath )
import Darcs.Util.File ( osxCacheDir, xdgCacheDir, removeFileMayNotExist )
windows,osx :: Bool
windows :: Bool
windows = "mingw" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
os
osx :: Bool
osx = [Char]
os [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "darwin"
writeDefaultPrefs :: IO ()
writeDefaultPrefs :: IO ()
writeDefaultPrefs = do
[Char] -> [[Char]] -> IO ()
setPreflist "boring" [[Char]]
defaultBoring
[Char] -> [[Char]] -> IO ()
setPreflist "binaries" [[Char]]
defaultBinaries
[Char] -> [[Char]] -> IO ()
setPreflist "motd" []
defaultBoring :: [String]
defaultBoring :: [[Char]]
defaultBoring = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ("# " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
boringFileInternalHelp [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
[ ""
, "### compiler and interpreter intermediate files"
, "# haskell (ghc) interfaces"
, "\\.hi$", "\\.hi-boot$", "\\.o-boot$"
, "# object files"
, "\\.o$","\\.o\\.cmd$"
, "# profiling haskell"
, "\\.p_hi$", "\\.p_o$"
, "# haskell program coverage resp. profiling info"
, "\\.tix$", "\\.prof$"
, "# fortran module files"
, "\\.mod$"
, "# linux kernel"
, "\\.ko\\.cmd$","\\.mod\\.c$"
, "(^|/)\\.tmp_versions($|/)"
, "# *.ko files aren't boring by default because they might"
, "# be Korean translations rather than kernel modules"
, "# \\.ko$"
, "# python, emacs, java byte code"
, "\\.py[co]$", "\\.elc$","\\.class$"
, "# objects and libraries; lo and la are libtool things"
, "\\.(obj|a|exe|so|lo|la)$"
, "# compiled zsh configuration files"
, "\\.zwc$"
, "# Common LISP output files for CLISP and CMUCL"
, "\\.(fas|fasl|sparcf|x86f)$"
, ""
, "### build and packaging systems"
, "# cabal intermediates"
, "\\.installed-pkg-config"
, "\\.setup-config"
, "# standard cabal build dir, might not be boring for everybody"
, "# ^dist(/|$)"
, "# autotools"
, "(^|/)autom4te\\.cache($|/)", "(^|/)config\\.(log|status)$"
, "# microsoft web expression, visual studio metadata directories"
, "\\_vti_cnf$"
, "\\_vti_pvt$"
, "# gentoo tools"
, "\\.revdep-rebuild.*"
, "# generated dependencies"
, "^\\.depend$"
, ""
, "### version control systems"
, "# cvs"
, "(^|/)CVS($|/)","\\.cvsignore$"
, "# cvs, emacs locks"
, "^\\.#"
, "# rcs"
, "(^|/)RCS($|/)", ",v$"
, "# subversion"
, "(^|/)\\.svn($|/)"
, "# mercurial"
, "(^|/)\\.hg($|/)"
, "# git"
, "(^|/)\\.git($|/)"
, "# bzr"
, "\\.bzr$"
, "# sccs"
, "(^|/)SCCS($|/)"
, "# darcs"
, "(^|/)"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
darcsdir[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++"($|/)", "(^|/)\\.darcsrepo($|/)"
, "# gnu arch"
, "(^|/)(\\+|,)"
, "(^|/)vssver\\.scc$"
, "\\.swp$","(^|/)MT($|/)"
, "(^|/)\\{arch\\}($|/)","(^|/).arch-ids($|/)"
, "# bitkeeper"
, "(^|/)BitKeeper($|/)","(^|/)ChangeSet($|/)"
, ""
, "### miscellaneous"
, "# backup files"
, "~$","\\.bak$","\\.BAK$"
, "# patch originals and rejects"
, "\\.orig$", "\\.rej$"
, "# X server"
, "\\..serverauth.*"
, "# image spam"
, "\\#", "(^|/)Thumbs\\.db$"
, "# vi, emacs tags"
, "(^|/)(tags|TAGS)$"
, "#(^|/)\\.[^/]"
, "# core dumps"
, "(^|/|\\.)core$"
, "# partial broken files (KIO copy operations)"
, "\\.part$"
, "# waf files, see http://code.google.com/p/waf/"
, "(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+($|/)"
, "(^|/)\\.lock-wscript$"
, "# mac os finder"
, "(^|/)\\.DS_Store$"
, "# emacs saved sessions (desktops)"
, "(^|.*/)\\.emacs\\.desktop(\\.lock)?$"
]
boringFileInternalHelp :: [String]
boringFileInternalHelp :: [[Char]]
boringFileInternalHelp =
[ "This file contains a list of extended regular expressions, one per"
, "line. A file path matching any of these expressions will be filtered"
, "out during `darcs add`, or when the `--look-for-adds` flag is passed"
, "to `darcs whatsnew` and `record`. The entries in "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
globalPrefsDirDoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "boring (if"
, "it exists) supplement those in this file."
, ""
, "Blank lines, and lines beginning with an octothorpe (#) are ignored."
, "See regex(7) for a description of extended regular expressions."
]
darcsdirFilter :: [FilePath] -> [FilePath]
darcsdirFilter :: [[Char]] -> [[Char]]
darcsdirFilter = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
isDarcsdir)
isDarcsdir :: FilePath -> Bool
isDarcsdir :: [Char] -> Bool
isDarcsdir ('.' : '/' : f :: [Char]
f) = [Char] -> Bool
isDarcsdir [Char]
f
isDarcsdir "." = Bool
True
isDarcsdir "" = Bool
True
isDarcsdir ".." = Bool
True
isDarcsdir "../" = Bool
True
isDarcsdir fp :: [Char]
fp = ([Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/") [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
fp Bool -> Bool -> Bool
|| [Char]
fp [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
darcsdir
globalPrefsDir :: IO (Maybe FilePath)
globalPrefsDir :: IO (Maybe [Char])
globalPrefsDir = do
[([Char], [Char])]
env <- IO [([Char], [Char])]
getEnvironment
case [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "DARCS_TESTING_PREFS_DIR" [([Char], [Char])]
env of
Just d :: [Char]
d -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
d)
Nothing -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> IO [Char] -> IO (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO [Char]
getAppUserDataDirectory "darcs"
IO (Maybe [Char]) -> IO (Maybe [Char]) -> IO (Maybe [Char])
forall a. IO a -> IO a -> IO a
`catchall` Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
globalPrefsDirDoc :: String
globalPrefsDirDoc :: [Char]
globalPrefsDirDoc | Bool
windows = "%APPDATA%\\darcs\\"
| Bool
otherwise = "~/.darcs/"
environmentHelpHome :: ([String], [String])
environmentHelpHome :: ([[Char]], [[Char]])
environmentHelpHome =
( ["HOME", "APPDATA"]
, [ "Per-user preferences are set in $HOME/.darcs (on Unix) or"
, "%APPDATA%/darcs (on Windows). This is also the default location of"
, "the cache."
]
)
getGlobal :: String -> IO [String]
getGlobal :: [Char] -> IO [[Char]]
getGlobal f :: [Char]
f = do
Maybe [Char]
dir <- IO (Maybe [Char])
globalPrefsDir
case Maybe [Char]
dir of
(Just d :: [Char]
d) -> [Char] -> IO [[Char]]
getPreffile ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
d [Char] -> [Char] -> [Char]
</> [Char]
f
Nothing -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
globalCacheDir :: IO (Maybe FilePath)
globalCacheDir :: IO (Maybe [Char])
globalCacheDir | Bool
windows = (([Char] -> [Char] -> [Char]
</> "cache2") ([Char] -> [Char]) -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`) (Maybe [Char] -> Maybe [Char])
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Maybe [Char])
globalPrefsDir
| Bool
osx = (([Char] -> [Char] -> [Char]
</> "darcs") ([Char] -> [Char]) -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`) (Maybe [Char] -> Maybe [Char])
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Maybe [Char])
osxCacheDir
| Bool
otherwise = (([Char] -> [Char] -> [Char]
</> "darcs") ([Char] -> [Char]) -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`) (Maybe [Char] -> Maybe [Char])
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Maybe [Char])
xdgCacheDir
tryMakeBoringRegexp :: String -> IO (Maybe Regex)
tryMakeBoringRegexp :: [Char] -> IO (Maybe Regex)
tryMakeBoringRegexp input :: [Char]
input = IO (Maybe Regex)
regex IO (Maybe Regex)
-> (SomeException -> IO (Maybe Regex)) -> IO (Maybe Regex)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` SomeException -> IO (Maybe Regex)
handleBadRegex
where
regex :: IO (Maybe Regex)
regex = Maybe Regex -> IO (Maybe Regex)
forall a. a -> IO a
C.evaluate (Regex -> Maybe Regex
forall a. a -> Maybe a
Just (Regex -> Maybe Regex) -> Regex -> Maybe Regex
forall a b. (a -> b) -> a -> b
$! [Char] -> Regex
mkRegex [Char]
input)
handleBadRegex :: C.SomeException -> IO (Maybe Regex)
handleBadRegex :: SomeException -> IO (Maybe Regex)
handleBadRegex _ = Handle -> Doc -> IO ()
hPutDocLn Handle
stderr Doc
warning IO () -> IO (Maybe Regex) -> IO (Maybe Regex)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Regex -> IO (Maybe Regex)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Regex
forall a. Maybe a
Nothing
warning :: Doc
warning = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ "Warning: Ignored invalid boring regex: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
input
boringRegexps :: IO [Regex]
boringRegexps :: IO [Regex]
boringRegexps = do
[Char]
borefile <- [Char] -> [Char] -> IO [Char]
defPrefval "boringfile" ([Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/prefs/boring")
[[Char]]
localBores <- [Char] -> IO [[Char]]
getPrefLines [Char]
borefile IO [[Char]] -> IO [[Char]] -> IO [[Char]]
forall a. IO a -> IO a -> IO a
`catchall` [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[[Char]]
globalBores <- [Char] -> IO [[Char]]
getGlobal "boring"
([Maybe Regex] -> [Regex]) -> IO [Maybe Regex] -> IO [Regex]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Maybe Regex] -> [Regex]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe Regex] -> IO [Regex]) -> IO [Maybe Regex] -> IO [Regex]
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO (Maybe Regex)) -> [[Char]] -> IO [Maybe Regex]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO (Maybe Regex)
tryMakeBoringRegexp ([[Char]] -> IO [Maybe Regex]) -> [[Char]] -> IO [Maybe Regex]
forall a b. (a -> b) -> a -> b
$ [[Char]]
localBores [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
globalBores
boringFileFilter :: IO ([FilePath] -> [FilePath])
boringFileFilter :: IO ([[Char]] -> [[Char]])
boringFileFilter = [Regex] -> [[Char]] -> [[Char]]
forall (t :: * -> *). Foldable t => t Regex -> [[Char]] -> [[Char]]
filterBoringAndDarcsdir ([Regex] -> [[Char]] -> [[Char]])
-> IO [Regex] -> IO ([[Char]] -> [[Char]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO [Regex]
boringRegexps
where
filterBoringAndDarcsdir :: t Regex -> [[Char]] -> [[Char]]
filterBoringAndDarcsdir regexps :: t Regex
regexps = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (t Regex -> [Char] -> Bool
forall (t :: * -> *). Foldable t => t Regex -> [Char] -> Bool
notBoring t Regex
regexps ([Char] -> Bool) -> ([Char] -> [Char]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
doNormalise)
notBoring :: t Regex -> [Char] -> Bool
notBoring regexps :: t Regex
regexps file :: [Char]
file = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
[Char] -> Bool
isDarcsdir [Char]
file Bool -> Bool -> Bool
|| (Regex -> Bool) -> t Regex -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\r :: Regex
r -> Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [[Char]] -> Bool) -> Maybe [[Char]] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> [Char] -> Maybe [[Char]]
matchRegex Regex
r [Char]
file) t Regex
regexps
noncomments :: [String] -> [String]
= ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
nonComment
where
nonComment :: [Char] -> Bool
nonComment "" = Bool
False
nonComment ('#' : _) = Bool
False
nonComment _ = Bool
True
getPrefLines :: FilePath -> IO [String]
getPrefLines :: [Char] -> IO [[Char]]
getPrefLines f :: [Char]
f = [[Char]] -> [[Char]]
removeCRsCommentsAndConflicts ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO [[Char]]
forall p. FilePathLike p => p -> IO [[Char]]
readTextFile [Char]
f
where
removeCRsCommentsAndConflicts :: [[Char]] -> [[Char]]
removeCRsCommentsAndConflicts =
([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
notconflict ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
noncomments ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
stripCr
startswith :: [a] -> [a] -> Bool
startswith [] _ = Bool
True
startswith (x :: a
x : xs :: [a]
xs) (y :: a
y : ys :: [a]
ys) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& [a] -> [a] -> Bool
startswith [a]
xs [a]
ys
startswith _ _ = Bool
False
notconflict :: [Char] -> Bool
notconflict l :: [Char]
l
| [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith "v v v v v v v" [Char]
l = Bool
False
| [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith "*************" [Char]
l = Bool
False
| [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith "^ ^ ^ ^ ^ ^ ^" [Char]
l = Bool
False
| Bool
otherwise = Bool
True
stripCr :: [Char] -> [Char]
stripCr "" = ""
stripCr "\r" = ""
stripCr (c :: Char
c : cs :: [Char]
cs) = Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
stripCr [Char]
cs
doNormalise :: FilePath -> FilePath
doNormalise :: [Char] -> [Char]
doNormalise = [Char] -> [Char]
dropTrailingPathSeparator ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
normalise
data FileType = BinaryFile
| TextFile
deriving (FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq)
defaultBinaries :: [String]
defaultBinaries :: [[Char]]
defaultBinaries = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ("# "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
binariesFileInternalHelp [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
[ "\\." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
regexToMatchOrigOrUpper [Char]
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "$" | [Char]
e <- [[Char]]
extensions ]
where
regexToMatchOrigOrUpper :: [Char] -> [Char]
regexToMatchOrigOrUpper e :: [Char]
e = "(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "|" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ")"
extensions :: [[Char]]
extensions =
[ "a"
, "bmp"
, "bz2"
, "doc"
, "elc"
, "exe"
, "gif"
, "gz"
, "iso"
, "jar"
, "jpe?g"
, "mng"
, "mpe?g"
, "p[nbgp]m"
, "pdf"
, "png"
, "pyc"
, "so"
, "tar"
, "tgz"
, "tiff?"
, "z"
, "zip"
]
binariesFileInternalHelp :: [String]
binariesFileInternalHelp :: [[Char]]
binariesFileInternalHelp =
[ "This file contains a list of extended regular expressions, one per"
, "line. A file path matching any of these expressions is assumed to"
, "contain binary data (not text). The entries in "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
globalPrefsDirDoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "binaries (if"
, "it exists) supplement those in this file."
, ""
, "Blank lines, and lines beginning with an octothorpe (#) are ignored."
, "See regex(7) for a description of extended regular expressions."
]
filetypeFunction :: IO (FilePath -> FileType)
filetypeFunction :: IO ([Char] -> FileType)
filetypeFunction = do
[Char]
binsfile <- [Char] -> [Char] -> IO [Char]
defPrefval "binariesfile" ([Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/prefs/binaries")
[[Char]]
bins <- [Char] -> IO [[Char]]
getPrefLines [Char]
binsfile
IO [[Char]] -> (IOError -> IO [[Char]]) -> IO [[Char]]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
(\e :: IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else IOError -> IO [[Char]]
forall a. IOError -> IO a
ioError IOError
e)
[[Char]]
gbs <- [Char] -> IO [[Char]]
getGlobal "binaries"
let binaryRegexes :: [Regex]
binaryRegexes = ([Char] -> Regex) -> [[Char]] -> [Regex]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Regex
mkRegex ([[Char]]
bins [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
gbs)
isBinary :: [Char] -> Bool
isBinary f :: [Char]
f = (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\r :: Regex
r -> Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [[Char]] -> Bool) -> Maybe [[Char]] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> [Char] -> Maybe [[Char]]
matchRegex Regex
r [Char]
f) [Regex]
binaryRegexes
ftf :: [Char] -> FileType
ftf f :: [Char]
f = if [Char] -> Bool
isBinary ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
doNormalise [Char]
f then FileType
BinaryFile else FileType
TextFile
([Char] -> FileType) -> IO ([Char] -> FileType)
forall (m :: * -> *) a. Monad m => a -> m a
return [Char] -> FileType
ftf
findPrefsDirectory :: IO (Maybe String)
findPrefsDirectory :: IO (Maybe [Char])
findPrefsDirectory = do
Bool
inDarcsRepo <- [Char] -> IO Bool
doesDirectoryExist [Char]
darcsdir
Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ if Bool
inDarcsRepo
then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/prefs/"
else Maybe [Char]
forall a. Maybe a
Nothing
withPrefsDirectory :: (String -> IO ()) -> IO ()
withPrefsDirectory :: ([Char] -> IO ()) -> IO ()
withPrefsDirectory job :: [Char] -> IO ()
job = IO (Maybe [Char])
findPrefsDirectory IO (Maybe [Char]) -> (Maybe [Char] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ([Char] -> IO ()) -> Maybe [Char] -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) [Char] -> IO ()
job
addToPreflist :: String -> String -> IO ()
addToPreflist :: [Char] -> [Char] -> IO ()
addToPreflist pref :: [Char]
pref value :: [Char]
value = ([Char] -> IO ()) -> IO ()
withPrefsDirectory (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \prefs :: [Char]
prefs -> do
Bool
hasprefs <- [Char] -> IO Bool
doesDirectoryExist [Char]
prefs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasprefs (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
createDirectory [Char]
prefs
[[Char]]
pl <- [Char] -> IO [[Char]]
getPreflist [Char]
pref
[Char] -> [Char] -> IO ()
forall p. FilePathLike p => p -> [Char] -> IO ()
writeTextFile ([Char]
prefs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pref) ([Char] -> IO ()) -> ([[Char]] -> [Char]) -> [[Char]] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines ([[Char]] -> IO ()) -> [[Char]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
union [[Char]
value] [[Char]]
pl
getPreflist :: String -> IO [String]
getPreflist :: [Char] -> IO [[Char]]
getPreflist p :: [Char]
p = IO (Maybe [Char])
findPrefsDirectory IO (Maybe [Char]) -> (Maybe [Char] -> IO [[Char]]) -> IO [[Char]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO [[Char]]
-> ([Char] -> IO [[Char]]) -> Maybe [Char] -> IO [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (\prefs :: [Char]
prefs -> [Char] -> IO [[Char]]
getPreffile ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
prefs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p)
getPreffile :: FilePath -> IO [String]
getPreffile :: [Char] -> IO [[Char]]
getPreffile f :: [Char]
f = do
Bool
hasprefs <- [Char] -> IO Bool
doesFileExist [Char]
f
if Bool
hasprefs then [Char] -> IO [[Char]]
getPrefLines [Char]
f else [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
setPreflist :: String -> [String] -> IO ()
setPreflist :: [Char] -> [[Char]] -> IO ()
setPreflist p :: [Char]
p ls :: [[Char]]
ls = ([Char] -> IO ()) -> IO ()
withPrefsDirectory (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \prefs :: [Char]
prefs -> do
Bool
haspref <- [Char] -> IO Bool
doesDirectoryExist [Char]
prefs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
haspref (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> [Char] -> IO ()
forall p. FilePathLike p => p -> [Char] -> IO ()
writeTextFile ([Char]
prefs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p) ([[Char]] -> [Char]
unlines [[Char]]
ls)
defPrefval :: String -> String -> IO String
defPrefval :: [Char] -> [Char] -> IO [Char]
defPrefval p :: [Char]
p d :: [Char]
d = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
d (Maybe [Char] -> [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO (Maybe [Char])
getPrefval [Char]
p
getPrefval :: String -> IO (Maybe String)
getPrefval :: [Char] -> IO (Maybe [Char])
getPrefval p :: [Char]
p = do
[[Char]]
pl <- [Char] -> IO [[Char]]
getPreflist [Char]
prefsDir
Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ case (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd ([([Char], [Char])] -> [[Char]]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
p) ([Char] -> Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) ([([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ ([Char] -> ([Char], [Char])) -> [[Char]] -> [([Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ')) [[Char]]
pl of
[val :: [Char]
val] -> case [Char] -> [[Char]]
words [Char]
val of
[] -> Maybe [Char]
forall a. Maybe a
Nothing
_ -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
tail [Char]
val
_ -> Maybe [Char]
forall a. Maybe a
Nothing
setPrefval :: String -> String -> IO ()
setPrefval :: [Char] -> [Char] -> IO ()
setPrefval p :: [Char]
p v :: [Char]
v = do
[[Char]]
pl <- [Char] -> IO [[Char]]
getPreflist [Char]
prefsDir
[Char] -> [[Char]] -> IO ()
setPreflist [Char]
prefsDir ([[Char]] -> IO ()) -> [[Char]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char] -> [Char] -> [[Char]]
updatePrefVal [[Char]]
pl [Char]
p [Char]
v
updatePrefVal :: [String] -> String -> String -> [String]
updatePrefVal :: [[Char]] -> [Char] -> [Char] -> [[Char]]
updatePrefVal prefList :: [[Char]]
prefList p :: [Char]
p newVal :: [Char]
newVal =
([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
p) ([Char] -> Bool) -> ([Char] -> [Char]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst (([Char], [Char]) -> [Char])
-> ([Char] -> ([Char], [Char])) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ')) [[Char]]
prefList [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newVal]
changePrefval :: String -> String -> String -> IO ()
changePrefval :: [Char] -> [Char] -> [Char] -> IO ()
changePrefval p :: [Char]
p f :: [Char]
f t :: [Char]
t = do
[[Char]]
pl <- [Char] -> IO [[Char]]
getPreflist [Char]
prefsDir
Maybe [Char]
ov <- [Char] -> IO (Maybe [Char])
getPrefval [Char]
p
let newval :: [Char]
newval = [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
t (\old :: [Char]
old -> if [Char]
old [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
f then [Char]
t else [Char]
old) Maybe [Char]
ov
[Char] -> [[Char]] -> IO ()
setPreflist [Char]
prefsDir ([[Char]] -> IO ()) -> [[Char]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char] -> [Char] -> [[Char]]
updatePrefVal [[Char]]
pl [Char]
p [Char]
newval
fixRepoPath :: String -> IO FilePath
fixRepoPath :: [Char] -> IO [Char]
fixRepoPath p :: [Char]
p
| [Char] -> Bool
isValidLocalPath [Char]
p = AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath (AbsolutePath -> [Char]) -> IO AbsolutePath -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO AbsolutePath
ioAbsolute [Char]
p
| Bool
otherwise = [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
p
defaultrepo :: RemoteRepos -> AbsolutePath -> [String] -> IO [String]
defaultrepo :: RemoteRepos -> AbsolutePath -> [[Char]] -> IO [[Char]]
defaultrepo (RemoteRepos rrepos :: [[Char]]
rrepos) _ [] =
do case [[Char]]
rrepos of
[] -> Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Char] -> [[Char]]) -> IO (Maybe [Char]) -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Maybe [Char])
getDefaultRepoPath
rs :: [[Char]]
rs -> ([Char] -> IO [Char]) -> [[Char]] -> IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO [Char]
fixRepoPath [[Char]]
rs
defaultrepo _ _ r :: [[Char]]
r = [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
r
getDefaultRepoPath :: IO (Maybe String)
getDefaultRepoPath :: IO (Maybe [Char])
getDefaultRepoPath = do
[[Char]]
defaults <- [Char] -> IO [[Char]]
getPreflist [Char]
defaultRepoPref
case [[Char]]
defaults of
[] -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
(d :: [Char]
d : _) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> IO [Char] -> IO (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO [Char]
fixRepoPath [Char]
d
defaultRepoPref :: String
defaultRepoPref :: [Char]
defaultRepoPref = "defaultrepo"
addRepoSource :: String -> DryRun -> RemoteRepos -> SetDefault -> IO ()
addRepoSource :: [Char] -> DryRun -> RemoteRepos -> SetDefault -> IO ()
addRepoSource r :: [Char]
r isDryRun :: DryRun
isDryRun (RemoteRepos rrepos :: [[Char]]
rrepos) setDefault :: SetDefault
setDefault = (do
[[Char]]
olddef <- [Char] -> IO [[Char]]
getPreflist [Char]
defaultRepoPref
let shouldDoIt :: Bool
shouldDoIt = [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
noSetDefault Bool -> Bool -> Bool
&& Bool
greenLight
greenLight :: Bool
greenLight = Bool
shouldAct Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
rIsTmp Bool -> Bool -> Bool
&& ([[Char]]
olddef [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
/= [[Char]
r] Bool -> Bool -> Bool
|| [[Char]]
olddef [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== [])
if Bool
shouldDoIt
then [Char] -> [[Char]] -> IO ()
setPreflist [Char]
defaultRepoPref [[Char]
r]
else Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
True Bool -> [Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Bool]
noSetDefault Bool -> Bool -> Bool
&& Bool
greenLight) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
putStr ([Char] -> IO ()) -> ([[Char]] -> [Char]) -> [[Char]] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines ([[Char]] -> IO ()) -> [[Char]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]]
setDefaultMsg
[Char] -> [Char] -> IO ()
addToPreflist "repos" [Char]
r) IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchall` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
shouldAct :: Bool
shouldAct = DryRun
isDryRun DryRun -> DryRun -> Bool
forall a. Eq a => a -> a -> Bool
== DryRun
NoDryRun
rIsTmp :: Bool
rIsTmp = [Char]
r [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
rrepos
noSetDefault :: [Bool]
noSetDefault = case SetDefault
setDefault of
NoSetDefault x :: Bool
x -> [Bool
x]
_ -> []
setDefaultMsg :: [[Char]]
setDefaultMsg =
[ "HINT: if you want to change the default remote repository to"
, " " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ","
, " quit now and issue the same command with the --set-default "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "flag."
]
deleteSources :: IO ()
deleteSources :: IO ()
deleteSources = do let prefsdir :: [Char]
prefsdir = [Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/prefs/"
[Char] -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist ([Char]
prefsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "sources")
[Char] -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist ([Char]
prefsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "repos")
getCaches :: UseCache -> String -> IO Cache
getCaches :: UseCache -> [Char] -> IO Cache
getCaches useCache :: UseCache
useCache repodir :: [Char]
repodir = do
[CacheLoc]
here <- [[Char]] -> [CacheLoc]
parsehs ([[Char]] -> [CacheLoc]) -> IO [[Char]] -> IO [CacheLoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO [[Char]]
getPreffile [Char]
sourcesFile
[CacheLoc]
there <- ([[Char]] -> [CacheLoc]
parsehs ([[Char]] -> [CacheLoc])
-> (ByteString -> [[Char]]) -> ByteString -> [CacheLoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines ([Char] -> [[Char]])
-> (ByteString -> [Char]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BC.unpack)
(ByteString -> [CacheLoc]) -> IO ByteString -> IO [CacheLoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
([Char] -> Cachable -> IO ByteString
gzFetchFilePS ([Char]
repodir [Char] -> [Char] -> [Char]
</> [Char]
sourcesFile) Cachable
Cachable
IO ByteString -> IO ByteString -> IO ByteString
forall a. IO a -> IO a -> IO a
`catchall` ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty)
Maybe [Char]
globalcachedir <- IO (Maybe [Char])
globalCacheDir
let globalcache :: [CacheLoc]
globalcache = if Bool
nocache
then []
else case Maybe [Char]
globalcachedir of
Nothing -> []
Just d :: [Char]
d -> [CacheType -> WritableOrNot -> [Char] -> CacheLoc
Cache CacheType
Directory WritableOrNot
Writable [Char]
d]
[CacheLoc]
globalsources <- [[Char]] -> [CacheLoc]
parsehs ([[Char]] -> [CacheLoc]) -> IO [[Char]] -> IO [CacheLoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO [[Char]]
getGlobal "sources"
AbsolutePath
thisdir <- IO AbsolutePath
getCurrentDirectory
let thisrepo :: [CacheLoc]
thisrepo = [CacheType -> WritableOrNot -> [Char] -> CacheLoc
Cache CacheType
Repo WritableOrNot
Writable ([Char] -> CacheLoc) -> [Char] -> CacheLoc
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
thisdir]
thatrepo :: [CacheLoc]
thatrepo = [CacheType -> WritableOrNot -> [Char] -> CacheLoc
Cache CacheType
Repo WritableOrNot
NotWritable [Char]
repodir]
tempCache :: [CacheLoc]
tempCache = [CacheLoc] -> [CacheLoc]
forall a. Eq a => [a] -> [a]
nub ([CacheLoc] -> [CacheLoc]) -> [CacheLoc] -> [CacheLoc]
forall a b. (a -> b) -> a -> b
$ [CacheLoc]
thisrepo [CacheLoc] -> [CacheLoc] -> [CacheLoc]
forall a. [a] -> [a] -> [a]
++ [CacheLoc]
globalcache [CacheLoc] -> [CacheLoc] -> [CacheLoc]
forall a. [a] -> [a] -> [a]
++ [CacheLoc]
globalsources [CacheLoc] -> [CacheLoc] -> [CacheLoc]
forall a. [a] -> [a] -> [a]
++ [CacheLoc]
here
[CacheLoc] -> [CacheLoc] -> [CacheLoc]
forall a. [a] -> [a] -> [a]
++ [CacheLoc]
thatrepo [CacheLoc] -> [CacheLoc] -> [CacheLoc]
forall a. [a] -> [a] -> [a]
++ [CacheLoc] -> [CacheLoc]
filterExternalSources [CacheLoc]
there
Cache -> IO Cache
forall (m :: * -> *) a. Monad m => a -> m a
return (Cache -> IO Cache) -> Cache -> IO Cache
forall a b. (a -> b) -> a -> b
$ [CacheLoc] -> Cache
Ca ([CacheLoc] -> Cache) -> [CacheLoc] -> Cache
forall a b. (a -> b) -> a -> b
$ (CacheLoc -> CacheLoc -> Ordering) -> [CacheLoc] -> [CacheLoc]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy CacheLoc -> CacheLoc -> Ordering
compareByLocality [CacheLoc]
tempCache
where
sourcesFile :: [Char]
sourcesFile = [Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/prefs/sources"
parsehs :: [[Char]] -> [CacheLoc]
parsehs = ([Char] -> Maybe CacheLoc) -> [[Char]] -> [CacheLoc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Char] -> Maybe CacheLoc
readln ([[Char]] -> [CacheLoc])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [CacheLoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
noncomments
readln :: [Char] -> Maybe CacheLoc
readln l :: [Char]
l
| "repo:" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l = CacheLoc -> Maybe CacheLoc
forall a. a -> Maybe a
Just (CacheType -> WritableOrNot -> [Char] -> CacheLoc
Cache CacheType
Repo WritableOrNot
NotWritable (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop 5 [Char]
l))
| Bool
nocache = Maybe CacheLoc
forall a. Maybe a
Nothing
| "cache:" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l = CacheLoc -> Maybe CacheLoc
forall a. a -> Maybe a
Just (CacheType -> WritableOrNot -> [Char] -> CacheLoc
Cache CacheType
Directory WritableOrNot
Writable (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop 6 [Char]
l))
| "readonly:" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l =
CacheLoc -> Maybe CacheLoc
forall a. a -> Maybe a
Just (CacheType -> WritableOrNot -> [Char] -> CacheLoc
Cache CacheType
Directory WritableOrNot
NotWritable (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop 9 [Char]
l))
| Bool
otherwise = Maybe CacheLoc
forall a. Maybe a
Nothing
nocache :: Bool
nocache = UseCache
useCache UseCache -> UseCache -> Bool
forall a. Eq a => a -> a -> Bool
== UseCache
NoUseCache
filterExternalSources :: [CacheLoc] -> [CacheLoc]
filterExternalSources there :: [CacheLoc]
there =
if [Char] -> Bool
isValidLocalPath [Char]
repodir
then [CacheLoc]
there
else (CacheLoc -> Bool) -> [CacheLoc] -> [CacheLoc]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CacheLoc -> Bool) -> CacheLoc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
isValidLocalPath ([Char] -> Bool) -> (CacheLoc -> [Char]) -> CacheLoc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheLoc -> [Char]
cacheSource) [CacheLoc]
there
getMotd :: String -> IO B.ByteString
getMotd :: [Char] -> IO ByteString
getMotd repo :: [Char]
repo = [Char] -> Cachable -> IO ByteString
fetchFilePS [Char]
motdPath (CInt -> Cachable
MaxAge 600) IO ByteString -> IO ByteString -> IO ByteString
forall a. IO a -> IO a -> IO a
`catchall` ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
where
motdPath :: [Char]
motdPath = [Char]
repo [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/prefs/motd"
showMotd :: String -> IO ()
showMotd :: [Char] -> IO ()
showMotd repo :: [Char]
repo = do
ByteString
motd <- [Char] -> IO ByteString
getMotd [Char]
repo
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
motd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> ByteString -> IO ()
B.hPut Handle
stdout ByteString
motd
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate 22 '*'
prefsUrl :: FilePath -> String
prefsUrl :: [Char] -> [Char]
prefsUrl r :: [Char]
r = [Char]
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
darcsdir[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++"/prefs"
prefsDir :: FilePath
prefsDir :: [Char]
prefsDir = "prefs"
prefsDirPath :: FilePath
prefsDirPath :: [Char]
prefsDirPath = [Char]
darcsdir [Char] -> [Char] -> [Char]
</> [Char]
prefsDir
prefsFilesHelp :: [(String,String)]
prefsFilesHelp :: [([Char], [Char])]
prefsFilesHelp =
[ ("motd", [[Char]] -> [Char]
unlines
[ "The `_darcs/prefs/motd` file may contain a 'message of the day' which"
, "will be displayed to users who clone or pull from the repository without"
, "the `--quiet` option."])
, ("email", [[Char]] -> [Char]
unlines
[ "The `_darcs/prefs/email` file is used to provide the e-mail address for"
, "your repository that others will use when they `darcs send` a patch back"
, "to you. The contents of the file should simply be an e-mail address."])
, ("post", [[Char]] -> [Char]
unlines
[ "If `_darcs/prefs/post` exists in the target repository, `darcs send ` will"
, "upload to the URL contained in that file, which may either be a `mailto:`"
, "URL, or an `http://` URL. In the latter case, the patch is posted to that URL."])
, ("author", [[Char]] -> [Char]
unlines
[ "The `_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. `David Roundy <droundy@abridgegame.org>`. This file overrides the"
, "contents of the environment variables `$DARCS_EMAIL` and `$EMAIL`."])
, ("defaults", [[Char]] -> [Char]
unlines
[ "Default values for darcs commands. Each line of this file has the"
, "following form:"
, ""
, " COMMAND FLAG VALUE"
, ""
, "where `COMMAND` is either the name of the command to which the default"
, "applies, or `ALL` to indicate that the default applies to all commands"
, "accepting that flag. The `FLAG` term is the name of the long argument"
, "option without the `--`, i.e. `verbose` rather than `--verbose`."
, "Finally, the `VALUE` option can be omitted if the flag does not involve"
, "a value. If the value has spaces in it, use single quotes, not double"
, "quotes, to surround it. Each line only takes one flag. To set multiple"
, "defaults for the same command (or for `ALL` commands), use multiple lines."
, ""
, "Note that the use of `ALL` easily can have unpredicted consequences,"
, "especially if commands in newer versions of darcs accepts flags that"
, "they did not in previous versions. Only use safe flags with `ALL`."
, ""
, "For example, if your system clock is bizarre, you could instruct darcs to"
, "always ignore the file modification times by adding the following line:"
, ""
, " ALL ignore-times"
, ""
, "There are some options which are meant specifically for use in"
, "`_darcs/prefs/defaults`. One of them is `--disable`. As the name"
, "suggests, this option will disable every command that got it as"
, "argument. So, if you are afraid that you could damage your repositories"
, "by inadvertent use of a command like amend, add the following line:"
, ""
, " amend disable"
, ""
, "Also, a global preferences file can be created with the name"
, "`.darcs/defaults` in your home directory. Options present there will be"
, "added to the repository-specific preferences if they do not conflict."])
, ("sources", [[Char]] -> [Char]
unlines
[ "The `_darcs/prefs/sources` file is used to indicate alternative locations"
, "from which to download patches. This file contains lines such as:"
, ""
, " cache:/home/droundy/.cache/darcs"
, " readonly:/home/otheruser/.cache/darcs"
, " repo:http://darcs.net"
, ""
, "This would indicate that darcs should first look in"
, "`/home/droundy/.cache/darcs` for patches that might be missing, and if"
, "the patch is not there, it should save a copy there for future use."
, "In that case, darcs will look in `/home/otheruser/.cache/darcs` to see if"
, "that user might have downloaded a copy, but will not try to save a copy"
, "there, of course. Finally, it will look in `http://darcs.net`. Note that"
, "the `sources` file can also exist in `~/.darcs/`. Also note that the"
, "sources mentioned in your `sources` file will be tried *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."
, ""
, "A global cache is enabled by default in your home directory. The cache"
, "allows darcs to avoid re-downloading patches (for example, when doing a"
, "second darcs clone of the same repository), and also allows darcs to use"
, "hard links to reduce disk usage."
, ""
, "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."])
, ("boring", [[Char]] -> [Char]
unlines
[ "The `_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. A newly created repository has a 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. `darcs setpref boringfile .boring`, where"
, "`.boring` is the repository path of a file that has been darcs added to"
, "your repository). The boringfile preference overrides"
, "`_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"
, "`~/.darcs/boring`, which will be used with all of your darcs repositories."
, ""
, "Any file not already managed by darcs and whose repository path"
, "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 `darcs add newdir newdir/*`"
, "without accidentally adding a bunch of object files. It is also used"
, "when the `--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."])
, ("binaries", [[Char]] -> [Char]
unlines
[ "The `_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 characters"
, "`^Z` or `NULL` within the first 4096 bytes as being binary 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. `darcs setpref binariesfile ./.binaries`, where `.binaries` is a"
, "file that has been darcs added to your repository). As with the boring"
, "file, you can also set up a `~/.darcs/binaries` file if you like."])
, ("defaultrepo", [[Char]] -> [Char]
unlines
[ "Contains the URL of the default remote repository used by commands `pull`,"
, "`push`, `send` and `optimize relink`. Darcs edits this file automatically"
, "or when the flag `--set-default` is used."])
, ("tmpdir", [[Char]] -> [Char]
unlines
[ "By default temporary directories are created in `/tmp`, or if that doesn't"
, "exist, in `_darcs` (within the current repo). This can be overridden by"
, "specifying some other directory in the file `_darcs/prefs/tmpdir` or the"
, "environment variable `$DARCS_TMPDIR` or `$TMPDIR`."])
, ("prefs", [[Char]] -> [Char]
unlines
[ "Contains the preferences set by the command `darcs setprefs`."
, "Do not edit manually."])
]