{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, RankNTypes #-}
module Distribution.Client.VCS (
    -- * VCS driver type
    VCS,
    vcsRepoType,
    vcsProgram,
    -- ** Type re-exports
    RepoType,
    Program,
    ConfiguredProgram,

    -- * Validating 'SourceRepo's and configuring VCS drivers
    validatePDSourceRepo,
    validateSourceRepo,
    validateSourceRepos,
    SourceRepoProblem(..),
    configureVCS,
    configureVCSs,

    -- * Running the VCS driver
    cloneSourceRepo,
    syncSourceRepos,

    -- * The individual VCS drivers
    knownVCSs,
    vcsBzr,
    vcsDarcs,
    vcsGit,
    vcsHg,
    vcsSvn,
    vcsPijul,
  ) where

import Prelude ()
import Distribution.Client.Compat.Prelude

import Distribution.Types.SourceRepo
         ( RepoType(..), KnownRepoType (..) )
import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy)
import Distribution.Client.RebuildMonad
         ( Rebuild, monitorFiles, MonitorFilePath, monitorDirectoryExistence )
import Distribution.Verbosity as Verbosity
         ( normal )
import Distribution.Simple.Program
         ( Program(programFindVersion)
         , ConfiguredProgram(programVersion)
         , simpleProgram, findProgramVersion
         , ProgramInvocation(..), programInvocation, runProgramInvocation, getProgramInvocationOutput
         , emptyProgramDb, requireProgram )
import Distribution.Version
         ( mkVersion )
import qualified Distribution.PackageDescription as PD

import Control.Applicative
         ( liftA2 )
import Control.Exception
         ( throw, try )
import Control.Monad.Trans
         ( liftIO )
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map  as Map
import System.FilePath
         ( takeDirectory, (</>) )
import System.Directory
         ( doesDirectoryExist
         , removeDirectoryRecursive
         )
import System.IO.Error
         ( isDoesNotExistError )


-- | A driver for a version control system, e.g. git, darcs etc.
--
data VCS program = VCS {
       -- | The type of repository this driver is for.
       VCS program -> RepoType
vcsRepoType  :: RepoType,

       -- | The vcs program itself.
       -- This is used at type 'Program' and 'ConfiguredProgram'.
       VCS program -> program
vcsProgram   :: program,

       -- | The program invocation(s) to get\/clone a repository into a fresh
       -- local directory.
       VCS program
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> SourceRepositoryPackage f
   -> FilePath
   -> FilePath
   -> [ProgramInvocation]
vcsCloneRepo :: forall f. Verbosity
                    -> ConfiguredProgram
                    -> SourceRepositoryPackage f
                    -> FilePath   -- Source URI
                    -> FilePath   -- Destination directory
                    -> [ProgramInvocation],

       -- | The program invocation(s) to synchronise a whole set of /related/
       -- repositories with corresponding local directories. Also returns the
       -- files that the command depends on, for change monitoring.
       VCS program
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> [(SourceRepositoryPackage f, FilePath)]
   -> IO [MonitorFilePath]
vcsSyncRepos :: forall f. Verbosity
                    -> ConfiguredProgram
                    -> [(SourceRepositoryPackage f, FilePath)]
                    -> IO [MonitorFilePath]
     }


-- ------------------------------------------------------------
-- * Selecting repos and drivers
-- ------------------------------------------------------------

data SourceRepoProblem = SourceRepoRepoTypeUnspecified
                       | SourceRepoRepoTypeUnsupported (SourceRepositoryPackage Proxy) RepoType
                       | SourceRepoLocationUnspecified
  deriving Int -> SourceRepoProblem -> ShowS
[SourceRepoProblem] -> ShowS
SourceRepoProblem -> FilePath
(Int -> SourceRepoProblem -> ShowS)
-> (SourceRepoProblem -> FilePath)
-> ([SourceRepoProblem] -> ShowS)
-> Show SourceRepoProblem
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SourceRepoProblem] -> ShowS
$cshowList :: [SourceRepoProblem] -> ShowS
show :: SourceRepoProblem -> FilePath
$cshow :: SourceRepoProblem -> FilePath
showsPrec :: Int -> SourceRepoProblem -> ShowS
$cshowsPrec :: Int -> SourceRepoProblem -> ShowS
Show

-- | Validates that the 'SourceRepo' specifies a location URI and a repository
-- type that is supported by a VCS driver.
--
-- | It also returns the 'VCS' driver we should use to work with it.
--
validateSourceRepo
    :: SourceRepositoryPackage f
    -> Either SourceRepoProblem (SourceRepositoryPackage f, String, RepoType, VCS Program)
validateSourceRepo :: SourceRepositoryPackage f
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
validateSourceRepo = \SourceRepositoryPackage f
repo -> do
    let rtype :: RepoType
rtype = SourceRepositoryPackage f -> RepoType
forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpType SourceRepositoryPackage f
repo
    VCS Program
vcs   <- RepoType -> Map RepoType (VCS Program) -> Maybe (VCS Program)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RepoType
rtype Map RepoType (VCS Program)
knownVCSs  Maybe (VCS Program)
-> SourceRepoProblem -> Either SourceRepoProblem (VCS Program)
forall b a. Maybe b -> a -> Either a b
?! SourceRepositoryPackage Proxy -> RepoType -> SourceRepoProblem
SourceRepoRepoTypeUnsupported (SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
forall (f :: * -> *).
SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy SourceRepositoryPackage f
repo) RepoType
rtype
    let uri :: FilePath
uri = SourceRepositoryPackage f -> FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> FilePath
srpLocation SourceRepositoryPackage f
repo
    (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceRepositoryPackage f
repo, FilePath
uri, RepoType
rtype, VCS Program
vcs)
  where
    Maybe b
a ?! :: Maybe b -> a -> Either a b
?! a
e = Either a b -> (b -> Either a b) -> Maybe b -> Either a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a b
forall a b. a -> Either a b
Left a
e) b -> Either a b
forall a b. b -> Either a b
Right Maybe b
a

validatePDSourceRepo
    :: PD.SourceRepo
    -> Either SourceRepoProblem (SourceRepoMaybe, String, RepoType, VCS Program)
validatePDSourceRepo :: SourceRepo
-> Either
     SourceRepoProblem
     (SourceRepoMaybe, FilePath, RepoType, VCS Program)
validatePDSourceRepo SourceRepo
repo = do
    RepoType
rtype <- SourceRepo -> Maybe RepoType
PD.repoType SourceRepo
repo      Maybe RepoType
-> SourceRepoProblem -> Either SourceRepoProblem RepoType
forall b a. Maybe b -> a -> Either a b
?! SourceRepoProblem
SourceRepoRepoTypeUnspecified
    FilePath
