module Darcs.Repository.Prefs
( addToPreflist
, deleteSources
, getPreflist
, setPreflist
, getGlobal
, environmentHelpHome
, defaultrepo
, getDefaultRepo
, addRepoSource
, getPrefval
, setPrefval
, changePrefval
, defPrefval
, writeDefaultPrefs
, boringRegexps
, isBoring
, FileType(..)
, filetypeFunction
, getCaches
, globalCacheDir
, globalPrefsDirDoc
, globalPrefsDir
, getMotd
, showMotd
, prefsUrl
, prefsDirPath
, prefsFilePath
, getPrefLines
, prefsFilesHelp
) where
import Darcs.Prelude
import Control.Exception ( catch )
import Control.Monad ( unless, when, liftM )
import Data.Char ( toUpper )
import Data.List ( nub, isPrefixOf, union, 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, catchIOError )
import System.IO ( stdout, stderr )
import System.Info ( os )
import System.Posix.Files ( getFileStatus, fileOwner )
import Text.Regex ( Regex, mkRegex, matchRegex )
import Darcs.Repository.Cache ( Cache, mkCache, CacheType(..), CacheLoc(..),
WritableOrNot(..) )
import Darcs.Util.External ( gzFetchFilePS , fetchFilePS, Cachable(..))
import Darcs.Repository.Flags
( UseCache (..)
, DryRun (..)
, SetDefault (..)
, InheritDefault (..)
, RemoteRepos (..)
)
import Darcs.Util.Lock( readTextFile, writeTextFile )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Global ( darcsdir, debugMessage )
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 = [Char]
"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
== [Char]
"darwin"
writeDefaultPrefs :: IO ()
writeDefaultPrefs :: IO ()
writeDefaultPrefs = do
[Char] -> [[Char]] -> IO ()
setPreflist [Char]
"boring" [[Char]]
defaultBoring
[Char] -> [[Char]] -> IO ()
setPreflist [Char]
"binaries" [[Char]]
defaultBinaries
[Char] -> [[Char]] -> IO ()
setPreflist [Char]
"motd" []
defaultBoring :: [String]
defaultBoring :: [[Char]]
defaultBoring = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"# " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
boringFileInternalHelp [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
[ [Char]
""
, [Char]
"### compiler and interpreter intermediate files"
, [Char]
"# haskell (ghc) interfaces"
, [Char]
"\\.hi$", [Char]
"\\.hi-boot$", [Char]
"\\.o-boot$"
, [Char]
"# object files"
, [Char]
"\\.o$",[Char]
"\\.o\\.cmd$"
, [Char]
"# profiling haskell"
, [Char]
"\\.p_hi$", [Char]
"\\.p_o$"
, [Char]
"# haskell program coverage resp. profiling info"
, [Char]
"\\.tix$", [Char]
"\\.prof$"
, [Char]
"# fortran module files"
, [Char]
"\\.mod$"
, [Char]
"# linux kernel"
, [Char]
"\\.ko\\.cmd$",[Char]
"\\.mod\\.c$"
, [Char]
"(^|/)\\.tmp_versions($|/)"
, [Char]
"# *.ko files aren't boring by default because they might"
, [Char]
"# be Korean translations rather than kernel modules"
, [Char]
"# \\.ko$"
, [Char]
"# python, emacs, java byte code"
, [Char]
"\\.py[co]$", [Char]
"\\.elc$",[Char]
"\\.class$"
, [Char]
"# objects and libraries; lo and la are libtool things"
, [Char]
"\\.(obj|a|exe|so|lo|la)$"
, [Char]
"# compiled zsh configuration files"
, [Char]
"\\.zwc$"
, [Char]
"# Common LISP output files for CLISP and CMUCL"
, [Char]
"\\.(fas|fasl|sparcf|x86f)$"
, [Char]
""
, [Char]
"### build and packaging systems"
, [Char]
"# cabal intermediates"
, [Char]
"\\.installed-pkg-config"
, [Char]
"\\.setup-config"
, [Char]
"# standard cabal build dir, might not be boring for everybody"
, [Char]
"# ^dist(/|$)"
, [Char]
"# autotools"
, [Char]
"(^|/)autom4te\\.cache($|/)", [Char]
"(^|/)config\\.(log|status)$"
, [Char]
"# microsoft web expression, visual studio metadata directories"
, [Char]
"\\_vti_cnf$"
, [Char]
"\\_vti_pvt$"
, [Char]
"# gentoo tools"
, [Char]
"\\.revdep-rebuild.*"
, [Char]
"# generated dependencies"
, [Char]
"^\\.depend$"
, [Char]
""
, [Char]
"### version control systems"
, [Char]
"# cvs"
, [Char]
"(^|/)CVS($|/)",[Char]
"\\.cvsignore$"
, [Char]
"# cvs, emacs locks"
, [Char]
"^\\.#"
, [Char]
"# rcs"
, [Char]
"(^|/)RCS($|/)", [Char]
",v$"
, [Char]
"# subversion"
, [Char]
"(^|/)\\.svn($|/)"
, [Char]
"# mercurial"
, [Char]
"(^|/)\\.hg($|/)"
, [Char]
"# git"
, [Char]
"(^|/)\\.git($|/)"
, [Char]
"# bzr"
, [Char]
"\\.bzr$"
, [Char]
"# sccs"
, [Char]
"(^|/)SCCS($|/)"
, [Char]
"# darcs"
, [Char]
"(^|/)"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
darcsdir[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"($|/)", [Char]
"(^|/)\\.darcsrepo($|/)"
, [Char]
"# gnu arch"
, [Char]
"(^|/)(\\+|,)"
, [Char]
"(^|/)vssver\\.scc$"
, [Char]
"\\.swp$",[Char]
"(^|/)MT($|/)"
, [Char]
"(^|/)\\{arch\\}($|/)",[Char]
"(^|/).arch-ids($|/)"
, [Char]
"# bitkeeper"
, [Char]
"(^|/)BitKeeper($|/)",[Char]
"(^|/)ChangeSet($|/)"
, [Char]
""
, [Char]
"### miscellaneous"
, [Char]
"# backup files"
, [Char]
"~$",[Char]
"\\.bak$",[Char]
"\\.BAK$"
, [Char]
"# patch originals and rejects"
, [Char]
"\\.orig$", [Char]
"\\.rej$"
, [Char]
"# X server"
, [Char]
"\\..serverauth.*"
, [Char]
"# image spam"
, [Char]
"\\#", [Char]
"(^|/)Thumbs\\.db$"
, [Char]
"# vi, emacs tags"
, [Char]
"(^|/)(tags|TAGS)$"
, [Char]
"#(^|/)\\.[^/]"
, [Char]
"# core dumps"
, [Char]
"(^|/|\\.)core$"
, [Char]
"# partial broken files (KIO copy operations)"
, [Char]
"\\.part$"
, [Char]
"# waf files, see http://code.google.com/p/waf/"
, [Char]
"(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+($|/)"
, [Char]
"(^|/)\\.lock-wscript$"
, [Char]
"# mac os finder"
, [Char]
"(^|/)\\.DS_Store$"
, [Char]
"# emacs saved sessions (desktops)"
, [Char]
"(^|.*/)\\.emacs\\.desktop(\\.lock)?$"
, [Char]
" # stack"
, [Char]
"(^|/)\\.stack-work($|/)"
]
boringFileInternalHelp :: [String]
boringFileInternalHelp :: [[Char]]
boringFileInternalHelp =
[ [Char]
"This file contains a list of extended regular expressions, one per"
, [Char]
"line. A file path matching any of these expressions will be filtered"
, [Char]
"out during `darcs add`, or when the `--look-for-adds` flag is passed"
, [Char]
"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]
++ [Char]
"boring (if"
, [Char]
"it exists) supplement those in this file."
, [Char]
""
, [Char]
"Blank lines, and lines beginning with an octothorpe (#) are ignored."
, [Char]
"See regex(7) for a description of extended regular expressions."
]
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 [Char]
"DARCS_TESTING_PREFS_DIR" [([Char], [Char])]
env of
Just [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)
Maybe [Char]
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 [Char]
"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 = [Char]
"%APPDATA%\\darcs\\"
| Bool
otherwise = [Char]
"~/.darcs/"
environmentHelpHome :: ([String], [String])
environmentHelpHome :: ([[Char]], [[Char]])
environmentHelpHome =
( [[Char]
"HOME", [Char]
"APPDATA"]
, [ [Char]
"Per-user preferences are set in $HOME/.darcs (on Unix) or"
, [Char]
"%APPDATA%/darcs (on Windows). This is also the default location of"
, [Char]
"the cache."
]
)
getGlobal :: String -> IO [String]
getGlobal :: [Char] -> IO [[Char]]
getGlobal [Char]
f = do
Maybe [Char]
dir <- IO (Maybe [Char])
globalPrefsDir
case Maybe [Char]
dir of
(Just [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
Maybe [Char]
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]
</> [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]
</> [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]
</> [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 [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 SomeException
_ = 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
$ [Char]
"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 [Char]
"boringfile" ([Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/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 [Char]
"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
isBoring :: IO (FilePath -> Bool)
isBoring :: IO ([Char] -> Bool)
isBoring = do
[Regex]
regexps <- IO [Regex]
boringRegexps
([Char] -> Bool) -> IO ([Char] -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Char] -> Bool) -> IO ([Char] -> Bool))
-> ([Char] -> Bool) -> IO ([Char] -> Bool)
forall a b. (a -> b) -> a -> b
$ \[Char]
file -> (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\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) [Regex]
regexps
noncomments :: [String] -> [String]
= ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
nonComment
where
nonComment :: [Char] -> Bool
nonComment [Char]
"" = Bool
False
nonComment (Char
'#' : [Char]
_) = Bool
False
nonComment [Char]
_ = Bool
True
getPrefLines :: FilePath -> IO [String]
getPrefLines :: [Char] -> IO [[Char]]
getPrefLines [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 [] [a]
_ = Bool
True
startswith (a
x : [a]
xs) (a
y : [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 [a]
_ [a]
_ = Bool
False
notconflict :: [Char] -> Bool
notconflict [Char]
l
| [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith [Char]
"v v v v v v v" [Char]
l = Bool
False
| [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith [Char]
"*************" [Char]
l = Bool
False
| [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith [Char]
"^ ^ ^ ^ ^ ^ ^" [Char]
l = Bool
False
| Bool
otherwise = Bool
True
stripCr :: [Char] -> [Char]
stripCr [Char]
"" = [Char]
""
stripCr [Char]
"\r" = [Char]
""
stripCr (Char
c : [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] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
binariesFileInternalHelp [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
[ [Char]
"\\." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
regexToMatchOrigOrUpper [Char]
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"$" | [Char]
e <- [[Char]]
extensions ]
where
regexToMatchOrigOrUpper :: [Char] -> [Char]
regexToMatchOrigOrUpper [Char]
e = [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"|" [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]
++ [Char]
")"
extensions :: [[Char]]
extensions =
[ [Char]
"a"
, [Char]
"bmp"
, [Char]
"bz2"
, [Char]
"doc"
, [Char]
"elc"
, [Char]
"exe"
, [Char]
"gif"
, [Char]
"gz"
, [Char]
"iso"
, [Char]
"jar"
, [Char]
"jpe?g"
, [Char]
"mng"
, [Char]
"mpe?g"
, [Char]
"p[nbgp]m"
, [Char]
"pdf"
, [Char]
"png"
, [Char]
"pyc"
, [Char]
"so"
, [Char]
"tar"
, [Char]
"tgz"
, [Char]
"tiff?"
, [Char]
"z"
, [Char]
"zip"
]
binariesFileInternalHelp :: [String]
binariesFileInternalHelp :: [[Char]]
binariesFileInternalHelp =
[ [Char]
"This file contains a list of extended regular expressions, one per"
, [Char]
"line. A file path matching any of these expressions is assumed to"
, [Char]
"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]
++ [Char]
"binaries (if"
, [Char]
"it exists) supplement those in this file."
, [Char]
""
, [Char]
"Blank lines, and lines beginning with an octothorpe (#) are ignored."
, [Char]
"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 [Char]
"binariesfile" ([Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/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`
(\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 [Char]
"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 [Char]
f = (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\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 [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]
++ [Char]
"/prefs/"
else Maybe [Char]
forall a. Maybe a
Nothing
withPrefsDirectory :: (String -> IO ()) -> IO ()
withPrefsDirectory :: ([Char] -> IO ()) -> IO ()
withPrefsDirectory [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 [Char]
pref [Char]
value = ([Char] -> IO ()) -> IO ()
withPrefsDirectory (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[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 [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 []) (\[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 [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 [Char]
p [[Char]]
ls = ([Char] -> IO ()) -> IO ()
withPrefsDirectory (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[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 [Char]
p [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 [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
' ')) [[Char]]
pl of
[[Char]
val] -> case [Char] -> [[Char]]
words [Char]
val of
[] -> Maybe [Char]
forall a. Maybe a
Nothing
[[Char]]
_ -> [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
[[Char]]
_ -> Maybe [Char]
forall a. Maybe a
Nothing
setPrefval :: String -> String -> IO ()
setPrefval :: [Char] -> [Char] -> IO ()
setPrefval [Char]
p [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 [[Char]]
prefList [Char]
p [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
' ')) [[Char]]
prefList [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newVal]
changePrefval :: String -> String -> String -> IO ()
changePrefval :: [Char] -> [Char] -> [Char] -> IO ()
changePrefval [Char]
p [Char]
f [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 (\[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 [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 [[Char]]
rrepos) AbsolutePath
_ [] =
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])
getDefaultRepo
[[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 RemoteRepos
_ AbsolutePath
_ [[Char]]
r = [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
r
getDefaultRepo :: IO (Maybe String)
getDefaultRepo :: IO (Maybe [Char])
getDefaultRepo = 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
([Char]
d : [[Char]]
_) -> [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 = [Char]
"defaultrepo"
addRepoSource :: String
-> DryRun
-> RemoteRepos
-> SetDefault
-> InheritDefault
-> Bool
-> IO ()
addRepoSource :: [Char]
-> DryRun
-> RemoteRepos
-> SetDefault
-> InheritDefault
-> Bool
-> IO ()
addRepoSource [Char]
r DryRun
isDryRun (RemoteRepos [[Char]]
rrepos) SetDefault
setDefault InheritDefault
inheritDefault Bool
isInteractive = (do
[[Char]]
olddef <- [Char] -> IO [[Char]]
getPreflist [Char]
defaultRepoPref
[Char]
newdef <- IO [Char]
newDefaultRepo
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]
newdef] 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]
newdef]
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 Bool -> Bool -> Bool
&& InheritDefault
inheritDefault InheritDefault -> InheritDefault -> Bool
forall a. Eq a => a -> a -> Bool
== InheritDefault
NoInheritDefault) (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 [Char]
"repos" [Char]
newdef) 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 Bool
x -> [Bool
x]
SetDefault
_ -> []
setDefaultMsg :: [[Char]]
setDefaultMsg =
[ [Char]
"By the way, to change the default remote repository to"
, [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
","
, [Char]
"you can " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
(if Bool
isInteractive then [Char]
"quit now and " else [Char]
"") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"issue the same command with the --set-default flag."
]
newDefaultRepo :: IO String
newDefaultRepo :: IO [Char]
newDefaultRepo = case InheritDefault
inheritDefault of
InheritDefault
YesInheritDefault -> IO [Char]
getRemoteDefaultRepo
InheritDefault
NoInheritDefault -> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
r
getRemoteDefaultRepo :: IO [Char]
getRemoteDefaultRepo
| [Char] -> Bool
isValidLocalPath [Char]
r = do
[Char] -> [Char] -> IO Bool
sameOwner [Char]
r [Char]
"." IO Bool -> (Bool -> IO [Char]) -> IO [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
[[Char]]
defs <-
[Char] -> IO [[Char]]
getPreffile ([Char]
r [Char] -> [Char] -> [Char]
</> [Char]
darcsdir [Char] -> [Char] -> [Char]
</> [Char]
"prefs/defaultrepo")
IO [[Char]] -> (IOError -> IO [[Char]]) -> IO [[Char]]
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError`
IO [[Char]] -> IOError -> IO [[Char]]
forall a b. a -> b -> a
const ([[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]
r])
case [[Char]]
defs of
[Char]
defrepo:[[Char]]
_ -> do
[Char] -> IO ()
debugMessage [Char]
"using defaultrepo of remote"
[Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
defrepo
[] -> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
r
Bool
False -> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
r
| Bool
otherwise = [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
r
sameOwner :: [Char] -> [Char] -> IO Bool
sameOwner [Char]
p [Char]
q =
UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
(==) (UserID -> UserID -> Bool) -> IO UserID -> IO (UserID -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileStatus -> UserID
fileOwner (FileStatus -> UserID) -> IO FileStatus -> IO UserID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO FileStatus
getFileStatus [Char]
p) IO (UserID -> Bool) -> IO UserID -> IO Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FileStatus -> UserID
fileOwner (FileStatus -> UserID) -> IO FileStatus -> IO UserID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO FileStatus
getFileStatus [Char]
q)
deleteSources :: IO ()
deleteSources :: IO ()
deleteSources = do let prefsdir :: [Char]
prefsdir = [Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/prefs/"
[Char] -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist ([Char]
prefsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"sources")
[Char] -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist ([Char]
prefsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"repos")
getCaches :: UseCache -> String -> IO Cache
getCaches :: UseCache -> [Char] -> IO Cache
getCaches UseCache
useCache [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
Maybe [Char]
Nothing -> []
Just [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 [Char]
"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
mkCache [CacheLoc]
tempCache
where
sourcesFile :: [Char]
sourcesFile = [Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/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 [Char]
l
| [Char]
"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 Int
5 [Char]
l))
| Bool
nocache = Maybe CacheLoc
forall a. Maybe a
Nothing
| [Char]
"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 Int
6 [Char]
l))
| [Char]
"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 Int
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 [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 [Char]
repo = [Char] -> Cachable -> IO ByteString
fetchFilePS [Char]
motdPath (CInt -> Cachable
MaxAge CInt
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] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
darcsdir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/prefs/motd"
showMotd :: String -> IO ()
showMotd :: [Char] -> IO ()
showMotd [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 Int
22 Char
'*'
prefsUrl :: FilePath -> String
prefsUrl :: [Char] -> [Char]
prefsUrl [Char]
r = [Char]
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
darcsdir[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"/prefs"
prefsDir :: FilePath
prefsDir :: [Char]
prefsDir = [Char]
"prefs"
prefsDirPath :: FilePath
prefsDirPath :: [Char]
prefsDirPath = [Char]
darcsdir [Char] -> [Char] -> [Char]
</> [Char]
prefsDir
prefsFilePath :: FilePath
prefsFilePath :: [Char]
prefsFilePath = [Char]
prefsDirPath [Char] -> [Char] -> [Char]
</> [Char]
"prefs"
prefsFilesHelp :: [(String,String)]
prefsFilesHelp :: [([Char], [Char])]
prefsFilesHelp =
[ ([Char]
"motd", [[Char]] -> [Char]
unlines
[ [Char]
"The `_darcs/prefs/motd` file may contain a 'message of the day' which"
, [Char]
"will be displayed to users who clone or pull from the repository without"
, [Char]
"the `--quiet` option."])
, ([Char]
"email", [[Char]] -> [Char]
unlines
[ [Char]
"The `_darcs/prefs/email` file is used to provide the e-mail address for"
, [Char]
"your repository that others will use when they `darcs send` a patch back"
, [Char]
"to you. The contents of the file should simply be an e-mail address."])
, ([Char]
"post", [[Char]] -> [Char]
unlines
[ [Char]
"If `_darcs/prefs/post` exists in the target repository, `darcs send ` will"
, [Char]
"upload to the URL contained in that file, which may either be a `mailto:`"
, [Char]
"URL, or an `http://` URL. In the latter case, the patch is posted to that URL."])
, ([Char]
"author", [[Char]] -> [Char]
unlines
[ [Char]
"The `_darcs/prefs/author` file contains the email address (or name) to"
, [Char]
"be used as the author when patches are recorded in this repository,"
, [Char]
"e.g. `David Roundy <droundy@abridgegame.org>`. This file overrides the"
, [Char]
"contents of the environment variables `$DARCS_EMAIL` and `$EMAIL`."])
, ([Char]
"defaults", [[Char]] -> [Char]
unlines
[ [Char]
"Default options for darcs commands. Each line of this file has the"
, [Char]
"following form:"
, [Char]
""
, [Char]
" COMMAND FLAG VALUE"
, [Char]
""
, [Char]
"where `COMMAND` is either the name of the command to which the default"
, [Char]
"applies, or `ALL` to indicate that the default applies to all commands"
, [Char]
"accepting that flag. The `FLAG` term is the name of the long argument"
, [Char]
"option with or without the `--`, i.e. `verbose` or `--verbose`."
, [Char]
"Finally, the `VALUE` option can be omitted if the flag does not involve"
, [Char]
"a value. If the value has spaces in it, use single quotes, not double"
, [Char]
"quotes, to surround it. Each line only takes one flag. To set multiple"
, [Char]
"defaults for the same command (or for `ALL` commands), use multiple lines."
, [Char]
""
, [Char]
"Options listed in the defaults file are just that: defaults. You can"
, [Char]
"override any default on the command line."
, [Char]
""
, [Char]
"Note that the use of `ALL` easily can have unpredicted consequences,"
, [Char]
"especially if commands in newer versions of darcs accepts flags that"
, [Char]
"they did not in previous versions. Only use safe flags with `ALL`."
, [Char]
""
, [Char]
"For example, if your system clock is bizarre, you could instruct darcs to"
, [Char]
"always ignore the file modification times by adding the following line:"
, [Char]
""
, [Char]
" ALL ignore-times"
, [Char]
""
, [Char]
"There are some options which are meant specifically for use in"
, [Char]
"`_darcs/prefs/defaults`. One of them is `--disable`. As the name"
, [Char]
"suggests, this option will disable every command that got it as"
, [Char]
"argument. So, if you are afraid that you could damage your repositories"
, [Char]
"by inadvertent use of a command like amend, add the following line:"
, [Char]
""
, [Char]
" amend disable"
, [Char]
""
, [Char]
"A global defaults file can be created with the name"
, [Char]
"`.darcs/defaults` in your home directory. In case of conflicts,"
, [Char]
"the defaults for a specific repository take precedence."
])
, ([Char]
"boring", [[Char]] -> [Char]
unlines
[ [Char]
"The `_darcs/prefs/boring` file may contain a list of regular expressions"
, [Char]
"describing files, such as object files, that you do not expect to add to"
, [Char]
"your project. A newly created repository has a boring file that includes"
, [Char]
"many common source control, backup, temporary, and compiled files."
, [Char]
""
, [Char]
"You may want to have the boring file under version control. To do this"
, [Char]
"you can use darcs setpref to set the value 'boringfile' to the name of"
, [Char]
"your desired boring file (e.g. `darcs setpref boringfile .boring`, where"
, [Char]
"`.boring` is the repository path of a file that has been darcs added to"
, [Char]
"your repository). The boringfile preference overrides"
, [Char]
"`_darcs/prefs/boring`, so be sure to copy that file to the boringfile."
, [Char]
""
, [Char]
"You can also set up a 'boring' regexps file in your home directory, named"
, [Char]
"`~/.darcs/boring`, which will be used with all of your darcs repositories."
, [Char]
""
, [Char]
"Any file not already managed by darcs and whose repository path"
, [Char]
"matches any of the boring regular expressions is"
, [Char]
"considered boring. The boring file is used to filter the files provided"
, [Char]
"to darcs add, to allow you to use a simple `darcs add newdir newdir/*`"
, [Char]
"without accidentally adding a bunch of object files. It is also used"
, [Char]
"when the `--look-for-adds` flag is given to whatsnew or record. Note"
, [Char]
"that once a file has been added to darcs, it is not considered boring,"
, [Char]
"even if it matches the boring file filter."])
, ([Char]
"binaries", [[Char]] -> [Char]
unlines
[ [Char]
"The `_darcs/prefs/binaries` file may contain a list of regular"
, [Char]
"expressions describing files that should be treated as binary files rather"
, [Char]
"than text files. Darcs automatically treats files containing characters"
, [Char]
"`^Z` or `NULL` within the first 4096 bytes as being binary files."
, [Char]
"You probably will want to have the binaries file under version control."
, [Char]
"To do this you can use `darcs setpref` to set the value 'binariesfile'"
, [Char]
"to the name of your desired binaries file"
, [Char]
"(e.g. `darcs setpref binariesfile ./.binaries`, where `.binaries` is a"
, [Char]
"file that has been darcs added to your repository). As with the boring"
, [Char]
"file, you can also set up a `~/.darcs/binaries` file if you like."])
, ([Char]
"defaultrepo", [[Char]] -> [Char]
unlines
[ [Char]
"Contains the URL of the default remote repository used by commands `pull`,"
, [Char]
"`push`, `send` and `optimize relink`. Darcs edits this file automatically"
, [Char]
"or when the flag `--set-default` is used."])
, ([Char]
"sources", [[Char]] -> [Char]
unlines
[ [Char]
"Besides the defaultrepo, darcs also keeps track of any other locations"
, [Char]
"used in commands for exchanging patches (e.g. push, pull, send)."
, [Char]
"These are subsequently used as alternatives from which to download"
, [Char]
"patches. The file contains lines such as:"
, [Char]
""
, [Char]
" cache:/home/droundy/.cache/darcs"
, [Char]
" readonly:/home/otheruser/.cache/darcs"
, [Char]
" repo:http://darcs.net"
, [Char]
""
, [Char]
"The prefix `cache:` indicates that darcs can use this as a read-write"
, [Char]
"cache for patches, `read-only:` indicates a cache that is only"
, [Char]
"readable, and `repo:` denotes a (possibly remote) repository. The order"
, [Char]
"of the entries is immaterial: darcs will always try local paths before"
, [Char]
"remote ones, and only local ones will be used as potentially writable."
, [Char]
""
, [Char]
"A global cache is enabled by default in your home directory under"
, [Char]
"`.cache/darcs` (older versions of darcs used `.darcs/cache` for this),"
, [Char]
"or `$XDG_CACHE_HOME/darcs` if the environment variable is set, see"
, [Char]
"https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html."
, [Char]
"The cache allows darcs to avoid re-downloading patches (for example, when"
, [Char]
"doing a second darcs clone of the same repository), and also allows darcs"
, [Char]
"to use hard links to reduce disk usage."
, [Char]
""
, [Char]
"Note that the cache directory should reside on the same filesystem as"
, [Char]
"your repositories, so you may need to vary this. You can also use"
, [Char]
"multiple cache directories on different filesystems, if you have several"
, [Char]
"filesystems on which you use darcs."
, [Char]
""
, [Char]
"While darcs automatically adds entries to `_darcs/prefs/sources`, it does"
, [Char]
"not currently remove them. If one or more of the entries aren't accessible"
, [Char]
"(e.g. because they resided on a removable media), then darcs will bugger"
, [Char]
"you with a hint, suggesting you remove those entries. This is done because"
, [Char]
"certain systems have extremely long timeouts associated with some remotely"
, [Char]
"accessible media (e.g. NFS over automounter on Linux), which can slow down"
, [Char]
"darcs operations considerably. On the other hand, when you clone a repo"
, [Char]
"with --lazy from a no longer accessible location, then the hint may give"
, [Char]
"you an idea where the patches could be found, so you can try to restore"
, [Char]
"access to them."
])
, ([Char]
"tmpdir", [[Char]] -> [Char]
unlines
[ [Char]
"By default temporary directories are created in `/tmp`, or if that doesn't"
, [Char]
"exist, in `_darcs` (within the current repo). This can be overridden by"
, [Char]
"specifying some other directory in the file `_darcs/prefs/tmpdir` or the"
, [Char]
"environment variable `$DARCS_TMPDIR` or `$TMPDIR`."])
, ([Char]
"prefs", [[Char]] -> [Char]
unlines
[ [Char]
"Contains the preferences set by the command `darcs setprefs`."
, [Char]
"Do not edit manually."])
]