--  Copyright (C) 2002-2003 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

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
    -- * documentation of prefs files
    , 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 -- GHC under Windows is compiled with mingw
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

-- | The path of the global preference directory; @~/.darcs@ on Unix,
-- and @%APPDATA%/darcs@ on Windows.
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

-- | The relative path of the global preference directory; @~/.darcs@ on Unix,
-- and @%APPDATA%/darcs@ on Windows. This is used for online documentation.
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 attempts to create a Regex from a given String. The
-- evaluation is forced, to ensure any malformed exceptions are thrown here,
-- and not later.
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 returns a list of the boring regexps, from the local and
-- global prefs/boring files. Any invalid regexps are filtered, preventing an
-- exception in (potentially) pure code, when the regexps are used.
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]
noncomments :: [[Char]] -> [[Char]]
noncomments = ([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)

-- | The lines that will be inserted into @_darcs/prefs/binaries@ when
-- @darcs init@ is run.  Hence, a list of comments, blank lines and
-- regular expressions (ERE dialect).
--
-- Note that while this matches .gz and .GZ, it will not match .gZ,
-- i.e. it is not truly case insensitive.
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 adds a new entry to _darcs/prefs/repos and sets it as default
--   in _darcs/prefs/defaultrepo, unless --no-set-default or --dry-run is passed,
--   or it is the same repository as the current one.
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
== [])
    -- the nuance here is that we should only notify when the reason we're not
    -- setting default is the --no-set-default flag, not the various automatic
    -- show stoppers
    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."
        ]

-- | delete references to other repositories.
--   Used when cloning to a ssh destination.
--   Assume the current working dir is the repository.
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

-- | Fetch and return the message of the day for a given repository.
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"

-- | Display the message of the day for a given repository,
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."])
    ]