uri   <- SourceRepo -> Maybe FilePath
PD.repoLocation SourceRepo
repo  Maybe FilePath
-> SourceRepoProblem -> Either SourceRepoProblem FilePath
forall b a. Maybe b -> a -> Either a b
?! SourceRepoProblem
SourceRepoLocationUnspecified
    SourceRepoMaybe
-> Either
     SourceRepoProblem
     (SourceRepoMaybe, FilePath, RepoType, VCS Program)
forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
validateSourceRepo SourceRepositoryPackage :: forall (f :: * -> *).
RepoType
-> FilePath
-> Maybe FilePath
-> Maybe FilePath
-> f FilePath
-> [FilePath]
-> SourceRepositoryPackage f
SourceRepositoryPackage
        { srpType :: RepoType
srpType     = RepoType
rtype
        , srpLocation :: FilePath
srpLocation = FilePath
uri
        , srpTag :: Maybe FilePath
srpTag      = SourceRepo -> Maybe FilePath
PD.repoTag SourceRepo
repo
        , srpBranch :: Maybe FilePath
srpBranch   = SourceRepo -> Maybe FilePath
PD.repoBranch SourceRepo
repo
        , srpSubdir :: Maybe FilePath
srpSubdir   = SourceRepo -> Maybe FilePath
PD.repoSubdir SourceRepo
repo
        , srpCommand :: [FilePath]
srpCommand  = [FilePath]
forall a. Monoid a => a
mempty
        }
  where
    Maybe b
a ?! :: Maybe b -> a -> Either a b
?! a
e = Either a b -> (b -> Either a b) -> Maybe b -> Either a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a b
forall a b. a -> Either a b
Left a
e) b -> Either a b
forall a b. b -> Either a b
Right Maybe b
a



-- | As 'validateSourceRepo' but for a bunch of 'SourceRepo's, and return
-- things in a convenient form to pass to 'configureVCSs', or to report
-- problems.
--
validateSourceRepos :: [SourceRepositoryPackage f]
                    -> Either [(SourceRepositoryPackage f, SourceRepoProblem)]
                              [(SourceRepositoryPackage f, String, RepoType, VCS Program)]
validateSourceRepos :: [SourceRepositoryPackage f]
-> Either
     [(SourceRepositoryPackage f, SourceRepoProblem)]
     [(SourceRepositoryPackage f, FilePath, RepoType, VCS Program)]
validateSourceRepos [SourceRepositoryPackage f]
rs =
    case [Either
   (SourceRepositoryPackage f, SourceRepoProblem)
   (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)]
