{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, RankNTypes #-}
module Distribution.Client.VCS (
VCS,
vcsRepoType,
vcsProgram,
RepoType,
Program,
ConfiguredProgram,
validatePDSourceRepo,
validateSourceRepo,
validateSourceRepos,
SourceRepoProblem(..),
configureVCS,
configureVCSs,
cloneSourceRepo,
syncSourceRepos,
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
#if !MIN_VERSION_base(4,18,0)
import Control.Applicative
( liftA2 )
#endif
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 )
data VCS program = VCS {
forall program. VCS program -> RepoType
vcsRepoType :: RepoType,
forall program. VCS program -> program
vcsProgram :: program,
forall program.
VCS program
-> forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall f. Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation],
forall program.
VCS program
-> forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall f. Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
}
data SourceRepoProblem = SourceRepoRepoTypeUnspecified
| SourceRepoRepoTypeUnsupported (SourceRepositoryPackage Proxy) RepoType
| SourceRepoLocationUnspecified
deriving Int -> SourceRepoProblem -> ShowS
[SourceRepoProblem] -> ShowS
SourceRepoProblem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceRepoProblem] -> ShowS
$cshowList :: [SourceRepoProblem] -> ShowS
show :: SourceRepoProblem -> String
$cshow :: SourceRepoProblem -> String
showsPrec :: Int -> SourceRepoProblem -> ShowS
$cshowsPrec :: Int -> SourceRepoProblem -> ShowS
Show
validateSourceRepo
:: SourceRepositoryPackage f
-> Either SourceRepoProblem (SourceRepositoryPackage f, String, RepoType, VCS Program)
validateSourceRepo :: forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
SourceRepoProblem
(SourceRepositoryPackage f, String, RepoType, VCS Program)
validateSourceRepo = \SourceRepositoryPackage f
repo -> do
let rtype :: RepoType
rtype = forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpType SourceRepositoryPackage f
repo
VCS Program
vcs <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RepoType
rtype Map RepoType (VCS Program)
knownVCSs forall {b} {a}. Maybe b -> a -> Either a b
?! SourceRepositoryPackage Proxy -> RepoType -> SourceRepoProblem
SourceRepoRepoTypeUnsupported (forall (f :: * -> *).
SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy SourceRepositoryPackage f
repo) RepoType
rtype
let uri :: String
uri = forall (f :: * -> *). SourceRepositoryPackage f -> String
srpLocation SourceRepositoryPackage f
repo
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceRepositoryPackage f
repo, String
uri, RepoType
rtype, VCS Program
vcs)
where
Maybe b
a ?! :: Maybe b -> a -> Either a b
?! a
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left a
e) 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, String, RepoType, VCS Program)
validatePDSourceRepo SourceRepo
repo = do
RepoType
rtype <- SourceRepo -> Maybe RepoType
PD.repoType SourceRepo
repo forall {b} {a}. Maybe b -> a -> Either a b
?! SourceRepoProblem
SourceRepoRepoTypeUnspecified
String
uri <- SourceRepo -> Maybe String
PD.repoLocation SourceRepo
repo forall {b} {a}. Maybe b -> a -> Either a b
?! SourceRepoProblem
SourceRepoLocationUnspecified
forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
SourceRepoProblem
(SourceRepositoryPackage f, String, RepoType, VCS Program)
validateSourceRepo SourceRepositoryPackage
{ srpType :: RepoType
srpType = RepoType
rtype
, srpLocation :: String
srpLocation = String
uri
, srpTag :: Maybe String
srpTag = SourceRepo -> Maybe String
PD.repoTag SourceRepo
repo
, srpBranch :: Maybe String
srpBranch = SourceRepo -> Maybe String
PD.repoBranch SourceRepo
repo
, srpSubdir :: Maybe String
srpSubdir = SourceRepo -> Maybe String
PD.repoSubdir SourceRepo
repo
, srpCommand :: [String]
srpCommand = forall a. Monoid a => a
mempty
}
where
Maybe b
a ?! :: Maybe b -> a -> Either a b
?! a
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left a
e) forall a b. b -> Either a b
Right Maybe b
a
validateSourceRepos :: [SourceRepositoryPackage f]
-> Either [(SourceRepositoryPackage f, SourceRepoProblem)]
[(SourceRepositoryPackage f, String, RepoType, VCS Program)]
validateSourceRepos :: forall (f :: * -> *).
[SourceRepositoryPackage f]
-> Either
[(SourceRepositoryPackage f, SourceRepoProblem)]
[(SourceRepositoryPackage f, String, RepoType, VCS Program)]
validateSourceRepos [SourceRepositoryPackage f]
rs =
case forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
(SourceRepositoryPackage f, SourceRepoProblem)
(SourceRepositoryPackage f, String, RepoType, VCS Program)
validateSourceRepo' [SourceRepositoryPackage f]
rs) of
(problems :: [(SourceRepositoryPackage f, SourceRepoProblem)]
problems@((SourceRepositoryPackage f, SourceRepoProblem)
_:[(SourceRepositoryPackage f, SourceRepoProblem)]
_), [(SourceRepositoryPackage f, String, RepoType, VCS Program)]
_) -> forall a b. a -> Either a b
Left [(SourceRepositoryPackage f, SourceRepoProblem)]
problems
([], [(SourceRepositoryPackage f, String, RepoType, VCS Program)]
vcss) -> forall a b. b -> Either a b
Right [(SourceRepositoryPackage f, String, RepoType, VCS Program)]
vcss
where
validateSourceRepo' :: SourceRepositoryPackage f
-> Either (SourceRepositoryPackage f, SourceRepoProblem)
(SourceRepositoryPackage f, String, RepoType, VCS Program)
validateSourceRepo' :: forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
(SourceRepositoryPackage f, SourceRepoProblem)
(SourceRepositoryPackage f, String, RepoType, VCS Program)
validateSourceRepo' SourceRepositoryPackage f
r = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) SourceRepositoryPackage f
r) forall a b. b -> Either a b
Right
(forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
SourceRepoProblem
(SourceRepositoryPackage f, String, 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} =
forall {program} {b}. (program, b) -> VCS program
asVcsConfigured 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 = 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)
cloneSourceRepo
:: Verbosity
-> VCS ConfiguredProgram
-> SourceRepositoryPackage f
-> [Char]
-> IO ()
cloneSourceRepo :: forall (f :: * -> *).
Verbosity
-> VCS ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> IO ()
cloneSourceRepo Verbosity
verbosity VCS ConfiguredProgram
vcs
repo :: SourceRepositoryPackage f
repo@SourceRepositoryPackage{ srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> String
srpLocation = String
srcuri } String
destdir =
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 = forall program.
VCS program
-> forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo VCS ConfiguredProgram
vcs Verbosity
verbosity
(forall program. VCS program -> program
vcsProgram VCS ConfiguredProgram
vcs) SourceRepositoryPackage f
repo
String
srcuri String
destdir
syncSourceRepos :: Verbosity
-> VCS ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> Rebuild ()
syncSourceRepos :: forall (f :: * -> *).
Verbosity
-> VCS ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> Rebuild ()
syncSourceRepos Verbosity
verbosity VCS ConfiguredProgram
vcs [(SourceRepositoryPackage f, String)]
repos = do
[MonitorFilePath]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall program.
VCS program
-> forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos VCS ConfiguredProgram
vcs Verbosity
verbosity (forall program. VCS program -> program
vcsProgram VCS ConfiguredProgram
vcs) [(SourceRepositoryPackage f, String)]
repos
[MonitorFilePath] -> Rebuild ()
monitorFiles [MonitorFilePath]
files
knownVCSs :: Map RepoType (VCS Program)
knownVCSs :: Map RepoType (VCS Program)
knownVCSs = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (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 ]
vcsBzr :: VCS Program
vcsBzr :: VCS Program
vcsBzr =
VCS {
vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Bazaar,
vcsProgram :: Program
vcsProgram = Program
bzrProgram,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos
}
where
vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo String
srcuri String
destdir =
[ ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog
([String
branchCmd, String
srcuri, String
destdir] forall a. [a] -> [a] -> [a]
++ [String]
tagArgs forall a. [a] -> [a] -> [a]
++ [String]
verboseArg) ]
where
branchCmd :: String
branchCmd | ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
prog forall a. Ord a => a -> a -> Bool
>= forall a. a -> Maybe a
Just ([Int] -> Version
mkVersion [Int
2,Int
4])
= String
"branch"
| Bool
otherwise = String
"get"
tagArgs :: [String]
tagArgs :: [String]
tagArgs = case forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
repo of
Maybe String
Nothing -> []
Just String
tag -> [String
"-r", String
"tag:" forall a. [a] -> [a] -> [a]
++ String
tag]
verboseArg :: [String]
verboseArg :: [String]
verboseArg = [ String
"--quiet" | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
vcsSyncRepos :: Verbosity -> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_v ConfiguredProgram
_p [(SourceRepositoryPackage f, String)]
_rs = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"sync repo not yet supported for bzr"
bzrProgram :: Program
bzrProgram :: Program
bzrProgram = (String -> Program
simpleProgram String
"bzr") {
programFindVersion :: Verbosity -> String -> IO (Maybe Version)
programFindVersion = String -> ShowS -> Verbosity -> String -> IO (Maybe Version)
findProgramVersion String
"--version" forall a b. (a -> b) -> a -> b
$ \String
str ->
case String -> [String]
words String
str of
(String
_:String
_:String
ver:[String]
_) -> String
ver
[String]
_ -> String
""
}
vcsDarcs :: VCS Program
vcsDarcs :: VCS Program
vcsDarcs =
VCS {
vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Darcs,
vcsProgram :: Program
vcsProgram = Program
darcsProgram,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos
}
where
vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo String
srcuri String
destdir =
[ ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
cloneArgs ]
where
cloneArgs :: [String]
cloneArgs :: [String]
cloneArgs = [String
cloneCmd, String
srcuri, String
destdir] forall a. [a] -> [a] -> [a]
++ [String]
tagArgs forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
cloneCmd :: String
cloneCmd :: String
cloneCmd | ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
prog forall a. Ord a => a -> a -> Bool
>= forall a. a -> Maybe a
Just ([Int] -> Version
mkVersion [Int
2,Int
8])
= String
"clone"
| Bool
otherwise = String
"get"
tagArgs :: [String]
tagArgs :: [String]
tagArgs = case forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
repo of
Maybe String
Nothing -> []
Just String
tag -> [String
"-t", String
tag]
verboseArg :: [String]
verboseArg :: [String]
verboseArg = [ String
"--quiet" | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
vcsSyncRepos :: Verbosity -> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)] -> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
vcsSyncRepos Verbosity
verbosity ConfiguredProgram
prog ((SourceRepositoryPackage f
primaryRepo, String
primaryLocalDir) : [(SourceRepositoryPackage f, String)]
secondaryRepos) =
[MonitorFilePath]
monitors forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
forall {f :: * -> *} {p}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> p
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
primaryRepo String
primaryLocalDir forall a. Maybe a
Nothing
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(SourceRepositoryPackage f, String)]
secondaryRepos forall a b. (a -> b) -> a -> b
$ \ (SourceRepositoryPackage f
repo, String
localDir) ->
forall {f :: * -> *} {p}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> p
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo String
localDir forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
primaryLocalDir
where
dirs :: [FilePath]
dirs :: [String]
dirs = String
primaryLocalDir forall a. a -> [a] -> [a]
: (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceRepositoryPackage f, String)]
secondaryRepos)
monitors :: [MonitorFilePath]
monitors :: [MonitorFilePath]
monitors = String -> MonitorFilePath
monitorDirectoryExistence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
dirs
vcsSyncRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> p
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage{f String
String
[String]
Maybe String
RepoType
srpCommand :: [String]
srpSubdir :: f String
srpBranch :: Maybe String
srpTag :: Maybe String
srpLocation :: String
srpType :: RepoType
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [String]
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> String
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
..} String
localDir p
_peer =
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
darcsWithOutput String
localDir [String
"log", String
"--last", String
"1"]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
Right (String
_:String
_:String
_:String
x:[String]
_)
| Just String
tag <- (forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
"tagged " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
List.dropWhile Char -> Bool
Char.isSpace) String
x
, Just String
tag' <- Maybe String
srpTag
, String
tag forall a. Eq a => a -> a -> Bool
== String
tag' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Left IOError
e | Bool -> Bool
not (IOError -> Bool
isDoesNotExistError IOError
e) -> forall a e. Exception e => e -> a
throw IOError
e
Either IOError [String]
_ -> do
String -> IO ()
removeDirectoryRecursive String
localDir forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless IOError -> Bool
isDoesNotExistError forall a e. Exception e => e -> a
throw
String -> [String] -> IO ()
darcs (ShowS
takeDirectory String
localDir) [String]
cloneArgs
where
darcs :: FilePath -> [String] -> IO ()
darcs :: String -> [String] -> IO ()
darcs = forall t.
(Verbosity -> ProgramInvocation -> t) -> String -> [String] -> t
darcs' Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation
darcsWithOutput :: FilePath -> [String] -> IO String
darcsWithOutput :: String -> [String] -> IO String
darcsWithOutput = forall t.
(Verbosity -> ProgramInvocation -> t) -> String -> [String] -> t
darcs' Verbosity -> ProgramInvocation -> IO String
getProgramInvocationOutput
darcs' :: (Verbosity -> ProgramInvocation -> t) -> FilePath -> [String] -> t
darcs' :: forall t.
(Verbosity -> ProgramInvocation -> t) -> String -> [String] -> t
darcs' Verbosity -> ProgramInvocation -> t
f String
cwd [String]
args = Verbosity -> ProgramInvocation -> t
f Verbosity
verbosity (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
args)
{ progInvokeCwd :: Maybe String
progInvokeCwd = forall a. a -> Maybe a
Just String
cwd }
cloneArgs :: [String]
cloneArgs :: [String]
cloneArgs = [String
"clone"] forall a. [a] -> [a] -> [a]
++ [String]
tagArgs forall a. [a] -> [a] -> [a]
++ [String
srpLocation, String
localDir] forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
tagArgs :: [String]
tagArgs :: [String]
tagArgs = case Maybe String
srpTag of
Maybe String
Nothing -> []
Just String
tag -> [String
"-t" forall a. [a] -> [a] -> [a]
++ String
tag]
verboseArg :: [String]
verboseArg :: [String]
verboseArg = [ String
"--quiet" | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
darcsProgram :: Program
darcsProgram :: Program
darcsProgram = (String -> Program
simpleProgram String
"darcs") {
programFindVersion :: Verbosity -> String -> IO (Maybe Version)
programFindVersion = String -> ShowS -> Verbosity -> String -> IO (Maybe Version)
findProgramVersion String
"--version" forall a b. (a -> b) -> a -> b
$ \String
str ->
case String -> [String]
words String
str of
(String
ver:[String]
_) -> String
ver
[String]
_ -> String
""
}
vcsGit :: VCS Program
vcsGit :: VCS Program
vcsGit =
VCS {
vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Git,
vcsProgram :: Program
vcsProgram = Program
gitProgram,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos
}
where
vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo String
srcuri String
destdir =
[ ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
cloneArgs ]
forall a. [a] -> [a] -> [a]
++ [ [String] -> ProgramInvocation
git (String -> [String]
resetArgs String
tag) | String
tag <- forall a. Maybe a -> [a]
maybeToList (forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
repo) ]
forall a. [a] -> [a] -> [a]
++ [ [String] -> ProgramInvocation
git ([String
"submodule", String
"sync", String
"--recursive"] forall a. [a] -> [a] -> [a]
++ [String]
verboseArg)
, [String] -> ProgramInvocation
git ([String
"submodule", String
"update", String
"--init", String
"--force", String
"--recursive"] forall a. [a] -> [a] -> [a]
++ [String]
verboseArg)
]
where
git :: [String] -> ProgramInvocation
git [String]
args = (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
args) {progInvokeCwd :: Maybe String
progInvokeCwd = forall a. a -> Maybe a
Just String
destdir}
cloneArgs :: [String]
cloneArgs = [String
"clone", String
srcuri, String
destdir]
forall a. [a] -> [a] -> [a]
++ [String]
branchArgs forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
branchArgs :: [String]
branchArgs = case forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpBranch SourceRepositoryPackage f
repo of
Just String
b -> [String
"--branch", String
b]
Maybe String
Nothing -> []
resetArgs :: String -> [String]
resetArgs String
tag = String
"reset" forall a. a -> [a] -> [a]
: [String]
verboseArg forall a. [a] -> [a] -> [a]
++ [String
"--hard", String
tag, String
"--"]
verboseArg :: [String]
verboseArg = [ String
"--quiet" | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
vcsSyncRepos Verbosity
verbosity ConfiguredProgram
gitProg
((SourceRepositoryPackage f
primaryRepo, String
primaryLocalDir) : [(SourceRepositoryPackage f, String)]
secondaryRepos) = do
forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
gitProg SourceRepositoryPackage f
primaryRepo String
primaryLocalDir forall a. Maybe a
Nothing
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
gitProg SourceRepositoryPackage f
repo String
localDir (forall a. a -> Maybe a
Just String
primaryLocalDir)
| (SourceRepositoryPackage f
repo, String
localDir) <- [(SourceRepositoryPackage f, String)]
secondaryRepos ]
forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> MonitorFilePath
monitorDirectoryExistence String
dir
| String
dir <- (String
primaryLocalDir forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(SourceRepositoryPackage f, String)]
secondaryRepos) ]
vcsSyncRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
gitProg SourceRepositoryPackage{f String
String
[String]
Maybe String
RepoType
srpCommand :: [String]
srpSubdir :: f String
srpBranch :: Maybe String
srpTag :: Maybe String
srpLocation :: String
srpType :: RepoType
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [String]
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> String
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
..} String
localDir Maybe String
peer = do
Bool
exists <- String -> IO Bool
doesDirectoryExist String
localDir
if Bool
exists
then String -> [String] -> IO ()
git String
localDir [String
"fetch"]
else String -> [String] -> IO ()
git (ShowS
takeDirectory String
localDir) [String]
cloneArgs
String -> [String] -> IO ()
git String
localDir [String
"submodule", String
"deinit", String
"--force", String
"--all"]
let gitModulesDir :: String
gitModulesDir = String
localDir String -> ShowS
</> String
".git" String -> ShowS
</> String
"modules"
Bool
gitModulesExists <- String -> IO Bool
doesDirectoryExist String
gitModulesDir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
gitModulesExists forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
gitModulesDir
String -> [String] -> IO ()
git String
localDir [String]
resetArgs
String -> [String] -> IO ()
git String
localDir forall a b. (a -> b) -> a -> b
$ [String
"submodule", String
"sync", String
"--recursive"] forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
String -> [String] -> IO ()
git String
localDir forall a b. (a -> b) -> a -> b
$ [String
"submodule", String
"update", String
"--force", String
"--init", String
"--recursive"] forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
String -> [String] -> IO ()
git String
localDir forall a b. (a -> b) -> a -> b
$ [String
"submodule", String
"foreach", String
"--recursive"] forall a. [a] -> [a] -> [a]
++ [String]
verboseArg forall a. [a] -> [a] -> [a]
++ [String
"git clean -ffxdq"]
String -> [String] -> IO ()
git String
localDir forall a b. (a -> b) -> a -> b
$ [String
"clean", String
"-ffxdq"]
where
git :: FilePath -> [String] -> IO ()
git :: String -> [String] -> IO ()
git String
cwd [String]
args = Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
(ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
gitProg [String]
args) {
progInvokeCwd :: Maybe String
progInvokeCwd = forall a. a -> Maybe a
Just String
cwd
}
cloneArgs :: [String]
cloneArgs = [String
"clone", String
"--no-checkout", String
loc, String
localDir]
forall a. [a] -> [a] -> [a]
++ case Maybe String
peer of
Maybe String
Nothing -> []
Just String
peerLocalDir -> [String
"--reference", String
peerLocalDir]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
where loc :: String
loc = String
srpLocation
resetArgs :: [String]
resetArgs = String
"reset" forall a. a -> [a] -> [a]
: [String]
verboseArg forall a. [a] -> [a] -> [a]
++ [String
"--hard", String
resetTarget, String
"--" ]
resetTarget :: String
resetTarget = forall a. a -> Maybe a -> a
fromMaybe String
"HEAD" (Maybe String
srpBranch forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
srpTag)
verboseArg :: [String]
verboseArg = [ String
"--quiet" | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
gitProgram :: Program
gitProgram :: Program
gitProgram = (String -> Program
simpleProgram String
"git") {
programFindVersion :: Verbosity -> String -> IO (Maybe Version)
programFindVersion = String -> ShowS -> Verbosity -> String -> IO (Maybe Version)
findProgramVersion String
"--version" forall a b. (a -> b) -> a -> b
$ \String
str ->
case String -> [String]
words String
str of
(String
_:String
_:String
ver:[String]
_) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isTypical String
ver -> String
ver
(String
_:String
_:String
ver:[String]
_) -> forall a. [a] -> [[a]] -> [a]
intercalate String
"."
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isNum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
split
forall a b. (a -> b) -> a -> b
$ String
ver
[String]
_ -> String
""
}
where
isNum :: Char -> Bool
isNum Char
c = Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c 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 forall a. Eq a => a -> a -> Bool
== Char
'.'
split :: String -> [String]
split String
cs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
'.') String
cs of
(String
chunk,[]) -> String
chunk forall a. a -> [a] -> [a]
: []
(String
chunk,Char
_:String
rest) -> String
chunk forall a. a -> [a] -> [a]
: String -> [String]
split String
rest
vcsHg :: VCS Program
vcsHg :: VCS Program
vcsHg =
VCS {
vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Mercurial,
vcsProgram :: Program
vcsProgram = Program
hgProgram,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos
}
where
vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo String
srcuri String
destdir =
[ ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
cloneArgs ]
where
cloneArgs :: [String]
cloneArgs = [String
"clone", String
srcuri, String
destdir]
forall a. [a] -> [a] -> [a]
++ [String]
branchArgs forall a. [a] -> [a] -> [a]
++ [String]
tagArgs forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
branchArgs :: [String]
branchArgs = case forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpBranch SourceRepositoryPackage f
repo of
Just String
b -> [String
"--branch", String
b]
Maybe String
Nothing -> []
tagArgs :: [String]
tagArgs = case forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
repo of
Just String
t -> [String
"--rev", String
t]
Maybe String
Nothing -> []
verboseArg :: [String]
verboseArg = [ String
"--quiet" | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
vcsSyncRepos Verbosity
verbosity ConfiguredProgram
hgProg
((SourceRepositoryPackage f
primaryRepo, String
primaryLocalDir) : [(SourceRepositoryPackage f, String)]
secondaryRepos) = do
forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
hgProg SourceRepositoryPackage f
primaryRepo String
primaryLocalDir
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
hgProg SourceRepositoryPackage f
repo String
localDir
| (SourceRepositoryPackage f
repo, String
localDir) <- [(SourceRepositoryPackage f, String)]
secondaryRepos ]
forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> MonitorFilePath
monitorDirectoryExistence String
dir
| String
dir <- (String
primaryLocalDir forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(SourceRepositoryPackage f, String)]
secondaryRepos) ]
vcsSyncRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
hgProg SourceRepositoryPackage f
repo String
localDir = do
Bool
exists <- String -> IO Bool
doesDirectoryExist String
localDir
if Bool
exists
then String -> [String] -> IO ()
hg String
localDir [String
"pull"]
else String -> [String] -> IO ()
hg (ShowS
takeDirectory String
localDir) [String]
cloneArgs
String -> [String] -> IO ()
hg String
localDir [String]
checkoutArgs
where
hg :: FilePath -> [String] -> IO ()
hg :: String -> [String] -> IO ()
hg String
cwd [String]
args = Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
(ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
hgProg [String]
args) {
progInvokeCwd :: Maybe String
progInvokeCwd = forall a. a -> Maybe a
Just String
cwd
}
cloneArgs :: [String]
cloneArgs = [String
"clone", String
"--noupdate", (forall (f :: * -> *). SourceRepositoryPackage f -> String
srpLocation SourceRepositoryPackage f
repo), String
localDir]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
verboseArg :: [String]
verboseArg = [ String
"--quiet" | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
checkoutArgs :: [String]
checkoutArgs = [ String
"checkout", String
"--clean" ]
forall a. [a] -> [a] -> [a]
++ [String]
tagArgs
tagArgs :: [String]
tagArgs = case forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
repo of
Just String
t -> [String
"--rev", String
t]
Maybe String
Nothing -> []
hgProgram :: Program
hgProgram :: Program
hgProgram = (String -> Program
simpleProgram String
"hg") {
programFindVersion :: Verbosity -> String -> IO (Maybe Version)
programFindVersion = String -> ShowS -> Verbosity -> String -> IO (Maybe Version)
findProgramVersion String
"--version" forall a b. (a -> b) -> a -> b
$ \String
str ->
case String -> [String]
words String
str of
(String
_:String
_:String
_:String
_:String
ver:[String]
_) -> forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
c -> Char -> Bool
Char.isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.') String
ver
[String]
_ -> String
""
}
vcsSvn :: VCS Program
vcsSvn :: VCS Program
vcsSvn =
VCS {
vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
SVN,
vcsProgram :: Program
vcsProgram = Program
svnProgram,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos
}
where
vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
_repo String
srcuri String
destdir =
[ ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
checkoutArgs ]
where
checkoutArgs :: [String]
checkoutArgs = [String
"checkout", String
srcuri, String
destdir] forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
verboseArg :: [String]
verboseArg = [ String
"--quiet" | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal ]
vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_v ConfiguredProgram
_p [(SourceRepositoryPackage f, String)]
_rs = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"sync repo not yet supported for svn"
svnProgram :: Program
svnProgram :: Program
svnProgram = (String -> Program
simpleProgram String
"svn") {
programFindVersion :: Verbosity -> String -> IO (Maybe Version)
programFindVersion = String -> ShowS -> Verbosity -> String -> IO (Maybe Version)
findProgramVersion String
"--version" forall a b. (a -> b) -> a -> b
$ \String
str ->
case String -> [String]
words String
str of
(String
_:String
_:String
ver:[String]
_) -> String
ver
[String]
_ -> String
""
}
vcsPijul :: VCS Program
vcsPijul :: VCS Program
vcsPijul =
VCS {
vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Pijul,
vcsProgram :: Program
vcsProgram = Program
pijulProgram,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo,
forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos
}
where
vcsCloneRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> FilePath
-> FilePath
-> [ProgramInvocation]
vcsCloneRepo :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
vcsCloneRepo Verbosity
_verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo String
srcuri String
destdir =
[ ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
cloneArgs ]
forall a. [a] -> [a] -> [a]
++ [ (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog (String -> [String]
checkoutArgs String
tag)) {
progInvokeCwd :: Maybe String
progInvokeCwd = forall a. a -> Maybe a
Just String
destdir
}
| String
tag <- forall a. Maybe a -> [a]
maybeToList (forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
repo) ]
where
cloneArgs :: [String]
cloneArgs :: [String]
cloneArgs = [String
"clone", String
srcuri, String
destdir]
forall a. [a] -> [a] -> [a]
++ [String]
branchArgs
branchArgs :: [String]
branchArgs :: [String]
branchArgs = case forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpBranch SourceRepositoryPackage f
repo of
Just String
b -> [String
"--from-branch", String
b]
Maybe String
Nothing -> []
checkoutArgs :: String -> [String]
checkoutArgs String
tag = String
"checkout" forall a. a -> [a] -> [a]
: [String
tag]
vcsSyncRepos :: Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, FilePath)]
-> IO [MonitorFilePath]
vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
vcsSyncRepos Verbosity
verbosity ConfiguredProgram
pijulProg
((SourceRepositoryPackage f
primaryRepo, String
primaryLocalDir) : [(SourceRepositoryPackage f, String)]
secondaryRepos) = do
forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
pijulProg SourceRepositoryPackage f
primaryRepo String
primaryLocalDir forall a. Maybe a
Nothing
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
pijulProg SourceRepositoryPackage f
repo String
localDir (forall a. a -> Maybe a
Just String
primaryLocalDir)
| (SourceRepositoryPackage f
repo, String
localDir) <- [(SourceRepositoryPackage f, String)]
secondaryRepos ]
forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> MonitorFilePath
monitorDirectoryExistence String
dir
| String
dir <- (String
primaryLocalDir forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(SourceRepositoryPackage f, String)]
secondaryRepos) ]
vcsSyncRepo :: Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
pijulProg SourceRepositoryPackage{f String
String
[String]
Maybe String
RepoType
srpCommand :: [String]
srpSubdir :: f String
srpBranch :: Maybe String
srpTag :: Maybe String
srpLocation :: String
srpType :: RepoType
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [String]
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> String
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
..} String
localDir Maybe String
peer = do
Bool
exists <- String -> IO Bool
doesDirectoryExist String
localDir
if Bool
exists
then String -> [String] -> IO ()
pijul String
localDir [String
"pull"]
else String -> [String] -> IO ()
pijul (ShowS
takeDirectory String
localDir) [String]
cloneArgs
String -> [String] -> IO ()
pijul String
localDir [String]
checkoutArgs
where
pijul :: FilePath -> [String] -> IO ()
pijul :: String -> [String] -> IO ()
pijul String
cwd [String]
args = Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
(ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
pijulProg [String]
args) {
progInvokeCwd :: Maybe String
progInvokeCwd = forall a. a -> Maybe a
Just String
cwd
}
cloneArgs :: [String]
cloneArgs :: [String]
cloneArgs = [String
"clone", String
loc, String
localDir]
forall a. [a] -> [a] -> [a]
++ case Maybe String
peer of
Maybe String
Nothing -> []
Just String
peerLocalDir -> [String
peerLocalDir]
where loc :: String
loc = String
srpLocation
checkoutArgs :: [String]
checkoutArgs :: [String]
checkoutArgs = String
"checkout" forall a. a -> [a] -> [a]
: [String
"--force", String
checkoutTarget, String
"--" ]
checkoutTarget :: String
checkoutTarget = forall a. a -> Maybe a -> a
fromMaybe String
"HEAD" (Maybe String
srpBranch forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
srpTag)
pijulProgram :: Program
pijulProgram :: Program
pijulProgram = (String -> Program
simpleProgram String
"pijul") {
programFindVersion :: Verbosity -> String -> IO (Maybe Version)
programFindVersion = String -> ShowS -> Verbosity -> String -> IO (Maybe Version)
findProgramVersion String
"--version" forall a b. (a -> b) -> a -> b
$ \String
str ->
case String -> [String]
words String
str of
(String
_:String
ver:[String]
_) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isTypical String
ver -> String
ver
[String]
_ -> String
""
}
where
isNum :: Char -> Bool
isNum Char
c = Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c 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 forall a. Eq a => a -> a -> Bool
== Char
'.'