--  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
    ( Pref(..)
    , addToPreflist
    , deleteSources
    , getPreflist
    , setPreflist
    , getGlobal

    , environmentHelpHome
    , getDefaultRepo
    , addRepoSource

    -- these are for the setpref command i.e. contents of _darcs/prefs/prefs
    , getPrefval
    , setPrefval
    , changePrefval
    , defPrefval

    , writeDefaultPrefs
    , isBoring
    , FileType(..)
    , filetypeFunction
    , getCaches
    , globalCacheDir
    , globalPrefsDirDoc
    , globalPrefsDir
    , getMotd
    , showMotd
    , prefsUrl
    , prefsDirPath --re-export
    , prefsFilePath
    , getPrefLines -- exported for darcsden, don't remove
    -- * documentation of prefs files
    , prefsFilesHelp
    ) where

import Darcs.Prelude

import Control.Exception ( catch )
import Control.Monad ( unless, when, liftM )
import Data.Char ( toLower, toUpper )
import Data.List ( isPrefixOf, union, lookup )
import Data.Maybe
    ( catMaybes
    , fromMaybe
    , isJust
    , listToMaybe
    , mapMaybe
    , 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 Safe ( tailErr )
import System.Directory
    ( createDirectory
    , doesDirectoryExist
    , doesFileExist
    , getAppUserDataDirectory
    , getHomeDirectory
    )
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 ( fileOwner, getFileStatus, ownerModes, setFileMode )

import Darcs.Util.Cache
    ( Cache
    , CacheLoc(..)
    , CacheType(..)
    , WritableOrNot(..)
    , mkCache
    , parseCacheLoc
    )
import Darcs.Util.File ( Cachable(..), fetchFilePS, gzFetchFilePS )
import Darcs.Repository.Flags
    ( UseCache (..)
    , DryRun (..)
    , SetDefault (..)
    , InheritDefault (..)
    , WithPrefsTemplates(..)
    )
import Darcs.Repository.Paths ( prefsDirPath )
import Darcs.Util.Lock( readTextFile, writeTextFile )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Global ( darcsdir, debugMessage )
import Darcs.Util.Path
    ( AbsoluteOrRemotePath
    , getCurrentDirectory
    , toFilePath
    , toPath
    )
import Darcs.Util.Printer( hPutDocLn, text )
import Darcs.Util.Regex ( Regex, mkRegex, matchRegex )
import Darcs.Util.URL ( isValidLocalPath )
import Darcs.Util.File ( removeFileMayNotExist )

windows,osx :: Bool
windows :: Bool
windows = String
"mingw" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
os -- GHC under Windows is compiled with mingw
osx :: Bool
osx     = String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"darwin"

writeDefaultPrefs :: WithPrefsTemplates -> IO ()
writeDefaultPrefs :: WithPrefsTemplates -> IO ()
writeDefaultPrefs WithPrefsTemplates
withPrefsTemplates = do
    Pref -> [String] -> IO ()
setPreflist Pref
Boring ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ WithPrefsTemplates -> [String]
defaultBoring WithPrefsTemplates
withPrefsTemplates
    Pref -> [String] -> IO ()
setPreflist Pref
Binaries ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ WithPrefsTemplates -> [String]
defaultBinaries WithPrefsTemplates
withPrefsTemplates
    Pref -> [String] -> IO ()
setPreflist Pref
Motd []

defaultBoring :: WithPrefsTemplates -> [String]
defaultBoring :: WithPrefsTemplates -> [String]
defaultBoring WithPrefsTemplates
withPrefsTemplates =
  (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"# " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
boringFileInternalHelp [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    case WithPrefsTemplates
withPrefsTemplates of
      WithPrefsTemplates
NoPrefsTemplates -> []
      WithPrefsTemplates
WithPrefsTemplates -> [String]
defaultBoringTemplate

defaultBoringTemplate :: [String]
defaultBoringTemplate :: [String]
defaultBoringTemplate =
    [ String
""
    , String
"### compiler and interpreter intermediate files"
    , String
"# haskell (ghc) interfaces"
    , String
"\\.hi$", String
"\\.hi-boot$", String
"\\.o-boot$"
    , String
"# object files"
    , String
"\\.o$",String
"\\.o\\.cmd$"
    , String
"# profiling haskell"
    , String
"\\.p_hi$", String
"\\.p_o$"
    , String
"# haskell program coverage resp. profiling info"
    , String
"\\.tix$", String
"\\.prof$"
    , String
"# fortran module files"
    , String
"\\.mod$"
    , String
"# linux kernel"
    , String
"\\.ko\\.cmd$",String
"\\.mod\\.c$"
    , String
"(^|/)\\.tmp_versions/"
    , String
"# *.ko files aren't boring by default because they might"
    , String
"# be Korean translations rather than kernel modules"
    , String
"# \\.ko$"
    , String
"# python, emacs, java byte code"
    , String
"\\.py[co]$", String
"\\.elc$",String
"\\.class$"
    , String
"# objects and libraries; lo and la are libtool things"
    , String
"\\.(obj|a|exe|so|lo|la)$"
    , String
"# compiled zsh configuration files"
    , String
"\\.zwc$"
    , String
"# Common LISP output files for CLISP and CMUCL"
    , String
"\\.(fas|fasl|sparcf|x86f)$"
    , String
""
    , String
"### build and packaging systems"
    , String
"# cabal intermediates"
    , String
"\\.installed-pkg-config"
    , String
"\\.setup-config"
    , String
"# standard cabal build dir, might not be boring for everybody"
    , String
"# ^dist(/|$)"
    , String
"# autotools"
    , String
"(^|/)autom4te\\.cache/", String
"(^|/)config\\.(log|status)$"
    , String
"# microsoft web expression, visual studio metadata directories"
    , String
"\\_vti_cnf$"
    , String
"\\_vti_pvt$"
    , String
"# gentoo tools"
    , String
"\\.revdep-rebuild.*"
    , String
"# generated dependencies"
    , String
"^\\.depend$"
    , String
""
    , String
"### version control systems"
    , String
"# cvs"
    , String
"(^|/)CVS/",String
"\\.cvsignore$"
    , String
"# cvs, emacs locks"
    , String
"^\\.#"
    , String
"# rcs"
    , String
"(^|/)RCS/", String
",v$"
    , String
"# subversion"
    , String
"(^|/)\\.svn/"
    , String
"# mercurial"
    , String
"(^|/)\\.hg/"
    , String
"# git"
    , String
"(^|/)\\.git/"
    , String
"# bzr"
    , String
"\\.bzr$"
    , String
"# sccs"
    , String
"(^|/)SCCS/"
    , String
"# darcs"
    , String
"(^|/)"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
darcsdirString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"/", String
"(^|/)\\.darcsrepo/"
    , String
"# gnu arch"
    , String
"(^|/)(\\+|,)"
    , String
"(^|/)vssver\\.scc$"
    , String
"\\.swp$",String
"(^|/)MT/"
    , String
"(^|/)\\{arch\\}/",String
"(^|/).arch-ids/"
    , String
"# bitkeeper"
    , String
"(^|/)BitKeeper/",String
"(^|/)ChangeSet/"
    , String
""
    , String
"### miscellaneous"
    , String
"# backup files"
    , String
"~$",String
"\\.bak$",String
"\\.BAK$"
    , String
"# patch originals and rejects"
    , String
"\\.orig$", String
"\\.rej$"
    , String
"# X server"
    , String
"\\..serverauth.*"
    , String
"# image spam"
    , String
"\\#", String
"(^|/)Thumbs\\.db$"
    , String
"# vi, emacs tags"
    , String
"(^|/)(tags|TAGS)$"
    , String
"#(^|/)\\.[^/]"
    , String
"# core dumps"
    , String
"(^|/|\\.)core$"
    , String
"# partial broken files (KIO copy operations)"
    , String
"\\.part$"
    , String
"# waf files, see http://code.google.com/p/waf/"
    , String
"(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+/"
    , String
"(^|/)\\.lock-wscript$"
    , String
"# mac os finder"
    , String
"(^|/)\\.DS_Store$"
    , String
"# emacs saved sessions (desktops)"
    , String
"(^|.*/)\\.emacs\\.desktop(\\.lock)?$"
    , String
" # stack"
    , String
"(^|/)\\.stack-work/"
    ]

boringFileInternalHelp :: [String]
boringFileInternalHelp :: [String]
boringFileInternalHelp =
    [ String
"This file contains a list of extended regular expressions, one per"
    , String
"line. A file path matching any of these expressions will be filtered"
    , String
"out during `darcs add`, or when the `--look-for-adds` flag is passed"
    , String
"to `darcs whatsnew` and `record`. The entries in "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globalPrefsDirDoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"boring (if"
    , String
"it exists) supplement those in this file."
    , String
""
    , String
"Blank lines, and lines beginning with an octothorpe (#) are ignored."
    , String
"See regex(7) for a description of extended regular expressions."
    ]

-- | The path of the global preference directory; @~/.darcs@ on Unix,
-- and @%APPDATA%/darcs@ on Windows.
globalPrefsDir :: IO (Maybe FilePath)
globalPrefsDir :: IO (Maybe String)
globalPrefsDir = do
    [(String, String)]
env <- IO [(String, String)]
getEnvironment
    case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"DARCS_TESTING_PREFS_DIR" [(String, String)]
env of
        Just String
d -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
d)
        Maybe String
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO String
getAppUserDataDirectory String
"darcs"
                   IO (Maybe String) -> IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a -> IO a
`catchall` Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
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 :: String
globalPrefsDirDoc | Bool
windows   = String
"%APPDATA%\\darcs\\"
                  | Bool
otherwise = String
"~/.darcs/"

environmentHelpHome :: ([String], [String])
environmentHelpHome :: ([String], [String])
environmentHelpHome =
    ( [String
"HOME", String
"APPDATA"]
    , [ String
"Per-user preferences are set in $HOME/.darcs (on Unix) or"
      , String
"%APPDATA%/darcs (on Windows).  This is also the default location of"
      , String
"the cache."
      ]
    )

getGlobal :: Pref -> IO [String]
getGlobal :: Pref -> IO [String]
getGlobal Pref
f = do
    Maybe String
dir <- IO (Maybe String)
globalPrefsDir
    case Maybe String
dir of
        (Just String
d) -> String -> IO [String]
getPreffile (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
d String -> String -> String
</> Pref -> String
formatPref Pref
f
        Maybe String
Nothing -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- |osxCacheDir assumes @~/Library/Caches/@ exists.
osxCacheDir :: IO (Maybe FilePath)
osxCacheDir :: IO (Maybe String)
osxCacheDir = do
    String
home <- IO String
getHomeDirectory
    Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
home String -> String -> String
</> String
"Library" String -> String -> String
</> String
"Caches"
    IO (Maybe String) -> IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a -> IO a
`catchall` Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

-- |xdgCacheDir returns the $XDG_CACHE_HOME environment variable,
-- or @~/.cache@ if undefined. See the FreeDesktop specification:
-- http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
xdgCacheDir :: IO (Maybe FilePath)
xdgCacheDir :: IO (Maybe String)
xdgCacheDir = do
    [(String, String)]
env <- IO [(String, String)]
getEnvironment
    String
d <- case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"XDG_CACHE_HOME" [(String, String)]
env of
           Just String
d  -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
d
           Maybe String
Nothing -> String -> IO String
getAppUserDataDirectory String
"cache"
    Bool
exists <- String -> IO Bool
doesDirectoryExist String
d

    -- If directory does not exist, create it with permissions 0700
    -- as specified by the FreeDesktop standard.
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do String -> IO ()
createDirectory String
d
                       String -> FileMode -> IO ()
setFileMode String
d FileMode
ownerModes
    Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
d
    IO (Maybe String) -> IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a -> IO a
`catchall` Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

globalCacheDir :: IO (Maybe FilePath)
globalCacheDir :: IO (Maybe String)
globalCacheDir | Bool
windows   = ((String -> String -> String
</> String
"cache2") (String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`) (Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Maybe String)
globalPrefsDir
               | Bool
osx       = ((String -> String -> String
</> String
"darcs") (String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`) (Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Maybe String)
osxCacheDir
               | Bool
otherwise = ((String -> String -> String
</> String
"darcs") (String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`) (Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO (Maybe String)
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 :: String -> IO (Maybe Regex)
tryMakeBoringRegexp String
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
$! String -> Regex
mkRegex String
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Regex -> IO (Maybe Regex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Regex
forall a. Maybe a
Nothing

    warning :: Doc
warning = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Warning: Ignored invalid boring regex: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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
    [String]
borefile <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> IO (Maybe String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
getPrefval String
"boringfile"
    [String]
localBores <-
      [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
safeGetPrefLines (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` ([String]
borefile [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Pref -> String
prefsFile Pref
Boring])
    [String]
globalBores <- Pref -> IO [String]
getGlobal Pref
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
$ (String -> IO (Maybe Regex)) -> [String] -> IO [Maybe Regex]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO (Maybe Regex)
tryMakeBoringRegexp ([String] -> IO [Maybe Regex]) -> [String] -> IO [Maybe Regex]
forall a b. (a -> b) -> a -> b
$ [String]
localBores [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
globalBores
  where
    safeGetPrefLines :: String -> IO [String]
safeGetPrefLines String
fileName = String -> IO [String]
getPrefLines String
fileName IO [String] -> IO [String] -> IO [String]
forall a. IO a -> IO a -> IO a
`catchall` [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

isBoring :: IO (FilePath -> Bool)
isBoring :: IO (String -> Bool)
isBoring = do
  [Regex]
regexps <- IO [Regex]
boringRegexps
  (String -> Bool) -> IO (String -> Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> Bool) -> IO (String -> Bool))
-> (String -> Bool) -> IO (String -> Bool)
forall a b. (a -> b) -> a -> b
$ \String
file -> (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Regex
r -> Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex Regex
r String
file) [Regex]
regexps

noncomments :: [String] -> [String]
noncomments :: [String] -> [String]
noncomments = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
nonComment
  where
    nonComment :: String -> Bool
nonComment String
"" = Bool
False
    nonComment (Char
'#' : String
_) = Bool
False
    nonComment String
_ = Bool
True

getPrefLines :: FilePath -> IO [String]
getPrefLines :: String -> IO [String]
getPrefLines String
f = [String] -> [String]
removeCRsCommentsAndConflicts ([String] -> [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO [String]
forall p. FilePathLike p => p -> IO [String]
readTextFile String
f
  where
    removeCRsCommentsAndConflicts :: [String] -> [String]
removeCRsCommentsAndConflicts =
        (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
notconflict ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
noncomments ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
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 :: String -> Bool
notconflict String
l
        | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith String
"v v v v v v v" String
l = Bool
False
        | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith String
"*************" String
l = Bool
False
        | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
startswith String
"^ ^ ^ ^ ^ ^ ^" String
l = Bool
False
        | Bool
otherwise = Bool
True
    stripCr :: String -> String
stripCr String
""     = String
""
    stripCr String
"\r"   = String
""
    stripCr (Char
c : String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
stripCr String
cs

doNormalise :: FilePath -> FilePath
doNormalise :: String -> String
doNormalise = String -> String
dropTrailingPathSeparator (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
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
$c== :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
/= :: 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 :: WithPrefsTemplates -> [String]
defaultBinaries :: WithPrefsTemplates -> [String]
defaultBinaries WithPrefsTemplates
withPrefsTemplates =
  (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"# "String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
binariesFileInternalHelp [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    case WithPrefsTemplates
withPrefsTemplates of
      WithPrefsTemplates
NoPrefsTemplates -> []
      WithPrefsTemplates
WithPrefsTemplates -> [String]
defaultBinariesTemplate

defaultBinariesTemplate :: [String]
defaultBinariesTemplate :: [String]
defaultBinariesTemplate =
    [ String
"\\." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
regexToMatchOrigOrUpper String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$" | String
e <- [String]
extensions ]
  where
    regexToMatchOrigOrUpper :: String -> String
regexToMatchOrigOrUpper String
e = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    extensions :: [String]
extensions =
        [ String
"a"
        , String
"bmp"
        , String
"bz2"
        , String
"doc"
        , String
"elc"
        , String
"exe"
        , String
"gif"
        , String
"gz"
        , String
"iso"
        , String
"jar"
        , String
"jpe?g"
        , String
"mng"
        , String
"mpe?g"
        , String
"p[nbgp]m"
        , String
"pdf"
        , String
"png"
        , String
"pyc"
        , String
"so"
        , String
"tar"
        , String
"tgz"
        , String
"tiff?"
        , String
"z"
        , String
"zip"
        ]

binariesFileInternalHelp :: [String]
binariesFileInternalHelp :: [String]
binariesFileInternalHelp =
    [ String
"This file contains a list of extended regular expressions, one per"
    , String
"line.  A file path matching any of these expressions is assumed to"
    , String
"contain binary data (not text). The entries in "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globalPrefsDirDoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"binaries (if"
    , String
"it exists) supplement those in this file."
    , String
""
    , String
"Blank lines, and lines beginning with an octothorpe (#) are ignored."
    , String
"See regex(7) for a description of extended regular expressions."
    ]

filetypeFunction :: IO (FilePath -> FileType)
filetypeFunction :: IO (String -> FileType)
filetypeFunction = do
    [String]
binsfile <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> IO (Maybe String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
getPrefval String
"binariesfile"
    [String]
bins <-
      [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
safeGetPrefLines (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` ([String]
binsfile [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Pref -> String
prefsFile Pref
Binaries])
    [String]
gbs <- Pref -> IO [String]
getGlobal Pref
Binaries
    let binaryRegexes :: [Regex]
binaryRegexes = (String -> Regex) -> [String] -> [Regex]
forall a b. (a -> b) -> [a] -> [b]
map String -> Regex
mkRegex ([String]
bins [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
gbs)
        isBinary :: String -> Bool
isBinary String
f = (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Regex
r -> Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex Regex
r String
f) [Regex]
binaryRegexes
        ftf :: String -> FileType
ftf String
f = if String -> Bool
isBinary (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String -> String
doNormalise String
f then FileType
BinaryFile else FileType
TextFile
    (String -> FileType) -> IO (String -> FileType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String -> FileType
ftf
  where
    safeGetPrefLines :: String -> IO [String]
safeGetPrefLines String
fileName =
        String -> IO [String]
getPrefLines String
fileName
        IO [String] -> (IOError -> IO [String]) -> IO [String]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
        (\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [] else IOError -> IO [String]
forall a. IOError -> IO a
ioError IOError
e)

findPrefsDirectory :: IO (Maybe String)
findPrefsDirectory :: IO (Maybe String)
findPrefsDirectory = do
    Bool
inDarcsRepo <- String -> IO Bool
doesDirectoryExist String
darcsdir
    Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
inDarcsRepo
                 then String -> Maybe String
forall a. a -> Maybe a
Just String
prefsDirPath
                 else Maybe String
forall a. Maybe a
Nothing

withPrefsDirectory :: (String -> IO ()) -> IO ()
withPrefsDirectory :: (String -> IO ()) -> IO ()
withPrefsDirectory String -> IO ()
job = IO (Maybe String)
findPrefsDirectory IO (Maybe String) -> (Maybe String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) String -> IO ()
job

data Pref
  = Author
  | Binaries
  | Boring
  | Defaultrepo
  | Defaults
  | Email
  | Motd
  | Post
  | Prefs
  | Repos
  | Sources
  deriving (Pref -> Pref -> Bool
(Pref -> Pref -> Bool) -> (Pref -> Pref -> Bool) -> Eq Pref
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pref -> Pref -> Bool
== :: Pref -> Pref -> Bool
$c/= :: Pref -> Pref -> Bool
/= :: Pref -> Pref -> Bool
Eq, Eq Pref
Eq Pref =>
(Pref -> Pref -> Ordering)
-> (Pref -> Pref -> Bool)
-> (Pref -> Pref -> Bool)
-> (Pref -> Pref -> Bool)
-> (Pref -> Pref -> Bool)
-> (Pref -> Pref -> Pref)
-> (Pref -> Pref -> Pref)
-> Ord Pref
Pref -> Pref -> Bool
Pref -> Pref -> Ordering
Pref -> Pref -> Pref
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pref -> Pref -> Ordering
compare :: Pref -> Pref -> Ordering
$c< :: Pref -> Pref -> Bool
< :: Pref -> Pref -> Bool
$c<= :: Pref -> Pref -> Bool
<= :: Pref -> Pref -> Bool
$c> :: Pref -> Pref -> Bool
> :: Pref -> Pref -> Bool
$c>= :: Pref -> Pref -> Bool
>= :: Pref -> Pref -> Bool
$cmax :: Pref -> Pref -> Pref
max :: Pref -> Pref -> Pref
$cmin :: Pref -> Pref -> Pref
min :: Pref -> Pref -> Pref
Ord, ReadPrec [Pref]
ReadPrec Pref
Int -> ReadS Pref
ReadS [Pref]
(Int -> ReadS Pref)
-> ReadS [Pref] -> ReadPrec Pref -> ReadPrec [Pref] -> Read Pref
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Pref
readsPrec :: Int -> ReadS Pref
$creadList :: ReadS [Pref]
readList :: ReadS [Pref]
$creadPrec :: ReadPrec Pref
readPrec :: ReadPrec Pref
$creadListPrec :: ReadPrec [Pref]
readListPrec :: ReadPrec [Pref]
Read, Int -> Pref -> String -> String
[Pref] -> String -> String
Pref -> String
(Int -> Pref -> String -> String)
-> (Pref -> String) -> ([Pref] -> String -> String) -> Show Pref
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Pref -> String -> String
showsPrec :: Int -> Pref -> String -> String
$cshow :: Pref -> String
show :: Pref -> String
$cshowList :: [Pref] -> String -> String
showList :: [Pref] -> String -> String
Show)

formatPref :: Pref -> String
formatPref :: Pref -> String
formatPref = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (Pref -> String) -> Pref -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pref -> String
forall a. Show a => a -> String
show

addToPreflist :: Pref -> String -> IO ()
addToPreflist :: Pref -> String -> IO ()
addToPreflist Pref
pref String
value =
  (String -> IO ()) -> IO ()
withPrefsDirectory ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
prefs_dir -> do
    Bool
hasprefs <- String -> IO Bool
doesDirectoryExist String
prefs_dir
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasprefs (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
createDirectory String
prefs_dir
    [String]
pl <- Pref -> IO [String]
getPreflist Pref
pref
    String -> String -> IO ()
forall p. FilePathLike p => p -> String -> IO ()
writeTextFile (String
prefs_dir String -> String -> String
</> Pref -> String
formatPref Pref
pref) (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
union [String
value] [String]
pl

getPreflist :: Pref -> IO [String]
getPreflist :: Pref -> IO [String]
getPreflist Pref
pref =
  IO (Maybe String)
findPrefsDirectory IO (Maybe String) -> (Maybe String -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  IO [String]
-> (String -> IO [String]) -> Maybe String -> IO [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []) (\String
prefs_dir -> String -> IO [String]
getPreffile (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
prefs_dir String -> String -> String
</> Pref -> String
formatPref Pref
pref)

getPreffile :: FilePath -> IO [String]
getPreffile :: String -> IO [String]
getPreffile String
f = do
    Bool
hasprefs <- String -> IO Bool
doesFileExist String
f
    if Bool
hasprefs then String -> IO [String]
getPrefLines String
f else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

setPreflist :: Pref -> [String] -> IO ()
setPreflist :: Pref -> [String] -> IO ()
setPreflist Pref
p [String]
ls = (String -> IO ()) -> IO ()
withPrefsDirectory ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
prefs_dir -> do
    Bool
haspref <- String -> IO Bool
doesDirectoryExist String
prefs_dir
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
haspref (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> String -> IO ()
forall p. FilePathLike p => p -> String -> IO ()
writeTextFile (String
prefs_dir String -> String -> String
</> Pref -> String
formatPref Pref
p) ([String] -> String
unlines [String]
ls)

defPrefval :: String -> String -> IO String
defPrefval :: String -> String -> IO String
defPrefval String
p String
d = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
d (Maybe String -> String) -> IO (Maybe String) -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO (Maybe String)
getPrefval String
p

getPrefval :: String -> IO (Maybe String)
getPrefval :: String -> IO (Maybe String)
getPrefval String
p = do
    [String]
pl <- Pref -> IO [String]
getPreflist Pref
Prefs
    Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ case ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p) (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) ([(String, String)] -> [(String, String)])
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')) [String]
pl of
                 [String
val] -> case String -> [String]
words String
val of
                    [] -> Maybe String
forall a. Maybe a
Nothing
                    [String]
_ -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Partial => [a] -> [a]
tailErr String
val
                 [String]
_ -> Maybe String
forall a. Maybe a
Nothing

setPrefval :: String -> String -> IO ()
setPrefval :: String -> String -> IO ()
setPrefval String
p String
v = do
    [String]
pl <- Pref -> IO [String]
getPreflist Pref
Prefs
    Pref -> [String] -> IO ()
setPreflist Pref
Prefs ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String -> String -> [String]
updatePrefVal [String]
pl String
p String
v

updatePrefVal :: [String] -> String -> String -> [String]
updatePrefVal :: [String] -> String -> String -> [String]
updatePrefVal [String]
prefList String
p String
newVal =
    (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
p) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')) [String]
prefList [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
newVal]

changePrefval :: String -> String -> String -> IO ()
changePrefval :: String -> String -> String -> IO ()
changePrefval String
p String
f String
t = do
    [String]
pl <- Pref -> IO [String]
getPreflist Pref
Prefs
    Maybe String
ov <- String -> IO (Maybe String)
getPrefval String
p
    let newval :: String
newval = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
t (\String
old -> if String
old String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
f then String
t else String
old) Maybe String
ov
    Pref -> [String] -> IO ()
setPreflist Pref
Prefs ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String -> String -> [String]
updatePrefVal [String]
pl String
p String
newval

getDefaultRepo :: IO (Maybe String)
getDefaultRepo :: IO (Maybe String)
getDefaultRepo = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> IO [String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pref -> IO [String]
getPreflist Pref
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
              -> SetDefault
              -> InheritDefault
              -> Bool
              -> IO ()
addRepoSource :: String -> DryRun -> SetDefault -> InheritDefault -> Bool -> IO ()
addRepoSource String
r DryRun
isDryRun SetDefault
setDefault InheritDefault
inheritDefault Bool
isInteractive = (do
    Maybe String
olddef <- IO (Maybe String)
getDefaultRepo
    String
newdef <- IO String
newDefaultRepo
    let shouldDoIt :: Bool
shouldDoIt = [Bool] -> Bool
forall a. [a] -> 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
&& Maybe String
olddef Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Maybe String
forall a. a -> Maybe a
Just String
newdef
    -- 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 Pref -> [String] -> IO ()
setPreflist Pref
Defaultrepo [String
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
$
                String -> IO ()
putStr (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String]
setDefaultMsg
    Pref -> String -> IO ()
addToPreflist Pref
Repos String
newdef) IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchall` () -> IO ()
forall a. a -> IO a
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
    noSetDefault :: [Bool]
noSetDefault = case SetDefault
setDefault of
                       NoSetDefault Bool
x -> [Bool
x]
                       SetDefault
_ -> []
    setDefaultMsg :: [String]
setDefaultMsg =
        [ String
"By the way, to change the default remote repository to"
        , String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
","
        , String
"you can " String -> String -> String
forall a. [a] -> [a] -> [a]
++
          (if Bool
isInteractive then String
"quit now and " else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++
          String
"issue the same command with the --set-default flag."
        ]
    newDefaultRepo :: IO String
    newDefaultRepo :: IO String
newDefaultRepo = case InheritDefault
inheritDefault of
      InheritDefault
YesInheritDefault -> IO String
getRemoteDefaultRepo
      InheritDefault
NoInheritDefault -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
r
    -- TODO It would be nice if --inherit-default could be made to work with
    -- arbitrary remote repos; for security reasons we currently allow only
    -- repos on the same host which must also be owned by ourselves. This is
    -- because the defaultrepo file is read and written as a text file, and
    -- therefore encoded in the user's locale encoding. See
    -- http://bugs.darcs.net/issue2627 for a more detailed discussion.
    getRemoteDefaultRepo :: IO String
getRemoteDefaultRepo
      | String -> Bool
isValidLocalPath String
r = do
          String -> String -> IO Bool
sameOwner String
r String
"." IO Bool -> (Bool -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
True -> do
              [String]
defs <-
                String -> IO [String]
getPreffile (String -> Pref -> String
prefsUrl String
r Pref
Defaultrepo)
                IO [String] -> (IOError -> IO [String]) -> IO [String]
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError`
                IO [String] -> IOError -> IO [String]
forall a b. a -> b -> a
const ([String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
r])
              case [String]
defs of
                String
defrepo:[String]
_ -> do
                  String -> IO ()
debugMessage String
"using defaultrepo of remote"
                  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
defrepo
                [] -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
r
            Bool
False -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
r
      | Bool
otherwise = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
r
    -- In case r is a symbolic link we do want the target directory's
    -- status, not that of the symlink.
    sameOwner :: String -> String -> IO Bool
sameOwner String
p String
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
<$> String -> IO FileStatus
getFileStatus String
p) IO (UserID -> Bool) -> IO UserID -> IO Bool
forall a b. IO (a -> b) -> IO a -> IO b
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
<$> String -> IO FileStatus
getFileStatus String
q)

-- | 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
  String -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist (Pref -> String
prefsFile Pref
Sources)
  String -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist (Pref -> String
prefsFile Pref
Repos)

getCaches :: UseCache -> Maybe AbsoluteOrRemotePath -> IO Cache
getCaches :: UseCache -> Maybe AbsoluteOrRemotePath -> IO Cache
getCaches UseCache
useCache Maybe AbsoluteOrRemotePath
from = do
    [CacheLoc]
here <- [String] -> [CacheLoc]
parsehs ([String] -> [CacheLoc]) -> IO [String] -> IO [CacheLoc]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Pref -> IO [String]
getPreflist Pref
Sources
    Maybe String
globalcachedir <- IO (Maybe String)
globalCacheDir
    let globalcache :: [CacheLoc]
globalcache = if Bool
nocache
                          then []
                          else case Maybe String
globalcachedir of
                              Maybe String
Nothing -> []
                              Just String
d -> [CacheType -> WritableOrNot -> String -> CacheLoc
Cache CacheType
Directory WritableOrNot
Writable String
d]
    [CacheLoc]
globalsources <- [String] -> [CacheLoc]
parsehs ([String] -> [CacheLoc]) -> IO [String] -> IO [CacheLoc]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Pref -> IO [String]
getGlobal Pref
Sources
    AbsolutePath
thisdir <- IO AbsolutePath
getCurrentDirectory
    let thisrepo :: [CacheLoc]
thisrepo = [CacheType -> WritableOrNot -> String -> CacheLoc
Cache CacheType
Repo WritableOrNot
Writable (String -> CacheLoc) -> String -> CacheLoc
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
thisdir]
    [CacheLoc]
from_cache <-
      case Maybe AbsoluteOrRemotePath
from of
        Maybe AbsoluteOrRemotePath
Nothing -> [CacheLoc] -> IO [CacheLoc]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just AbsoluteOrRemotePath
repoloc -> do
          [CacheLoc]
there <- ([String] -> [CacheLoc]
parsehs ([String] -> [CacheLoc])
-> (ByteString -> [String]) -> ByteString -> [CacheLoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String])
-> (ByteString -> String) -> ByteString -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BC.unpack)
                 (ByteString -> [CacheLoc]) -> IO ByteString -> IO [CacheLoc]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                 (String -> Cachable -> IO ByteString
gzFetchFilePS (String -> Pref -> String
prefsUrl (AbsoluteOrRemotePath -> String
forall a. FilePathOrURL a => a -> String
toPath AbsoluteOrRemotePath
repoloc) Pref
Sources) Cachable
Cachable
                  IO ByteString -> IO ByteString -> IO ByteString
forall a. IO a -> IO a -> IO a
`catchall` ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty)
          let thatrepo :: [CacheLoc]
thatrepo = [CacheType -> WritableOrNot -> String -> CacheLoc
Cache CacheType
Repo WritableOrNot
NotWritable (AbsoluteOrRemotePath -> String
forall a. FilePathOrURL a => a -> String
toPath AbsoluteOrRemotePath
repoloc)]
              externalSources :: [CacheLoc]
externalSources =
                  if String -> Bool
isValidLocalPath (AbsoluteOrRemotePath -> String
forall a. FilePathOrURL a => a -> String
toPath AbsoluteOrRemotePath
repoloc)
                      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
. String -> Bool
isValidLocalPath (String -> Bool) -> (CacheLoc -> String) -> CacheLoc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheLoc -> String
cacheSource) [CacheLoc]
there
          [CacheLoc] -> IO [CacheLoc]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CacheLoc]
thatrepo [CacheLoc] -> [CacheLoc] -> [CacheLoc]
forall a. [a] -> [a] -> [a]
++ [CacheLoc]
externalSources)
    Cache -> IO Cache
forall a. a -> IO a
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]
thisrepo [CacheLoc] -> [CacheLoc] -> [CacheLoc]
forall a. [a] -> [a] -> [a]
++ [CacheLoc]
here [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]
from_cache)
  where
    parsehs :: [String] -> [CacheLoc]
parsehs = (CacheLoc -> Bool) -> [CacheLoc] -> [CacheLoc]
forall a. (a -> Bool) -> [a] -> [a]
filter CacheLoc -> Bool
by ([CacheLoc] -> [CacheLoc])
-> ([String] -> [CacheLoc]) -> [String] -> [CacheLoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe CacheLoc) -> [String] -> [CacheLoc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe CacheLoc
parseCacheLoc ([String] -> [CacheLoc])
-> ([String] -> [String]) -> [String] -> [CacheLoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
noncomments
    by :: CacheLoc -> Bool
by (Cache CacheType
Directory WritableOrNot
_ String
_) = Bool -> Bool
not Bool
nocache
    by (Cache CacheType
Repo WritableOrNot
Writable String
_) = Bool
False -- ignore thisrepo: entries
    by CacheLoc
_ = Bool
True
    nocache :: Bool
nocache = UseCache
useCache UseCache -> UseCache -> Bool
forall a. Eq a => a -> a -> Bool
== UseCache
NoUseCache

-- | Fetch and return the message of the day for a given repository.
getMotd :: String -> IO B.ByteString
getMotd :: String -> IO ByteString
getMotd String
repo = String -> Cachable -> IO ByteString
fetchFilePS String
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
  where
    motdPath :: String
motdPath = String -> Pref -> String
prefsUrl String
repo Pref
Motd

-- | Display the message of the day for a given repository,
showMotd :: String -> IO ()
showMotd :: String -> IO ()
showMotd String
repo = do
    ByteString
motd <- String -> IO ByteString
getMotd String
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
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
22 Char
'*'

prefsUrl :: String -> Pref -> String
prefsUrl :: String -> Pref -> String
prefsUrl String
repourl Pref
pref = String
repourl String -> String -> String
</> String
prefsDirPath String -> String -> String
</> Pref -> String
formatPref Pref
pref

prefsFile :: Pref -> FilePath
prefsFile :: Pref -> String
prefsFile Pref
pref = String
prefsDirPath String -> String -> String
</> Pref -> String
formatPref Pref
pref

prefsFilePath :: FilePath
prefsFilePath :: String
prefsFilePath = Pref -> String
prefsFile Pref
Prefs

prefsFilesHelp :: [(String,String)]
prefsFilesHelp :: [(String, String)]
prefsFilesHelp  =
    [ (String
"motd", [String] -> String
unlines
      [ String
"The `_darcs/prefs/motd` file may contain a 'message of the day' which"
      , String
"will be displayed to users who clone or pull from the repository without"
      , String
"the `--quiet` option."])
    , (String
"email", [String] -> String
unlines
      [ String
"The `_darcs/prefs/email` file is used to provide the e-mail address for"
      , String
"your repository that others will use when they `darcs send` a patch back"
      , String
"to you. The contents of the file should simply be an e-mail address."])
    , (String
"post", [String] -> String
unlines
      [ String
"If `_darcs/prefs/post` exists in the target repository, `darcs send ` will"
      , String
"upload to the URL contained in that file, which may either be a `mailto:`"
      , String
"URL, or an `http://` URL. In the latter case, the patch is posted to that URL."])
    , (String
"author", [String] -> String
unlines
      [ String
"The `_darcs/prefs/author` file contains the email address (or name) to"
      , String
"be used as the author when patches are recorded in this repository,"
      , String
"e.g. `David Roundy <droundy@abridgegame.org>`. This file overrides the"
      , String
"contents of the environment variables `$DARCS_EMAIL` and `$EMAIL`."])
    , (String
"defaults", [String] -> String
unlines
      [ String
"Default options for darcs commands. Each line of this file has the"
      , String
"following form:"
      , String
""
      , String
"    COMMAND FLAG VALUE"
      , String
""
      , String
"where `COMMAND` is either the name of the command to which the default"
      , String
"applies, or `ALL` to indicate that the default applies to all commands"
      , String
"accepting that flag. The `FLAG` term is the name of the long argument"
      , String
"option with or without the `--`, i.e. `verbose` or `--verbose`."
      , String
"Finally, the `VALUE` option can be omitted if the flag does not involve"
      , String
"a value. If the value has spaces in it, use single quotes, not double"
      , String
"quotes, to surround it. Each line only takes one flag. To set multiple"
      , String
"defaults for the same command (or for `ALL` commands), use multiple lines."
      , String
""
      , String
"Options listed in the defaults file are just that: defaults. You can"
      , String
"override any default on the command line."
      , String
""
      , String
"Note that the use of `ALL` easily can have unpredicted consequences,"
      , String
"especially if commands in newer versions of darcs accepts flags that"
      , String
"they did not in previous versions. Only use safe flags with `ALL`."
      , String
""
      , String
"For example, if your system clock is bizarre, you could instruct darcs to"
      , String
"always ignore the file modification times by adding the following line:"
      , String
""
      , String
"    ALL ignore-times"
      , String
""
      , String
"There are some options which are meant specifically for use in"
      , String
"`_darcs/prefs/defaults`. One of them is `--disable`. As the name"
      , String
"suggests, this option will disable every command that got it as"
      , String
"argument. So, if you are afraid that you could damage your repositories"
      , String
"by inadvertent use of a command like amend, add the following line:"
      , String
""
      , String
"    amend disable"
      , String
""
      , String
"A global defaults file can be created with the name"
      , String
"`.darcs/defaults` in your home directory. In case of conflicts,"
      , String
"the defaults for a specific repository take precedence."
      ])
    , (String
"boring", [String] -> String
unlines
      [ String
"The `_darcs/prefs/boring` file may contain a list of regular expressions"
      , String
"describing files, such as object files, that you do not expect to add to"
      , String
"your project. A newly created repository has a boring file that includes"
      , String
"many common source control, backup, temporary, and compiled files."
      , String
""
      , String
"You may want to have the boring file under version control. To do this"
      , String
"you can use darcs setpref to set the value 'boringfile' to the name of"
      , String
"your desired boring file (e.g. `darcs setpref boringfile .boring`, where"
      , String
"`.boring` is the repository path of a file that has been darcs added to"
      , String
"your repository). The boringfile preference overrides"
      , String
"`_darcs/prefs/boring`, so be sure to copy that file to the boringfile."
      , String
""
      , String
"You can also set up a 'boring' regexps file in your home directory, named"
      , String
"`~/.darcs/boring`, which will be used with all of your darcs repositories."
      , String
""
      , String
"Any file not already managed by darcs and whose repository path"
      , String
"matches any of the boring regular expressions is"
      , String
"considered boring. The boring file is used to filter the files provided"
      , String
"to darcs add, to allow you to use a simple `darcs add newdir newdir/*`"
      , String
"without accidentally adding a bunch of object files. It is also used"
      , String
"when the `--look-for-adds` flag is given to whatsnew or record. Note"
      , String
"that once a file has been added to darcs, it is not considered boring,"
      , String
"even if it matches the boring file filter."])
    , (String
"binaries", [String] -> String
unlines
      [ String
"The `_darcs/prefs/binaries` file may contain a list of regular"
      , String
"expressions describing files that should be treated as binary files rather"
      , String
"than text files. Darcs automatically treats files containing characters"
      , String
"`^Z` or `NULL` within the first 4096 bytes as being binary files."
      , String
"You probably will want to have the binaries file under version control."
      , String
"To do this you can use `darcs setpref` to set the value 'binariesfile'"
      , String
"to the name of your desired binaries file"
      , String
"(e.g. `darcs setpref binariesfile ./.binaries`, where `.binaries` is a"
      , String
"file that has been darcs added to your repository). As with the boring"
      , String
"file, you can also set up a `~/.darcs/binaries` file if you like."])
    , (String
"defaultrepo", [String] -> String
unlines
      [ String
"Contains the URL of the default remote repository used by commands `pull`,"
      , String
"`push`, `send` and `optimize relink`. Darcs edits this file automatically"
      , String
"or when the flag `--set-default` is used."])
    , (String
"sources", [String] -> String
unlines
      [ String
"Besides the defaultrepo, darcs also keeps track of any other locations"
      , String
"used in commands for exchanging patches (e.g. push, pull, send)."
      , String
"These are subsequently used as alternatives from which to download"
      , String
"patches. The file contains lines such as:"
      , String
""
      , String
"    cache:/home/droundy/.cache/darcs"
      , String
"    readonly:/home/otheruser/.cache/darcs"
      , String
"    repo:http://darcs.net"
      , String
""
      , String
"The prefix `cache:` indicates that darcs can use this as a read-write"
      , String
"cache for patches, `read-only:` indicates a cache that is only"
      , String
"readable, and `repo:` denotes a (possibly remote) repository. The order"
      , String
"of the entries is immaterial: darcs will always try local paths before"
      , String
"remote ones, and only local ones will be used as potentially writable."
      , String
""
      , String
"A global cache is enabled by default in your home directory under"
      , String
"`.cache/darcs` (older versions of darcs used `.darcs/cache` for this),"
      , String
"or `$XDG_CACHE_HOME/darcs` if the environment variable is set, see"
      , String
"https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html."
      , String
"The cache allows darcs to avoid re-downloading patches (for example, when"
      , String
"doing a second darcs clone of the same repository), and also allows darcs"
      , String
"to use hard links to reduce disk usage."
      , String
""
      , String
"Note that the cache directory should reside on the same filesystem as"
      , String
"your repositories, so you may need to vary this. You can also use"
      , String
"multiple cache directories on different filesystems, if you have several"
      , String
"filesystems on which you use darcs."
      , String
""
      , String
"While darcs automatically adds entries to `_darcs/prefs/sources`, it does"
      , String
"not currently remove them. If one or more of the entries aren't accessible"
      , String
"(e.g. because they resided on a removable media), then darcs will bugger"
      , String
"you with a hint, suggesting you remove those entries. This is done because"
      , String
"certain systems have extremely long timeouts associated with some remotely"
      , String
"accessible media (e.g. NFS over automounter on Linux), which can slow down"
      , String
"darcs operations considerably. On the other hand, when you clone a repo"
      , String
"with --lazy from a no longer accessible location, then the hint may give"
      , String
"you an idea where the patches could be found, so you can try to restore"
      , String
"access to them."
      ])
    , (String
"tmpdir", [String] -> String
unlines
      [ String
"By default temporary directories are created in `/tmp`, or if that doesn't"
      , String
"exist, in `_darcs` (within the current repo).  This can be overridden by"
      , String
"specifying some other directory in the file `_darcs/prefs/tmpdir` or the"
      , String
"environment variable `$DARCS_TMPDIR` or `$TMPDIR`."])
    , (String
"prefs", [String] -> String
unlines
      [ String
"Contains the preferences set by the command `darcs setprefs`."
      , String
"Do not edit manually."])
    ]