-> ([(SourceRepositoryPackage f, SourceRepoProblem)],
    [(SourceRepositoryPackage f, FilePath, RepoType, VCS Program)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((SourceRepositoryPackage f
 -> Either
      (SourceRepositoryPackage f, SourceRepoProblem)
      (SourceRepositoryPackage f, FilePath, RepoType, VCS Program))
-> [SourceRepositoryPackage f]
-> [Either
      (SourceRepositoryPackage f, SourceRepoProblem)
      (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)]
forall a b. (a -> b) -> [a] -> [b]
map SourceRepositoryPackage f
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
validateSourceRepo' [SourceRepositoryPackage f]
rs) of
      (problems :: [(SourceRepositoryPackage f, SourceRepoProblem)]
problems@((SourceRepositoryPackage f, SourceRepoProblem)
_:[(SourceRepositoryPackage f, SourceRepoProblem)]
_), [(SourceRepositoryPackage f, FilePath, RepoType, VCS Program)]
_) -> [(SourceRepositoryPackage f, SourceRepoProblem)]
-> Either
     [(SourceRepositoryPackage f, SourceRepoProblem)]
     [(SourceRepositoryPackage f, FilePath, RepoType, VCS Program)]
forall a b. a -> Either a b
Left [(SourceRepositoryPackage f, SourceRepoProblem)]
problems
      ([], [(SourceRepositoryPackage f, FilePath, RepoType, VCS Program)]
vcss)          -> [(SourceRepositoryPackage f, FilePath, RepoType, VCS Program)]
-> Either
     [(SourceRepositoryPackage f, SourceRepoProblem)]
     [(SourceRepositoryPackage f, FilePath, RepoType, VCS Program)]
forall a b. b -> Either a b
Right [(SourceRepositoryPackage f, FilePath, RepoType, VCS Program)]
vcss
  where
    validateSourceRepo'   :: SourceRepositoryPackage f
                          -> Either (SourceRepositoryPackage f, SourceRepoProblem)
                                    (SourceRepositoryPackage f, String, RepoType, VCS Program)
    validateSourceRepo' :: SourceRepositoryPackage f
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
validateSourceRepo' SourceRepositoryPackage f
r = (SourceRepoProblem
 -> Either
      (SourceRepositoryPackage f, SourceRepoProblem)
      (SourceRepositoryPackage f, FilePath, RepoType, VCS Program))
-> ((SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
    -> Either
         (SourceRepositoryPackage f, SourceRepoProblem)
         (SourceRepositoryPackage f, FilePath, RepoType, VCS Program))
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((SourceRepositoryPackage f, SourceRepoProblem)
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
forall a b. a -> Either a b
Left ((SourceRepositoryPackage f, SourceRepoProblem)
 -> Either
      (SourceRepositoryPackage f, SourceRepoProblem)
      (SourceRepositoryPackage f, FilePath, RepoType, VCS Program))
-> (SourceRepoProblem
    -> (SourceRepositoryPackage f, SourceRepoProblem))
-> SourceRepoProblem
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) SourceRepositoryPackage f
r) (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
forall a b. b -> Either a b
Right
                                   (SourceRepositoryPackage f
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, FilePath, RepoType, VCS Program)
validateSourceRepo SourceRepositoryPackage f
r)


configureVCS :: Verbosity
             -> VCS Program
             -> IO (VCS ConfiguredProgram)
configureVCS :: Verbosity -> VCS Program -> IO (VCS ConfiguredProgram)
configureVCS Verbosity
verbosity vcs :: VCS Program
vcs@VCS{vcsProgram :: forall program. VCS program -> program
vcsProgram = Program
prog} =
    (ConfiguredProgram, ProgramDb) -> VCS ConfiguredProgram
forall program b. (program, b) -> VCS program
asVcsConfigured ((ConfiguredProgram, ProgramDb) -> VCS ConfiguredProgram)
-> IO (ConfiguredProgram, ProgramDb) -> IO (VCS ConfiguredProgram)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
prog ProgramDb
emptyProgramDb
  where
    asVcsConfigured :: (program, b) -> VCS program
asVcsConfigured (program
prog', b
_) = VCS Program
vcs { vcsProgram :: program
vcsProgram = program
prog' }

configureVCSs :: Verbosity
              -> Map RepoType (VCS Program)
              -> IO (Map RepoType (VCS ConfiguredProgram))
configureVCSs :: Verbosity
-> Map RepoType (VCS Program)
-> IO (Map RepoType (VCS ConfiguredProgram))
configureVCSs Verbosity
verbosity = (VCS Program -> IO (VCS ConfiguredProgram))
-> Map RepoType (VCS Program)
-> IO (Map RepoType (VCS ConfiguredProgram))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Verbosity -> VCS Program -> IO (VCS ConfiguredProgram)
configureVCS Verbosity
verbosity)


-- ------------------------------------------------------------
-- * Running the driver
-- ------------------------------------------------------------

-- | Clone a single source repo into a fresh directory, using a configured VCS.
--
-- This is for making a new copy, not synchronising an existing copy. It will
-- fail if the destination directory already exists.
--
-- Make sure to validate the 'SourceRepo' using 'validateSourceRepo' first.
--

cloneSourceRepo
    :: Verbosity
    -> VCS ConfiguredProgram
    -> SourceRepositoryPackage f
    -> [Char]
    -> IO ()
cloneSourceRepo :: Verbosity
-> VCS ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> IO ()
cloneSourceRepo Verbosity
verbosity VCS ConfiguredProgram
vcs
                repo :: SourceRepositoryPackage f
repo@SourceRepositoryPackage{ srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> FilePath
srpLocation = FilePath
srcuri } FilePath
destdir =
    (ProgramInvocation -> IO ()) -> [ProgramInvocation] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity) [ProgramInvocation]
invocations
  where
    invocations :: [ProgramInvocation]
invocations = VCS ConfiguredProgram
-> Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
forall program.
VCS program
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> SourceRepositoryPackage f
   -> FilePath
   -> FilePath
   -> [ProgramInvocation]
vcsCloneRepo VCS ConfiguredProgram
vcs Verbosity
verbosity
                               (VCS ConfiguredProgram -> ConfiguredProgram
forall program. VCS program -> program
vcsProgram VCS ConfiguredProgram
vcs) SourceRepositoryPackage f
repo
                               FilePath
srcuri FilePath
destdir


-- | Syncronise a set of 'SourceRepo's referring to the same repository with
-- corresponding local directories. The local directories may or may not
-- already exist.
--
-- The 'SourceRepo' values used in a single invocation of 'syncSourceRepos',
-- or used across a series of invocations with any local directory must refer
-- to the /same/ repository. That means it must be the same location but they
-- can differ in the branch, or tag or subdir.
--
-- The reason to allow multiple related 'SourceRepo's is to allow for the
-- network or storage to be shared between different checkouts of the repo.
-- For example if a single repo contains multiple packages in different subdirs
-- and in some project it may make sense to use a different state of the repo
-- for one subdir compared to another.
--
syncSourceRepos :: Verbosity
                -> VCS ConfiguredProgram
                -> [(SourceRepositoryPackage f, FilePath)]
                -> Rebuild ()
syncSourceRepos :: Verbosity
-> VCS ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> Rebuild ()
syncSourceRepos Verbosity
verbosity VCS ConfiguredProgram
vcs [(SourceRepositoryPackage f, FilePath)]
repos = do
    [MonitorFilePath]
files <- IO [MonitorFilePath] -> Rebuild [MonitorFilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [MonitorFilePath] -> Rebuild [MonitorFilePath])
-> IO [MonitorFilePath] -> Rebuild [MonitorFilePath]
forall a b. (a -> b) -> a -> b
$ VCS ConfiguredProgram
-> Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
forall program.
VCS program
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> [(SourceRepositoryPackage f, FilePath)]
   -> IO [MonitorFilePath]
vcsSyncRepos VCS ConfiguredProgram
vcs Verbosity
verbosity (VCS ConfiguredProgram -> ConfiguredProgram
forall program. VCS program -> program
vcsProgram VCS ConfiguredProgram
vcs) [(SourceRepositoryPackage f, FilePath)]
repos
    [MonitorFilePath] -> Rebuild ()
monitorFiles [MonitorFilePath]
files


-- ------------------------------------------------------------
-- * The various VCS drivers
-- ------------------------------------------------------------

-- | The set of all supported VCS drivers, organised by 'RepoType'.
--
knownVCSs :: Map RepoType (VCS Program)
knownVCSs :: Map RepoType (VCS Program)
knownVCSs = [(RepoType, VCS Program)] -> Map RepoType (VCS Program)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (VCS Program -> RepoType
forall program. VCS program -> RepoType
vcsRepoType VCS Program
vcs, VCS Program
vcs) | VCS Program
vcs <- [VCS Program]
vcss ]
  where
    vcss :: [VCS Program]
vcss = [ VCS Program
vcsBzr, VCS Program
vcsDarcs, VCS Program
vcsGit, VCS Program
vcsHg, VCS Program
vcsSvn ]


-- | VCS driver for Bazaar.
--
vcsBzr :: VCS Program
vcsBzr :: VCS Program
vcsBzr =
    VCS :: forall program.
RepoType
-> program
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> SourceRepositoryPackage f
    -> FilePath
    -> FilePath
    -> [ProgramInvocation])
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> [(SourceRepositoryPackage f, FilePath)]
    -> IO [MonitorFilePath])
-> VCS program
VCS {
      vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Bazaar,
      vcsProgram :: Program
vcsProgram  = Program
bzrProgram,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos
    }
  where
    vcsCloneRepo :: Verbosity
                 -> ConfiguredProgram
                 -> SourceRepositoryPackage f
                 -> FilePath
                 -> FilePath
                 -> [ProgramInvocation]
    vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo FilePath
srcuri FilePath
destdir =
        [ ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog
            ([FilePath
branchCmd, FilePath
srcuri, FilePath
destdir] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
tagArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg) ]
      where
        -- The @get@ command was deprecated in version 2.4 in favour of
        -- the alias @branch@
        branchCmd :: FilePath
branchCmd | ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
prog Maybe Version -> Maybe Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
mkVersion [Int
2,Int
4])
                              = FilePath
"branch"
                  | Bool
otherwise = FilePath
"get"

        tagArgs :: [String]
        tagArgs :: [FilePath]
tagArgs = case SourceRepositoryPackage f -> Maybe FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag SourceRepositoryPackage f
repo of
          Maybe FilePath
Nothing  -> []
          Just FilePath
tag -> [FilePath
"-r", FilePath
"tag:" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
tag]
        verboseArg :: [String]
        verboseArg :: [FilePath]
verboseArg = [ FilePath
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]

    vcsSyncRepos :: Verbosity -> ConfiguredProgram
                 -> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath]
    vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_v ConfiguredProgram
_p [(SourceRepositoryPackage f, FilePath)]
_rs = FilePath -> IO [MonitorFilePath]
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"sync repo not yet supported for bzr"

