{-# NOINLINE defaultBoring #-}
defaultBoring :: [String]
defaultBoring = ["# Boring file regexps:",
                  "",
                  "### 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",
                  "(^|/)"++darcsdir++"($|/)", "(^|/)\\.darcsrepo($|/)",
                  "^\\.darcs-temp-mail$",
                  "-darcs-backup[[:digit:]]+$",
                  "# 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$" ]

darcsdirFilter :: [FilePath] -> [FilePath]
darcsdirFilter = filter (not.isDarcsdir)
isDarcsdir :: FilePath -> Bool
isDarcsdir ('.':'/':f) = isDarcsdir f
isDarcsdir "." = True
isDarcsdir "" = True
isDarcsdir ".." = True
isDarcsdir "../" = True
isDarcsdir "_darcs" = True
isDarcsdir fp = "_darcs/" `isPrefixOf` fp

-- | The path of the global preference directory; @~/.darcs@ on Unix,
-- and @%APPDATA%/darcs@ on Windows.
globalPrefsDir :: IO (Maybe FilePath)
globalPrefsDir = do
  env <- getEnvironment
  case lookup "DARCS_TESTING_PREFS_DIR" env of
    Just d -> return (Just d)
    Nothing -> (getAppUserDataDirectory "darcs" >>= return.Just)
               `catchall` (return Nothing)

environmentHelpHome :: ([String], [String])
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 f = do
  dir <- globalPrefsDir
  case dir of
    (Just d) -> getPreffile $ d </> f
    Nothing -> return []

globalCacheDir :: IO (Maybe FilePath)
globalCacheDir = slash_cache `fmap` globalPrefsDir
  where slash_cache = fmap (</> "cache")

boringRegexps :: IO [Regex]
boringRegexps = do
    borefile <- defPrefval "boringfile" (darcsdir ++ "/prefs/boring")
    bores <- getPrefLines borefile `catchall` return []
    gbs <- getGlobal "boring"
    return $ map mkRegex $ bores ++ gbs

boringFileFilter :: IO ([FilePath] -> [FilePath])
boringFileFilter = boringRegexps >>= return . actualBoringFileFilter

noncomments :: [String] -> [String]
noncomments ss = filter is_ok ss
                 where is_ok "" = False
                       is_ok ('#':_) = False
                       is_ok _ = True

getPrefLines :: ReadableDirectory m => FilePath -> m [String]
getPrefLines f = (notconflicts . noncomments . map stripCr . lines)
              `fmap` mReadBinFile (fp2fn f)
    where notconflicts = filter nc
          startswith [] _ = True
          startswith (x:xs) (y:ys) | x == y = startswith xs ys
          startswith _ _ = False
          nc l | startswith "v v v v v v v" l = False
          nc l | startswith "*************" l = False
          nc l | startswith "^ ^ ^ ^ ^ ^ ^" l = False
          nc _ = True

-- | From a list of paths, filter out any that are within @_darcs@ or
-- match a boring regexp.
actualBoringFileFilter :: [Regex] -> [FilePath] -> [FilePath]
actualBoringFileFilter regexps files = filter (not . boring . normalize) files
    where boring file = isDarcsdir file ||
                        any (\regexp -> isJust $ matchRegex regexp file) regexps

normalize :: FilePath -> FilePath
normalize ('.':'/':f) = normalize f
normalize f = normalize_helper $ reverse f
              where
              normalize_helper ('/':rf) = normalize_helper rf
              normalize_helper rf = reverse rf

data FileType = BinaryFile | TextFile
                deriving (Eq)

{-# NOINLINE defaultBinaries #-}
-- | 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 = help ++
                   ["\\.(" ++ e ++ "|" ++ map toUpper e ++ ")$" | e <- extensions ]
    where 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"]
          help = map ("# "++) binariesFileHelp

binariesFileHelp :: [String]
binariesFileHelp =
  ["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 ~/.darcs/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 = do
    binsfile <- defPrefval "binariesfile" (darcsdir ++ "/prefs/binaries")
    bins <- getPrefLines binsfile `catch`
             (\e-> if isDoesNotExistError e then return [] else ioError e)
    gbs <- getGlobal "binaries"
    regexes <- return (map (\r -> mkRegex r) (bins ++ gbs))
    let isbin f = or $ map (\r -> isJust $ matchRegex r f) regexes
        ftf f = if isbin $ normalize f then BinaryFile else TextFile
        in
        return ftf

-- this avoids a circular dependency with Repository
prefsDirectory :: ReadableDirectory m => m String
prefsDirectory =
    do darcs <- mDoesDirectoryExist $ fp2fn darcsdir
       if darcs
          then return $ darcsdir ++ "/prefs/"
          else fail $ "Directory " ++ darcsdir ++ "/ does not exist!"

withPrefsDirectory :: ReadableDirectory m => (String -> m ()) -> m ()
withPrefsDirectory j = do prefs <- prefsDirectory `mplus` return "x"
                          when (prefs /= "x") $ j prefs

addToPreflist :: WriteableDirectory m => String -> String -> m ()
addToPreflist p s = withPrefsDirectory $ \prefs -> do
  hasprefs <- mDoesDirectoryExist $ fp2fn prefs
  unless hasprefs $ mCreateDirectory $ fp2fn prefs
  pl <- getPreflist p
  mWriteBinFile (fp2fn $ prefs ++ p) $ unlines $ union [s] pl

getPreflist :: ReadableDirectory m => String -> m [String]
getPreflist p =  do prefs <- prefsDirectory `mplus` return "x"
                    if (prefs /= "x") then getPreffile $ prefs ++ p
                                      else return []

getPreffile :: ReadableDirectory m => FilePath -> m [String]
getPreffile f = do
  hasprefs <- mDoesFileExist (fp2fn f)
  if hasprefs
    then getPrefLines f
    else return []

setPreflist :: WriteableDirectory m => String -> [String] -> m ()
setPreflist p ls = withPrefsDirectory $ \prefs -> do
  haspref <- mDoesDirectoryExist $ fp2fn prefs
  if haspref
     then mWriteBinFile (fp2fn $ prefs ++ p) (unlines ls)
     else return ()

defPrefval :: String -> String -> IO String
defPrefval p d = do
  pv <- getPrefval p
  case pv of Nothing -> return d
             Just v -> return v

getPrefval :: ReadableDirectory m => String -> m (Maybe String)
getPrefval p =
    do pl <- getPreflist "prefs"
       case map snd $ filter ((==p).fst) $ map (break (==' ')) pl of
           [val] -> case words val of
               [] -> return Nothing
               _ -> return $ Just $ tail val
           _ -> return Nothing

setPrefval :: WriteableDirectory m => String -> String -> m ()
setPrefval p v =  do pl <- getPreflist "prefs"
                     setPreflist "prefs" $
                       filter ((/=p).fst.(break (==' '))) pl ++ [p++" "++v]

changePrefval :: WriteableDirectory m => String -> String -> String -> m ()
changePrefval p f t =
    do pl <- getPreflist "prefs"
       ov <- getPrefval p
       newval <- case ov of
                 Nothing -> return t
                 Just old -> if old == f then return t else return old
       setPreflist "prefs" $
                    filter ((/=p).fst.(break(==' '))) pl ++ [p++" "++newval]

defaultrepo :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
defaultrepo opts _ [] =
  do let fixR r | not (isFile r) = return r
                | otherwise = do absr <- ioAbsolute r
                                 return $ toFilePath absr
     case [r | RemoteRepo r <- opts] of
       [] -> do defrepo <- getPreflist "defaultrepo"
                case defrepo of
                  [r] -> (:[]) `fmap` fixR r
                  _ -> return []
       rs -> mapM fixR rs
defaultrepo _ _ r = return r

setDefaultrepo :: String -> [DarcsFlag] -> IO ()
setDefaultrepo r opts =  do olddef <- getPreflist "defaultrepo"
                            let doit = null noSetDefault && greenLight
                                greenLight = wetRun
                                           && not rIsTmp
                                           && (olddef /= [r] || olddef == [])
                            if doit
                               then setPreflist "defaultrepo" [r]
                               else when (True `notElem` noSetDefault && greenLight) $ putStr . unlines $
                                      -- 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
                                      [ "HINT: if you want to change the default remote repository to"
                                      , "      " ++ r ++ ","
                                      , "      quit now and issue the same command with the --set-default flag."
                                      ]
                            addToPreflist "repos" r
                         `catchall` return () -- we don't care if this fails!
 where
  wetRun = DryRun `notElem` opts
  rIsTmp = r `elem` [x | RemoteRepo x <- opts]
  noSetDefault = [x | NoSetDefault x <- opts]

getCaches :: [DarcsFlag] -> String -> IO Cache
getCaches opts repodir =
    do here <- parsehs `fmap` getPreffile (darcsdir ++ "/prefs/sources")
       there <- (parsehs . lines . BC.unpack) `fmap`
                (gzFetchFilePS (repodir ++ "/" ++ darcsdir ++ "/prefs/sources") Cachable
                 `catchall` return B.empty)
       globalcachedir <- globalCacheDir
       let globalcache = case (nocache,globalcachedir) of
                           (True,_) -> []
                           (_,Just d) -> [Cache Directory Writable d]
                           _ -> []
       globalsources <- parsehs `fmap` getGlobal "sources"
       thisdir <- getCurrentDirectory
       let thisrepo = if Ephemeral `elem` opts
                      then [Cache Repo NotWritable $ toFilePath thisdir]
                      else [Cache Repo Writable $ toFilePath thisdir]
       let tempCache = nub $ thisrepo ++ globalcache ++ globalsources ++
                  here ++ [Cache Repo NotWritable repodir] ++ there
       return $ Ca $ sortBy compareByLocality tempCache
      where
            parsehs = catMaybes . map readln . noncomments
            readln l | take 5 l == "repo:" = Just (Cache Repo NotWritable (drop 5 l))
                     | take 9 l == "thisrepo:" = Just (Cache Repo Writable (drop 9 l))
                     | nocache = Nothing
                     | take 6 l == "cache:" = Just (Cache Directory Writable (drop 6 l))
                     | take 9 l == "readonly:" = Just (Cache Directory NotWritable (drop 9 l))
                     | otherwise = Nothing
            nocache = NoCache `elem` opts