bzrProgram :: Program
bzrProgram :: Program
bzrProgram = (FilePath -> Program
simpleProgram FilePath
"bzr") {
    programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
programFindVersion = FilePath -> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
findProgramVersion FilePath
"--version" (ShowS -> Verbosity -> FilePath -> IO (Maybe Version))
-> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \FilePath
str ->
      case FilePath -> [FilePath]
words FilePath
str of
        -- "Bazaar (bzr) 2.6.0\n  ... lots of extra stuff"
        (FilePath
_:FilePath
_:FilePath
ver:[FilePath]
_) -> FilePath
ver
        [FilePath]
_ -> FilePath
""
  }


-- | VCS driver for Darcs.
--
vcsDarcs :: VCS Program
vcsDarcs :: VCS Program
vcsDarcs =
    VCS :: forall program.
RepoType
-> program
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> SourceRepositoryPackage f
    -> FilePath
    -> FilePath
    -> [ProgramInvocation])
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> [(SourceRepositoryPackage f, FilePath)]
    -> IO [MonitorFilePath])
-> VCS program
VCS {
      vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Darcs,
      vcsProgram :: Program
vcsProgram  = Program
darcsProgram,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos
    }
  where
    vcsCloneRepo :: Verbosity
                 -> ConfiguredProgram
                 -> SourceRepositoryPackage f
                 -> FilePath
                 -> FilePath
                 -> [ProgramInvocation]
    vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo FilePath
srcuri FilePath
destdir =
        [ ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [FilePath]
cloneArgs ]
      where
        cloneArgs :: [String]
        cloneArgs :: [FilePath]
cloneArgs  = [FilePath
cloneCmd, FilePath
srcuri, FilePath
destdir] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
tagArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg
        -- At some point the @clone@ command was introduced as an alias for
        -- @get@, and @clone@ seems to be the recommended one now.
        cloneCmd :: String
        cloneCmd :: FilePath
cloneCmd   | ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
prog Maybe Version -> Maybe Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
mkVersion [Int
2,Int
8])
                               = FilePath
"clone"
                   | Bool
otherwise = FilePath
"get"
        tagArgs :: [String]
        tagArgs :: [FilePath]
tagArgs    = case SourceRepositoryPackage f -> Maybe FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag SourceRepositoryPackage f
repo of
          Maybe FilePath
Nothing  -> []
          Just FilePath
tag -> [FilePath
"-t", FilePath
tag]
        verboseArg :: [String]
        verboseArg :: [FilePath]
verboseArg = [ FilePath
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]

    vcsSyncRepos :: Verbosity -> ConfiguredProgram
                 -> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath]
    vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = [MonitorFilePath] -> IO [MonitorFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    vcsSyncRepos Verbosity
verbosity ConfiguredProgram
prog ((SourceRepositoryPackage f
primaryRepo, FilePath
primaryLocalDir) : [(SourceRepositoryPackage f, FilePath)]
secondaryRepos) =
        [MonitorFilePath]
monitors [MonitorFilePath] -> IO () -> IO [MonitorFilePath]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
        Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe Any
-> IO ()
forall (f :: * -> *) p.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> p
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
primaryRepo FilePath
primaryLocalDir Maybe Any
forall a. Maybe a
Nothing
        [(SourceRepositoryPackage f, FilePath)]
-> ((SourceRepositoryPackage f, FilePath) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(SourceRepositoryPackage f, FilePath)]
secondaryRepos (((SourceRepositoryPackage f, FilePath) -> IO ()) -> IO ())
-> ((SourceRepositoryPackage f, FilePath) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ (SourceRepositoryPackage f
repo, FilePath
localDir) ->
          Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
forall (f :: * -> *) p.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> p
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo FilePath
localDir (Maybe FilePath -> IO ()) -> Maybe FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
primaryLocalDir
      where
        dirs :: [FilePath]
        dirs :: [FilePath]
dirs = FilePath
primaryLocalDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ((SourceRepositoryPackage f, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((SourceRepositoryPackage f, FilePath) -> FilePath)
-> [(SourceRepositoryPackage f, FilePath)] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceRepositoryPackage f, FilePath)]
secondaryRepos)
        monitors :: [MonitorFilePath]
        monitors :: [MonitorFilePath]
monitors = FilePath -> MonitorFilePath
monitorDirectoryExistence (FilePath -> MonitorFilePath) -> [FilePath] -> [MonitorFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
dirs

    vcsSyncRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> p
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage{f FilePath
FilePath
[FilePath]
Maybe FilePath
RepoType
srpCommand :: [FilePath]
srpSubdir :: f FilePath
srpBranch :: Maybe FilePath
srpTag :: Maybe FilePath
srpLocation :: FilePath
srpType :: RepoType
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [FilePath]
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f FilePath
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> FilePath
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
..} FilePath
localDir p
_peer =
      IO [FilePath] -> IO (Either IOError [FilePath])
forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO FilePath
darcsWithOutput FilePath
localDir [FilePath
"log", FilePath
"--last", FilePath
"1"]) IO (Either IOError [FilePath])
-> (Either IOError [FilePath] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
        Right (FilePath
_:FilePath
_:FilePath
_:FilePath
x:[FilePath]
_)
          | Just FilePath
tag <- (FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix FilePath
"tagged " (FilePath -> Maybe FilePath) -> ShowS -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhile Char -> Bool
Char.isSpace) FilePath
x
          , Just FilePath
tag' <- Maybe FilePath
srpTag
          , FilePath
tag FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
tag' -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Left IOError
e | Bool -> Bool
not (IOError -> Bool
isDoesNotExistError IOError
e) -> IOError -> IO ()
forall a e. Exception e => e -> a
throw IOError
e
        Either IOError [FilePath]
_ -> do
          FilePath -> IO ()
removeDirectoryRecursive FilePath
localDir IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (Bool -> IO () -> IO ())
-> (IOError -> Bool) -> (IOError -> IO ()) -> IOError -> IO ()
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless IOError -> Bool
isDoesNotExistError IOError -> IO ()
forall a e. Exception e => e -> a
throw
          FilePath -> [FilePath] -> IO ()
darcs (ShowS
takeDirectory FilePath
localDir) [FilePath]
cloneArgs
      where
        darcs :: FilePath -> [String] -> IO ()
        darcs :: FilePath -> [FilePath] -> IO ()
darcs = (Verbosity -> ProgramInvocation -> IO ())
-> FilePath -> [FilePath] -> IO ()
forall t.
(Verbosity -> ProgramInvocation -> t)
-> FilePath -> [FilePath] -> t
darcs' Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation

        darcsWithOutput :: FilePath -> [String] -> IO String
        darcsWithOutput :: FilePath -> [FilePath] -> IO FilePath
darcsWithOutput = (Verbosity -> ProgramInvocation -> IO FilePath)
-> FilePath -> [FilePath] -> IO FilePath
forall t.
(Verbosity -> ProgramInvocation -> t)
-> FilePath -> [FilePath] -> t
darcs' Verbosity -> ProgramInvocation -> IO FilePath
getProgramInvocationOutput

        darcs' :: (Verbosity -> ProgramInvocation -> t) -> FilePath -> [String] -> t
        darcs' :: (Verbosity -> ProgramInvocation -> t)
-> FilePath -> [FilePath] -> t
darcs' Verbosity -> ProgramInvocation -> t
f FilePath
cwd [FilePath]
args = Verbosity -> ProgramInvocation -> t
f Verbosity
verbosity (ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [FilePath]
args)
          { progInvokeCwd :: Maybe FilePath
progInvokeCwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
cwd }

        cloneArgs :: [String]
        cloneArgs :: [FilePath]
cloneArgs = [FilePath
"clone"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
tagArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
srpLocation, FilePath
localDir] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg
        tagArgs :: [String]
        tagArgs :: [FilePath]
tagArgs    = case Maybe FilePath
srpTag of
          Maybe FilePath
Nothing  -> []
          Just FilePath
tag -> [FilePath
"-t" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
tag]
        verboseArg :: [String]
        verboseArg :: [FilePath]
verboseArg = [ FilePath
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]

darcsProgram :: Program
darcsProgram :: Program
darcsProgram = (FilePath -> Program
simpleProgram FilePath
"darcs") {
    programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
programFindVersion = FilePath -> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
findProgramVersion FilePath
"--version" (ShowS -> Verbosity -> FilePath -> IO (Maybe Version))
-> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \FilePath
str ->
      case FilePath -> [FilePath]
words FilePath
str of
        -- "2.8.5 (release)"
        (FilePath
ver:[FilePath]
_) -> FilePath
ver
        [FilePath]
_ -> FilePath
""
  }


-- | VCS driver for Git.
--
vcsGit :: VCS Program
vcsGit :: VCS Program
vcsGit =
    VCS :: forall program.
RepoType
-> program
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> SourceRepositoryPackage f
    -> FilePath
    -> FilePath
    -> [ProgramInvocation])
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> [(SourceRepositoryPackage f, FilePath)]
    -> IO [MonitorFilePath])
-> VCS program
VCS {
      vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Git,
      vcsProgram :: Program
vcsProgram  = Program
gitProgram,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos
    }
  where
    vcsCloneRepo :: Verbosity
                 -> ConfiguredProgram
                 -> SourceRepositoryPackage f
                 -> FilePath
                 -> FilePath
                 -> [ProgramInvocation]
    vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo FilePath
srcuri FilePath
destdir =
        [ ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [FilePath]
cloneArgs ]
        -- And if there's a tag, we have to do that in a second step:
     [ProgramInvocation] -> [ProgramInvocation] -> [ProgramInvocation]
forall a. [a] -> [a] -> [a]
++ [ [FilePath] -> ProgramInvocation
git (FilePath -> [FilePath]
resetArgs FilePath
tag) | FilePath
tag <- Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList (SourceRepositoryPackage f -> Maybe FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag SourceRepositoryPackage f
repo) ]
     [ProgramInvocation] -> [ProgramInvocation] -> [ProgramInvocation]
forall a. [a] -> [a] -> [a]
++ [ [FilePath] -> ProgramInvocation
git ([FilePath
"submodule", FilePath
"sync", FilePath
"--recursive"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg)
        , [FilePath] -> ProgramInvocation
git ([FilePath
"submodule", FilePath
"update", FilePath
"--init", FilePath
"--force", FilePath
"--recursive"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg)
        ]
      where
        git :: [FilePath] -> ProgramInvocation
git [FilePath]
args   = (ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [FilePath]
args) {progInvokeCwd :: Maybe FilePath
progInvokeCwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
destdir}
        cloneArgs :: [FilePath]
cloneArgs  = [FilePath
"clone", FilePath
srcuri, FilePath
destdir]
                     [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
branchArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg
        branchArgs :: [FilePath]
branchArgs = case SourceRepositoryPackage f -> Maybe FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpBranch SourceRepositoryPackage f
repo of
          Just FilePath
b  -> [FilePath
"--branch", FilePath
b]
          Maybe FilePath
Nothing -> []
        resetArgs :: FilePath -> [FilePath]
resetArgs FilePath
tag = FilePath
"reset" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
verboseArg [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--hard", FilePath
tag, FilePath
"--"]
        verboseArg :: [FilePath]
verboseArg = [ FilePath
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]

    vcsSyncRepos :: Verbosity
                 -> ConfiguredProgram
                 -> [(SourceRepositoryPackage f, FilePath)]
                 -> IO [MonitorFilePath]
    vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = [MonitorFilePath] -> IO [MonitorFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    vcsSyncRepos Verbosity
verbosity ConfiguredProgram
gitProg
                 ((SourceRepositoryPackage f
primaryRepo, FilePath
primaryLocalDir) : [(SourceRepositoryPackage f, FilePath)]
secondaryRepos) = do

      Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
gitProg SourceRepositoryPackage f
primaryRepo FilePath
primaryLocalDir Maybe FilePath
forall a. Maybe a
Nothing
      [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
        [ Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
gitProg SourceRepositoryPackage f
repo FilePath
localDir (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
primaryLocalDir)
        | (SourceRepositoryPackage f
repo, FilePath
localDir) <- [(SourceRepositoryPackage f, FilePath)]
secondaryRepos ]
      [MonitorFilePath] -> IO [MonitorFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [ FilePath -> MonitorFilePath
monitorDirectoryExistence FilePath
dir
             | FilePath
dir <- (FilePath
primaryLocalDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ((SourceRepositoryPackage f, FilePath) -> FilePath)
-> [(SourceRepositoryPackage f, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (SourceRepositoryPackage f, FilePath) -> FilePath
forall a b. (a, b) -> b
snd [(SourceRepositoryPackage f, FilePath)]
secondaryRepos) ]

    vcsSyncRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
gitProg SourceRepositoryPackage{f FilePath
FilePath
[FilePath]
Maybe FilePath
RepoType
srpCommand :: [FilePath]
srpSubdir :: f FilePath
srpBranch :: Maybe FilePath
srpTag :: Maybe FilePath
srpLocation :: FilePath
srpType :: RepoType
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [FilePath]
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f FilePath
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> FilePath
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
..} FilePath
localDir Maybe FilePath
peer = do
        Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
localDir
        if Bool
exists
          then FilePath -> [FilePath] -> IO ()
git FilePath
localDir                 [FilePath
"fetch"]
          else FilePath -> [FilePath] -> IO ()
git (ShowS
takeDirectory FilePath
localDir) [FilePath]
cloneArgs
        -- Before trying to checkout other commits, all submodules must be
        -- de-initialised and the .git/modules directory must be deleted. This
        -- is needed because sometimes `git submodule sync` does not actually
        -- update the submodule source URL. Detailed description here:
        -- https://git.coop/-/snippets/85
        FilePath -> [FilePath] -> IO ()
git FilePath
localDir [FilePath
"submodule", FilePath
"deinit", FilePath
"--force", FilePath
"--all"]
        let gitModulesDir :: FilePath
gitModulesDir = FilePath
localDir FilePath -> ShowS
</> FilePath
".git" FilePath -> ShowS
</> FilePath
"modules"
        Bool
gitModulesExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
gitModulesDir
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
gitModulesExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
gitModulesDir
        FilePath -> [FilePath] -> IO ()
git FilePath
localDir [FilePath]
resetArgs
        FilePath -> [FilePath] -> IO ()
git FilePath
localDir ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath
"submodule", FilePath
"sync", FilePath
"--recursive"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg
        FilePath -> [FilePath] -> IO ()
git FilePath
localDir ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath
"submodule", FilePath
"update", FilePath
"--force", FilePath
"--init", FilePath
"--recursive"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg
        FilePath -> [FilePath] -> IO ()
git FilePath
localDir ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath
"submodule", FilePath
"foreach", FilePath
"--recursive"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"git clean -ffxdq"]
        FilePath -> [FilePath] -> IO ()
git FilePath
localDir ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath
"clean", FilePath
"-ffxdq"]
      where
        git :: FilePath -> [String] -> IO ()
        git :: FilePath -> [FilePath] -> IO ()
git FilePath
cwd [FilePath]
args = Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
forall a b. (a -> b) -> a -> b
$
                         (ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
gitProg [FilePath]
args) {
                           progInvokeCwd :: Maybe FilePath
progInvokeCwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
cwd
                         }

        cloneArgs :: [FilePath]
cloneArgs   = [FilePath
"clone", FilePath
"--no-checkout", FilePath
loc, FilePath
localDir]
                   [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ case Maybe FilePath
peer of
                        Maybe FilePath
Nothing           -> []
                        Just peerLocalDir -> [FilePath
"--reference", FilePath
peerLocalDir]
                   [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg
                      where loc :: FilePath
loc = FilePath
srpLocation
        resetArgs :: [FilePath]
resetArgs   = FilePath
"reset" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
verboseArg [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--hard", FilePath
resetTarget, FilePath
"--" ]
        resetTarget :: FilePath
resetTarget = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"HEAD" (Maybe FilePath
srpBranch Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe FilePath
srpTag)
        verboseArg :: [FilePath]
verboseArg  = [ FilePath
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]

gitProgram :: Program
gitProgram :: Program
gitProgram = (FilePath -> Program
simpleProgram FilePath
"git") {
    programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
programFindVersion = FilePath -> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
findProgramVersion FilePath
"--version" (ShowS -> Verbosity -> FilePath -> IO (Maybe Version))
-> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \FilePath
str ->
      case FilePath -> [FilePath]
words FilePath
str of
        -- "git version 2.5.5"
        (FilePath
_:FilePath
_:FilePath
ver:[FilePath]
_) | (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isTypical FilePath
ver -> FilePath
ver

        -- or annoyingly "git version 2.17.1.windows.2" yes, really
        (FilePath
_:FilePath
_:FilePath
ver:[FilePath]
_) -> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"."
                     ([FilePath] -> FilePath) -> (FilePath -> [FilePath]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isNum)
                     ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
split
                     ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath
ver
        [FilePath]
_ -> FilePath
""
  }
  where
    isNum :: Char -> Bool
isNum     Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
    isTypical :: Char -> Bool
isTypical Char
c = Char -> Bool
isNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
    split :: FilePath -> [FilePath]
split    FilePath
cs = case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') FilePath
cs of
                    (FilePath
chunk,[])     -> FilePath
chunk FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: []
                    (FilePath
chunk,Char
_:FilePath
rest) -> FilePath
chunk FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split FilePath
rest

-- | VCS driver for Mercurial.
--
vcsHg :: VCS Program
vcsHg :: VCS Program
vcsHg =
    VCS :: forall program.
RepoType
-> program
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> SourceRepositoryPackage f
    -> FilePath
    -> FilePath
    -> [ProgramInvocation])
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> [(SourceRepositoryPackage f, FilePath)]
    -> IO [MonitorFilePath])
-> VCS program
VCS {
      vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Mercurial,
      vcsProgram :: Program
vcsProgram  = Program
hgProgram,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos
    }
  where
    vcsCloneRepo :: Verbosity
                 -> ConfiguredProgram
                 -> SourceRepositoryPackage f
                 -> FilePath
                 -> FilePath
                 -> [ProgramInvocation]
    vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo FilePath
srcuri FilePath
destdir =
        [ ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [FilePath]
cloneArgs ]
      where
        cloneArgs :: [FilePath]
cloneArgs  = [FilePath
"clone", FilePath
srcuri, FilePath
destdir]
                     [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
branchArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
tagArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg
        branchArgs :: [FilePath]
branchArgs = case SourceRepositoryPackage f -> Maybe FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpBranch SourceRepositoryPackage f
repo of
          Just FilePath
b  -> [FilePath
"--branch", FilePath
b]
          Maybe FilePath
Nothing -> []
        tagArgs :: [FilePath]
tagArgs = case SourceRepositoryPackage f -> Maybe FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag SourceRepositoryPackage f
repo of
          Just FilePath
t  -> [FilePath
"--rev", FilePath
t]
          Maybe FilePath
Nothing -> []
        verboseArg :: [FilePath]
verboseArg = [ FilePath
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]

    vcsSyncRepos :: Verbosity
                 -> ConfiguredProgram
                 -> [(SourceRepositoryPackage f, FilePath)]
                 -> IO [MonitorFilePath]
    vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = [MonitorFilePath] -> IO [MonitorFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    vcsSyncRepos Verbosity
verbosity ConfiguredProgram
hgProg
                 ((SourceRepositoryPackage f
primaryRepo, FilePath
primaryLocalDir) : [(SourceRepositoryPackage f, FilePath)]
secondaryRepos) = do
      Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> IO ()
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
hgProg SourceRepositoryPackage f
primaryRepo FilePath
primaryLocalDir
      [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
        [ Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> IO ()
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
hgProg SourceRepositoryPackage f
repo FilePath
localDir
        | (SourceRepositoryPackage f
repo, FilePath
localDir) <- [(SourceRepositoryPackage f, FilePath)]
secondaryRepos ]
      [MonitorFilePath] -> IO [MonitorFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [ FilePath -> MonitorFilePath
monitorDirectoryExistence FilePath
dir
            | FilePath
dir <- (FilePath
primaryLocalDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ((SourceRepositoryPackage f, FilePath) -> FilePath)
-> [(SourceRepositoryPackage f, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (SourceRepositoryPackage f, FilePath) -> FilePath
forall a b. (a, b) -> b
snd [(SourceRepositoryPackage f, FilePath)]
secondaryRepos) ]
    vcsSyncRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
hgProg SourceRepositoryPackage f
repo FilePath
localDir = do
        Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
localDir
        if Bool
exists
          then FilePath -> [FilePath] -> IO ()
hg FilePath
localDir [FilePath
"pull"]
          else FilePath -> [FilePath] -> IO ()
hg (ShowS
takeDirectory FilePath
localDir) [FilePath]
cloneArgs
        FilePath -> [FilePath] -> IO ()
hg FilePath
localDir [FilePath]
checkoutArgs
      where
        hg :: FilePath -> [String] -> IO ()
        hg :: FilePath -> [FilePath] -> IO ()
hg FilePath
cwd [FilePath]
args = Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
forall a b. (a -> b) -> a -> b
$
                          (ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
hgProg [FilePath]
args) {
                            progInvokeCwd :: Maybe FilePath
progInvokeCwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
cwd
                          }
        cloneArgs :: [FilePath]
cloneArgs      = [FilePath
"clone", FilePath
"--noupdate", (SourceRepositoryPackage f -> FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> FilePath
srpLocation SourceRepositoryPackage f
repo), FilePath
localDir]
                        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg
        verboseArg :: [FilePath]
verboseArg = [ FilePath
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
        checkoutArgs :: [FilePath]
checkoutArgs = [ FilePath
"checkout", FilePath
"--clean" ]
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
tagArgs
        tagArgs :: [FilePath]
tagArgs = case SourceRepositoryPackage f -> Maybe FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag SourceRepositoryPackage f
repo of
            Just FilePath
t  -> [FilePath
"--rev", FilePath
t]
            Maybe FilePath
Nothing -> []

hgProgram :: Program
hgProgram :: Program
hgProgram = (FilePath -> Program
simpleProgram FilePath
"hg") {
    programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
programFindVersion = FilePath -> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
findProgramVersion FilePath
"--version" (ShowS -> Verbosity -> FilePath -> IO (Maybe Version))
-> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \FilePath
str ->
      case FilePath -> [FilePath]
words FilePath
str of
        -- Mercurial Distributed SCM (version 3.5.2)\n ... long message
        (FilePath
_:FilePath
_:FilePath
_:FilePath
_:FilePath
ver:[FilePath]
_) -> (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
c -> Char -> Bool
Char.isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
ver
        [FilePath]
_ -> FilePath
""
  }


-- | VCS driver for Subversion.
--
vcsSvn :: VCS Program
vcsSvn :: VCS Program
vcsSvn =
    VCS :: forall program.
RepoType
-> program
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> SourceRepositoryPackage f
    -> FilePath
    -> FilePath
    -> [ProgramInvocation])
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> [(SourceRepositoryPackage f, FilePath)]
    -> IO [MonitorFilePath])
-> VCS program
VCS {
      vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
SVN,
      vcsProgram :: Program
vcsProgram  = Program
svnProgram,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos
    }
  where
    vcsCloneRepo :: Verbosity
                 -> ConfiguredProgram
                 -> SourceRepositoryPackage f
                 -> FilePath
                 -> FilePath
                 -> [ProgramInvocation]
    vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
_repo FilePath
srcuri FilePath
destdir =
        [ ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [FilePath]
checkoutArgs ]
      where
        checkoutArgs :: [FilePath]
checkoutArgs = [FilePath
"checkout", FilePath
srcuri, FilePath
destdir] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
verboseArg
        verboseArg :: [FilePath]
verboseArg   = [ FilePath
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
        --TODO: branch or tag?

    vcsSyncRepos :: Verbosity
                 -> ConfiguredProgram
                 -> [(SourceRepositoryPackage f, FilePath)]
                 -> IO [MonitorFilePath]
    vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_v ConfiguredProgram
_p [(SourceRepositoryPackage f, FilePath)]
_rs = FilePath -> IO [MonitorFilePath]
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"sync repo not yet supported for svn"

svnProgram :: Program
svnProgram :: Program
svnProgram = (FilePath -> Program
simpleProgram FilePath
"svn") {
    programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
programFindVersion = FilePath -> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
findProgramVersion FilePath
"--version" (ShowS -> Verbosity -> FilePath -> IO (Maybe Version))
-> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \FilePath
str ->
      case FilePath -> [FilePath]
words FilePath
str of
        -- svn, version 1.9.4 (r1740329)\n ... long message
        (FilePath
_:FilePath
_:FilePath
ver:[FilePath]
_) -> FilePath
ver
        [FilePath]
_ -> FilePath
""
  }


-- | VCS driver for Pijul.
-- Documentation for Pijul can be found at <https://pijul.org/manual/introduction.html>
--
-- 2020-04-09 Oleg:
--
--    As far as I understand pijul, there are branches and "tags" in pijul,
--    but there aren't a "commit hash" identifying an arbitrary state.
--
--    One can create `a pijul tag`, which will make a patch hash,
--    which depends on everything currently in the repository.
--    I guess if you try to apply that patch, you'll be forced to apply
--    all the dependencies too. In other words, there are no named tags.
--
--    It's not clear to me whether there is an option to
--    "apply this patch *and* all of its dependencies".
--    And relatedly, whether how to make sure that there are no other
--    patches applied.
--
--    With branches it's easier, as you can `pull` and `checkout` them,
--    and they seem to be similar enough. Yet, pijul documentations says
--
--    > Note that the purpose of branches in Pijul is quite different from Git,
--      since Git's "feature branches" can usually be implemented by just
--      patches.
--
--    I guess it means that indeed instead of creating a branch and making PR
--    in "GitHub" workflow, you'd just create a patch and offer it.
--    You can do that with `git` too. Push (a branch with) commit to remote
--    and ask other to cherry-pick that commit. Yet, in git identity of commit
--    changes when it applied to other trees, where patches in pijul have
--    will continue to have the same hash.
--
--    Unfortunately pijul doesn't talk about conflict resolution.
--    It seems that you get something like:
--
--        % pijul status
--        On branch merge
--
--        Unresolved conflicts:
--          (fix conflicts and record the resolution with "pijul record ...")
--
--                foo
--
--        % cat foo
--        first line
--        >> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>
--        branch BBB
--        ================================
--        branch AAA
--        <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
--        last line
--
--    And then the `pijul dependencies` would draw you a graph like
--
--
--                    ----->  foo on branch B ----->
--    resolve confict                                  Initial patch
--                    ----->  foo on branch A ----->
--
--    Which is seems reasonable.
--
--    So currently, pijul support is very experimental, and most likely
--    won't work, even the basics are in place. Tests are also written
--    but disabled, as the branching model differs from `git` one,
--    for which tests are written.
--
vcsPijul :: VCS Program
vcsPijul :: VCS Program
vcsPijul =
    VCS :: forall program.
RepoType
-> program
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> SourceRepositoryPackage f
    -> FilePath
    -> FilePath
    -> [ProgramInvocation])
-> (forall (f :: * -> *).
    Verbosity
    -> ConfiguredProgram
    -> [(SourceRepositoryPackage f, FilePath)]
    -> IO [MonitorFilePath])
-> VCS program
VCS {
      vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Pijul,
      vcsProgram :: Program
vcsProgram  = Program
pijulProgram,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo,
      forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos
    }
  where
    vcsCloneRepo :: Verbosity -- ^ it seems that pijul does not have verbose flag
                 -> ConfiguredProgram
                 -> SourceRepositoryPackage f
                 -> FilePath
                 -> FilePath
                 -> [ProgramInvocation]
    vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo Verbosity
_verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo FilePath
srcuri FilePath
destdir =
        [ ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [FilePath]
cloneArgs ]
        -- And if there's a tag, we have to do that in a second step:
     [ProgramInvocation] -> [ProgramInvocation] -> [ProgramInvocation]
forall a. [a] -> [a] -> [a]
++ [ (ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
prog (FilePath -> [FilePath]
checkoutArgs FilePath
tag)) {
            progInvokeCwd :: Maybe FilePath
progInvokeCwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
destdir
          }
        | FilePath
tag <- Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList (SourceRepositoryPackage f -> Maybe FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag SourceRepositoryPackage f
repo) ]
      where
        cloneArgs :: [String]
        cloneArgs :: [FilePath]
cloneArgs  = [FilePath
"clone", FilePath
srcuri, FilePath
destdir]
                     [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
branchArgs
        branchArgs :: [String]
        branchArgs :: [FilePath]
branchArgs = case SourceRepositoryPackage f -> Maybe FilePath
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpBranch SourceRepositoryPackage f
repo of
          Just FilePath
b  -> [FilePath
"--from-branch", FilePath
b]
          Maybe FilePath
Nothing -> []
        checkoutArgs :: FilePath -> [FilePath]
checkoutArgs FilePath
tag = FilePath
"checkout" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath
tag] -- TODO: this probably doesn't work either

    vcsSyncRepos :: Verbosity
                 -> ConfiguredProgram
                 -> [(SourceRepositoryPackage f, FilePath)]
                 -> IO [MonitorFilePath]
    vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = [MonitorFilePath] -> IO [MonitorFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    vcsSyncRepos Verbosity
verbosity ConfiguredProgram
pijulProg
                 ((SourceRepositoryPackage f
primaryRepo, FilePath
primaryLocalDir) : [(SourceRepositoryPackage f, FilePath)]
secondaryRepos) = do

      Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
pijulProg SourceRepositoryPackage f
primaryRepo FilePath
primaryLocalDir Maybe FilePath
forall a. Maybe a
Nothing
      [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
        [ Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
pijulProg SourceRepositoryPackage f
repo FilePath
localDir (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
primaryLocalDir)
        | (SourceRepositoryPackage f
repo, FilePath
localDir) <- [(SourceRepositoryPackage f, FilePath)]
secondaryRepos ]
      [MonitorFilePath] -> IO [MonitorFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [ FilePath -> MonitorFilePath
monitorDirectoryExistence FilePath
dir
             | FilePath
dir <- (FilePath
primaryLocalDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ((SourceRepositoryPackage f, FilePath) -> FilePath)
-> [(SourceRepositoryPackage f, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (SourceRepositoryPackage f, FilePath) -> FilePath
forall a b. (a, b) -> b
snd [(SourceRepositoryPackage f, FilePath)]
secondaryRepos) ]

    vcsSyncRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> Maybe FilePath
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
pijulProg SourceRepositoryPackage{f FilePath
FilePath
[FilePath]
Maybe FilePath
RepoType
srpCommand :: [FilePath]
srpSubdir :: f FilePath
srpBranch :: Maybe FilePath
srpTag :: Maybe FilePath
srpLocation :: FilePath
srpType :: RepoType
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [FilePath]
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f FilePath
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> FilePath
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
..} FilePath
localDir Maybe FilePath
peer = do
        Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
localDir
        if Bool
exists
        then FilePath -> [FilePath] -> IO ()
pijul FilePath
localDir                 [FilePath
"pull"] -- TODO: this probably doesn't work.
        else FilePath -> [FilePath] -> IO ()
pijul (ShowS
takeDirectory FilePath
localDir) [FilePath]
cloneArgs
        FilePath -> [FilePath] -> IO ()
pijul FilePath
localDir [FilePath]
checkoutArgs
      where
        pijul :: FilePath -> [String] -> IO ()
        pijul :: FilePath -> [FilePath] -> IO ()
pijul FilePath
cwd [FilePath]
args = Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
forall a b. (a -> b) -> a -> b
$
                         (ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
pijulProg [FilePath]
args) {
                           progInvokeCwd :: Maybe FilePath
progInvokeCwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
cwd
                         }

        cloneArgs :: [String]
        cloneArgs :: [FilePath]
cloneArgs      = [FilePath
"clone", FilePath
loc, FilePath
localDir]
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ case Maybe FilePath
peer of
                           Maybe FilePath
Nothing           -> []
                           Just FilePath
peerLocalDir -> [FilePath
peerLocalDir]
                         where loc :: FilePath
loc = FilePath
srpLocation
        checkoutArgs :: [String]
        checkoutArgs :: [FilePath]
checkoutArgs   = FilePath
"checkout" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:  [FilePath
"--force", FilePath
checkoutTarget, FilePath
"--" ]
        checkoutTarget :: FilePath
checkoutTarget = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"HEAD" (Maybe FilePath
srpBranch Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe FilePath
srpTag) -- TODO: this is definitely wrong.

pijulProgram :: Program
pijulProgram :: Program
pijulProgram = (FilePath -> Program
simpleProgram FilePath
"pijul") {
    programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
programFindVersion = FilePath -> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
findProgramVersion FilePath
"--version" (ShowS -> Verbosity -> FilePath -> IO (Maybe Version))
-> ShowS -> Verbosity -> FilePath -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ \FilePath
str ->
      case FilePath -> [FilePath]
words FilePath
str of
        -- "pijul 0.12.2
        (FilePath
_:FilePath
ver:[FilePath]
_) | (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isTypical FilePath
ver -> FilePath
ver
        [FilePath]
_ -> FilePath
""
  }
  where
    isNum :: Char -> Bool
isNum     Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
    isTypical :: Char -> Bool
isTypical Char
c = Char -> Bool
isNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'