{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

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 Distribution.Client.Compat.Prelude
import Prelude ()

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

#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.Directory
  ( doesDirectoryExist
  , removeDirectoryRecursive
  )
import System.FilePath
  ( takeDirectory
  , (</>)
  )
import System.IO.Error
  ( isDoesNotExistError
  )

-- | A driver for a version control system, e.g. git, darcs etc.
data VCS program = VCS
  { forall program. VCS program -> RepoType
vcsRepoType :: RepoType
  -- ^ The type of repository this driver is for.
  , forall program. VCS program -> program
vcsProgram :: program
  -- ^ The vcs program itself.
  -- This is used at type 'Program' and 'ConfiguredProgram'.
  , forall program.
VCS program
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> SourceRepositoryPackage f
   -> String
   -> String
   -> [ProgramInvocation]
vcsCloneRepo
      :: forall f
       . Verbosity
      -> ConfiguredProgram
      -> SourceRepositoryPackage f
      -> FilePath -- Source URI
      -> FilePath -- Destination directory
      -> [ProgramInvocation]
  -- ^ The program invocation(s) to get\/clone a repository into a fresh
  -- local directory.
  , forall program.
VCS program
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> [(SourceRepositoryPackage f, String)]
   -> IO [MonitorFilePath]
vcsSyncRepos
      :: forall f
       . Verbosity
      -> ConfiguredProgram
      -> [(SourceRepositoryPackage f, FilePath)]
      -> IO [MonitorFilePath]
  -- ^ 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.
  }

-- ------------------------------------------------------------

-- * Selecting repos and drivers

-- ------------------------------------------------------------

data SourceRepoProblem
  = SourceRepoRepoTypeUnspecified
  | SourceRepoRepoTypeUnsupported (SourceRepositoryPackage Proxy) RepoType
  | SourceRepoLocationUnspecified
  deriving (Int -> SourceRepoProblem -> ShowS
[SourceRepoProblem] -> ShowS
SourceRepoProblem -> String
(Int -> SourceRepoProblem -> ShowS)
-> (SourceRepoProblem -> String)
-> ([SourceRepoProblem] -> ShowS)
-> Show SourceRepoProblem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceRepoProblem -> ShowS
showsPrec :: Int -> SourceRepoProblem -> ShowS
$cshow :: SourceRepoProblem -> String
show :: SourceRepoProblem -> String
$cshowList :: [SourceRepoProblem] -> ShowS
showList :: [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 :: forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, String, 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 :: String
uri = SourceRepositoryPackage f -> String
forall (f :: * -> *). SourceRepositoryPackage f -> String
srpLocation SourceRepositoryPackage f
repo
  (SourceRepositoryPackage f, String, RepoType, VCS Program)
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, String, RepoType, VCS Program)
forall a. a -> Either SourceRepoProblem a
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 = 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, String, 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
  String
uri <- SourceRepo -> Maybe String
PD.repoLocation SourceRepo
repo Maybe String
-> SourceRepoProblem -> Either SourceRepoProblem String
forall {b} {a}. Maybe b -> a -> Either a b
?! SourceRepoProblem
SourceRepoLocationUnspecified
  SourceRepoMaybe
-> Either
     SourceRepoProblem (SourceRepoMaybe, String, RepoType, VCS Program)
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 = [String]
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 :: forall (f :: * -> *).
[SourceRepositoryPackage f]
-> Either
     [(SourceRepositoryPackage f, SourceRepoProblem)]
     [(SourceRepositoryPackage f, String, RepoType, VCS Program)]
validateSourceRepos [SourceRepositoryPackage f]
rs =
  case [Either
   (SourceRepositoryPackage f, SourceRepoProblem)
   (SourceRepositoryPackage f, String, RepoType, VCS Program)]
-> ([(SourceRepositoryPackage f, SourceRepoProblem)],
    [(SourceRepositoryPackage f, String, RepoType, VCS Program)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((SourceRepositoryPackage f
 -> Either
      (SourceRepositoryPackage f, SourceRepoProblem)
      (SourceRepositoryPackage f, String, RepoType, VCS Program))
-> [SourceRepositoryPackage f]
-> [Either
      (SourceRepositoryPackage f, SourceRepoProblem)
      (SourceRepositoryPackage f, String, RepoType, VCS Program)]
forall a b. (a -> b) -> [a] -> [b]
map SourceRepositoryPackage f
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, String, RepoType, VCS Program)
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)]
_) -> [(SourceRepositoryPackage f, SourceRepoProblem)]
-> Either
     [(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) -> [(SourceRepositoryPackage f, String, RepoType, VCS Program)]
-> Either
     [(SourceRepositoryPackage f, SourceRepoProblem)]
     [(SourceRepositoryPackage f, String, RepoType, VCS Program)]
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 =
      (SourceRepoProblem
 -> Either
      (SourceRepositoryPackage f, SourceRepoProblem)
      (SourceRepositoryPackage f, String, RepoType, VCS Program))
-> ((SourceRepositoryPackage f, String, RepoType, VCS Program)
    -> Either
         (SourceRepositoryPackage f, SourceRepoProblem)
         (SourceRepositoryPackage f, String, RepoType, VCS Program))
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, String, RepoType, VCS Program)
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, String, 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, String, RepoType, VCS Program)
forall a b. a -> Either a b
Left ((SourceRepositoryPackage f, SourceRepoProblem)
 -> Either
      (SourceRepositoryPackage f, SourceRepoProblem)
      (SourceRepositoryPackage f, String, RepoType, VCS Program))
-> (SourceRepoProblem
    -> (SourceRepositoryPackage f, SourceRepoProblem))
-> SourceRepoProblem
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, String, RepoType, VCS Program)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) SourceRepositoryPackage f
r)
        (SourceRepositoryPackage f, String, RepoType, VCS Program)
-> Either
     (SourceRepositoryPackage f, SourceRepoProblem)
     (SourceRepositoryPackage f, String, RepoType, VCS Program)
forall a b. b -> Either a b
Right
        (SourceRepositoryPackage f
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, String, RepoType, VCS Program)
forall (f :: * -> *).
SourceRepositoryPackage f
-> Either
     SourceRepoProblem
     (SourceRepositoryPackage f, String, RepoType, VCS Program)
validateSourceRepo SourceRepositoryPackage f
r)

configureVCS
  :: Verbosity
  -> [FilePath]
  -- ^ Extra prog paths
  -> VCS Program
  -> IO (VCS ConfiguredProgram)
configureVCS :: Verbosity -> [String] -> VCS Program -> IO (VCS ConfiguredProgram)
configureVCS Verbosity
verbosity [String]
progPaths vcs :: VCS Program
vcs@VCS{vcsProgram :: forall program. VCS program -> program
vcsProgram = Program
prog} = do
  ProgramDb
progPath <- Verbosity
-> [String]
-> [(String, Maybe String)]
-> ProgramDb
-> IO ProgramDb
prependProgramSearchPath Verbosity
verbosity [String]
progPaths [] ProgramDb
emptyProgramDb
  (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
progPath
  where
    asVcsConfigured :: (program, b) -> VCS program
asVcsConfigured (program
prog', b
_) = VCS Program
vcs{vcsProgram = prog'}

configureVCSs
  :: Verbosity
  -> [FilePath]
  -- ^ Extra prog paths
  -> Map RepoType (VCS Program)
  -> IO (Map RepoType (VCS ConfiguredProgram))
configureVCSs :: Verbosity
-> [String]
-> Map RepoType (VCS Program)
-> IO (Map RepoType (VCS ConfiguredProgram))
configureVCSs Verbosity
verbosity [String]
progPaths = (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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map RepoType a -> f (Map RepoType b)
traverse (Verbosity -> [String] -> VCS Program -> IO (VCS ConfiguredProgram)
configureVCS Verbosity
verbosity [String]
progPaths)

-- ------------------------------------------------------------

-- * 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 :: 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 =
    (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
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> SourceRepositoryPackage f
   -> String
   -> String
   -> [ProgramInvocation]
forall program.
VCS program
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> SourceRepositoryPackage f
   -> String
   -> String
   -> [ProgramInvocation]
vcsCloneRepo
          VCS ConfiguredProgram
vcs
          Verbosity
verbosity
          (VCS ConfiguredProgram -> ConfiguredProgram
forall program. VCS program -> program
vcsProgram VCS ConfiguredProgram
vcs)
          SourceRepositoryPackage f
repo
          String
srcuri
          String
destdir

-- | Synchronise 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 :: forall (f :: * -> *).
Verbosity
-> VCS ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> Rebuild ()
syncSourceRepos Verbosity
verbosity VCS ConfiguredProgram
vcs [(SourceRepositoryPackage f, String)]
repos = do
  [MonitorFilePath]
files <- IO [MonitorFilePath] -> Rebuild [MonitorFilePath]
forall a. IO a -> Rebuild a
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
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> [(SourceRepositoryPackage f, String)]
   -> IO [MonitorFilePath]
forall program.
VCS program
-> forall (f :: * -> *).
   Verbosity
   -> ConfiguredProgram
   -> [(SourceRepositoryPackage f, String)]
   -> IO [MonitorFilePath]
vcsSyncRepos VCS ConfiguredProgram
vcs Verbosity
verbosity (VCS ConfiguredProgram -> ConfiguredProgram
forall program. VCS program -> program
vcsProgram VCS ConfiguredProgram
vcs) [(SourceRepositoryPackage f, String)]
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
    { vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Bazaar
    , vcsProgram :: Program
vcsProgram = Program
bzrProgram
    , Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
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
    , Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
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] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
tagArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg)
      ]
      where
        -- The @get@ command was deprecated in version 2.4 in favour of
        -- the alias @branch@
        branchCmd :: String
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]) =
              String
"branch"
          | Bool
otherwise = String
"get"

        tagArgs :: [String]
        tagArgs :: [String]
tagArgs = case SourceRepositoryPackage f -> Maybe String
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
repo of
          Maybe String
Nothing -> []
          Just String
tag -> [String
"-r", String
"tag:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tag]
        verboseArg :: [String]
        verboseArg :: [String]
verboseArg = [String
"--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 :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_v ConfiguredProgram
_p [(SourceRepositoryPackage f, String)]
_rs = String -> IO [MonitorFilePath]
forall a. String -> IO a
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 = findProgramVersion "--version" $ \String
str ->
        case String -> [String]
words String
str of
          -- "Bazaar (bzr) 2.6.0\n  ... lots of extra stuff"
          (String
_ : String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

-- | VCS driver for Darcs.
vcsDarcs :: VCS Program
vcsDarcs :: VCS Program
vcsDarcs =
  VCS
    { vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Darcs
    , vcsProgram :: Program
vcsProgram = Program
darcsProgram
    , Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
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
    , Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
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] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
tagArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
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 :: String
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]) =
              String
"clone"
          | Bool
otherwise = String
"get"
        tagArgs :: [String]
        tagArgs :: [String]
tagArgs = case SourceRepositoryPackage f -> Maybe String
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 Verbosity -> Verbosity -> Bool
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
_ [] = [MonitorFilePath] -> IO [MonitorFilePath]
forall a. a -> IO a
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 [MonitorFilePath] -> IO () -> IO [MonitorFilePath]
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
        Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe Any
-> IO ()
forall {f :: * -> *} {p}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> p
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
primaryRepo String
primaryLocalDir Maybe Any
forall a. Maybe a
Nothing
        [(SourceRepositoryPackage f, String)]
-> ((SourceRepositoryPackage f, String) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(SourceRepositoryPackage f, String)]
secondaryRepos (((SourceRepositoryPackage f, String) -> IO ()) -> IO ())
-> ((SourceRepositoryPackage f, String) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(SourceRepositoryPackage f
repo, String
localDir) ->
          Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
forall {f :: * -> *} {p}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> p
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
prog SourceRepositoryPackage f
repo String
localDir (Maybe String -> IO ()) -> Maybe String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
primaryLocalDir
      where
        dirs :: [FilePath]
        dirs :: [String]
dirs = String
primaryLocalDir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((SourceRepositoryPackage f, String) -> String
forall a b. (a, b) -> b
snd ((SourceRepositoryPackage f, String) -> String)
-> [(SourceRepositoryPackage f, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceRepositoryPackage f, String)]
secondaryRepos)
        monitors :: [MonitorFilePath]
        monitors :: [MonitorFilePath]
monitors = String -> MonitorFilePath
monitorDirectoryExistence (String -> MonitorFilePath) -> [String] -> [MonitorFilePath]
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
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> String
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [String]
srpType :: RepoType
srpLocation :: String
srpTag :: Maybe String
srpBranch :: Maybe String
srpSubdir :: f String
srpCommand :: [String]
..} String
localDir p
_peer =
      IO [String] -> IO (Either IOError [String])
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
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"]) IO (Either IOError [String])
-> (Either IOError [String] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right (String
_ : String
_ : String
_ : String
x : [String]
_)
          | Just String
tag <- (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
"tagged " (String -> Maybe String) -> ShowS -> String -> Maybe String
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) String
x
          , Just String
tag' <- Maybe String
srpTag
          , String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
tag' ->
              () -> IO ()
forall a. a -> IO a
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 [String]
_ -> do
          String -> IO ()
removeDirectoryRecursive String
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 a b c.
(a -> b -> c) -> (IOError -> a) -> (IOError -> b) -> IOError -> c
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
          String -> [String] -> IO ()
darcs (ShowS
takeDirectory String
localDir) [String]
cloneArgs
      where
        darcs :: FilePath -> [String] -> IO ()
        darcs :: String -> [String] -> IO ()
darcs = (Verbosity -> ProgramInvocation -> IO ())
-> String -> [String] -> IO ()
forall t.
(Verbosity -> ProgramInvocation -> t) -> String -> [String] -> t
darcs' Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation

        darcsWithOutput :: FilePath -> [String] -> IO String
        darcsWithOutput :: String -> [String] -> IO String
darcsWithOutput = (Verbosity -> ProgramInvocation -> IO String)
-> String -> [String] -> IO String
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 = Just cwd
              }

        cloneArgs :: [String]
        cloneArgs :: [String]
cloneArgs = [String
"clone"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
tagArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
srpLocation, String
localDir] [String] -> [String] -> [String]
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" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tag]
        verboseArg :: [String]
        verboseArg :: [String]
verboseArg = [String
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal]

darcsProgram :: Program
darcsProgram :: Program
darcsProgram =
  (String -> Program
simpleProgram String
"darcs")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        case String -> [String]
words String
str of
          -- "2.8.5 (release)"
          (String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

-- | VCS driver for Git.
vcsGit :: VCS Program
vcsGit :: VCS Program
vcsGit =
  VCS
    { vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Git
    , vcsProgram :: Program
vcsProgram = Program
gitProgram
    , Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
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
    , Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
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]
        -- And if there's a tag, we have to do that in a second step:
        [ProgramInvocation] -> [ProgramInvocation] -> [ProgramInvocation]
forall a. [a] -> [a] -> [a]
++ [[String] -> ProgramInvocation
git (String -> [String]
resetArgs String
tag) | String
tag <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (SourceRepositoryPackage f -> Maybe String
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
repo)]
        [ProgramInvocation] -> [ProgramInvocation] -> [ProgramInvocation]
forall a. [a] -> [a] -> [a]
++ [ [String] -> ProgramInvocation
git ([String
"submodule", String
"sync", String
"--recursive"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg)
           , [String] -> ProgramInvocation
git ([String
"submodule", String
"update", String
"--init", String
"--force", String
"--recursive"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg)
           ]
      where
        git :: [String] -> ProgramInvocation
git [String]
args = (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String]
args){progInvokeCwd = Just destdir}
        cloneArgs :: [String]
cloneArgs =
          [String
"clone", String
srcuri, String
destdir]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
branchArgs
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
        branchArgs :: [String]
branchArgs = case SourceRepositoryPackage f -> Maybe String
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" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
verboseArg [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--hard", String
tag, String
"--"]
        verboseArg :: [String]
verboseArg = [String
"--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 :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = [MonitorFilePath] -> IO [MonitorFilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    vcsSyncRepos
      Verbosity
verbosity
      ConfiguredProgram
gitProg
      ((SourceRepositoryPackage f
primaryRepo, String
primaryLocalDir) : [(SourceRepositoryPackage f, String)]
secondaryRepos) = do
        Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
gitProg SourceRepositoryPackage f
primaryRepo String
primaryLocalDir Maybe String
forall a. Maybe a
Nothing
        [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
          [ Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
gitProg SourceRepositoryPackage f
repo String
localDir (String -> Maybe String
forall a. a -> Maybe a
Just String
primaryLocalDir)
          | (SourceRepositoryPackage f
repo, String
localDir) <- [(SourceRepositoryPackage f, String)]
secondaryRepos
          ]
        [MonitorFilePath] -> IO [MonitorFilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
          [ String -> MonitorFilePath
monitorDirectoryExistence String
dir
          | String
dir <- (String
primaryLocalDir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((SourceRepositoryPackage f, String) -> String)
-> [(SourceRepositoryPackage f, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (SourceRepositoryPackage f, String) -> String
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
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> String
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [String]
srpType :: RepoType
srpLocation :: String
srpTag :: Maybe String
srpBranch :: Maybe String
srpSubdir :: f String
srpCommand :: [String]
..} 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
      -- 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
      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
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
gitModulesExists (IO () -> IO ()) -> IO () -> IO ()
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 ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String
"submodule", String
"sync", String
"--recursive"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
      String -> [String] -> IO ()
git String
localDir ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String
"submodule", String
"update", String
"--force", String
"--init", String
"--recursive"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
      String -> [String] -> IO ()
git String
localDir ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String
"submodule", String
"foreach", String
"--recursive"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"git clean -ffxdq"]
      String -> [String] -> IO ()
git String
localDir ([String] -> IO ()) -> [String] -> IO ()
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 (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
forall a b. (a -> b) -> a -> b
$
            (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
gitProg [String]
args)
              { progInvokeCwd = Just cwd
              }

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

gitProgram :: Program
gitProgram :: Program
gitProgram =
  (String -> Program
simpleProgram String
"git")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        case String -> [String]
words String
str of
          -- "git version 2.5.5"
          (String
_ : String
_ : String
ver : [String]
_) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isTypical String
ver -> String
ver
          -- or annoyingly "git version 2.17.1.windows.2" yes, really
          (String
_ : String
_ : String
ver : [String]
_) ->
            String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"."
              ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isNum)
              ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
split
              ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
ver
          [String]
_ -> String
""
    }
  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 :: String -> [String]
split String
cs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
cs of
      (String
chunk, []) -> String
chunk String -> [String] -> [String]
forall a. a -> [a] -> [a]
: []
      (String
chunk, Char
_ : String
rest) -> String
chunk String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
split String
rest

-- | VCS driver for Mercurial.
vcsHg :: VCS Program
vcsHg :: VCS Program
vcsHg =
  VCS
    { vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Mercurial
    , vcsProgram :: Program
vcsProgram = Program
hgProgram
    , Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
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
    , Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
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]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
branchArgs
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
tagArgs
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
        branchArgs :: [String]
branchArgs = case SourceRepositoryPackage f -> Maybe String
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 SourceRepositoryPackage f -> Maybe String
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 Verbosity -> Verbosity -> Bool
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
_ [] = [MonitorFilePath] -> IO [MonitorFilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    vcsSyncRepos
      Verbosity
verbosity
      ConfiguredProgram
hgProg
      ((SourceRepositoryPackage f
primaryRepo, String
primaryLocalDir) : [(SourceRepositoryPackage f, String)]
secondaryRepos) = do
        Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> IO ()
forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
hgProg SourceRepositoryPackage f
primaryRepo String
primaryLocalDir
        [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
          [ Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> IO ()
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
          ]
        [MonitorFilePath] -> IO [MonitorFilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
          [ String -> MonitorFilePath
monitorDirectoryExistence String
dir
          | String
dir <- (String
primaryLocalDir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((SourceRepositoryPackage f, String) -> String)
-> [(SourceRepositoryPackage f, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (SourceRepositoryPackage f, String) -> String
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 (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
forall a b. (a -> b) -> a -> b
$
            (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
hgProg [String]
args)
              { progInvokeCwd = Just cwd
              }
        cloneArgs :: [String]
cloneArgs =
          [String
"clone", String
"--noupdate", (SourceRepositoryPackage f -> String
forall (f :: * -> *). SourceRepositoryPackage f -> String
srpLocation SourceRepositoryPackage f
repo), String
localDir]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
        verboseArg :: [String]
verboseArg = [String
"--quiet" | Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
< Verbosity
Verbosity.normal]
        checkoutArgs :: [String]
checkoutArgs =
          [String
"checkout", String
"--clean"]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
tagArgs
        tagArgs :: [String]
tagArgs = case SourceRepositoryPackage f -> Maybe String
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 = findProgramVersion "--version" $ \String
str ->
        case String -> [String]
words String
str of
          -- Mercurial Distributed SCM (version 3.5.2)\n ... long message
          (String
_ : String
_ : String
_ : String
_ : String
ver : [String]
_) -> (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
'.') String
ver
          [String]
_ -> String
""
    }

-- | VCS driver for Subversion.
vcsSvn :: VCS Program
vcsSvn :: VCS Program
vcsSvn =
  VCS
    { vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
SVN
    , vcsProgram :: Program
vcsProgram = Program
svnProgram
    , Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
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
    , Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
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] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
verboseArg
        verboseArg :: [String]
verboseArg = [String
"--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 :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_v ConfiguredProgram
_p [(SourceRepositoryPackage f, String)]
_rs = String -> IO [MonitorFilePath]
forall a. String -> IO a
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 = findProgramVersion "--version" $ \String
str ->
        case String -> [String]
words String
str of
          -- svn, version 1.9.4 (r1740329)\n ... long message
          (String
_ : String
_ : String
ver : [String]
_) -> String
ver
          [String]
_ -> String
""
    }

-- | 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 conflict                                  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
    { vcsRepoType :: RepoType
vcsRepoType = KnownRepoType -> RepoType
KnownRepoType KnownRepoType
Pijul
    , vcsProgram :: Program
vcsProgram = Program
pijulProgram
    , Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> String
-> [ProgramInvocation]
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
    , Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
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
      -- \^ it seems that pijul does not have verbose flag
      -> 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]
        -- And if there's a tag, we have to do that in a second step:
        [ProgramInvocation] -> [ProgramInvocation] -> [ProgramInvocation]
forall a. [a] -> [a] -> [a]
++ [ (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog (String -> [String]
checkoutArgs String
tag))
            { progInvokeCwd = Just destdir
            }
           | String
tag <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (SourceRepositoryPackage f -> Maybe String
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
repo)
           ]
      where
        cloneArgs :: [String]
        cloneArgs :: [String]
cloneArgs =
          [String
"clone", String
srcuri, String
destdir]
            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
branchArgs
        branchArgs :: [String]
        branchArgs :: [String]
branchArgs = case SourceRepositoryPackage f -> Maybe String
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" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String
tag] -- TODO: this probably doesn't work either
    vcsSyncRepos
      :: Verbosity
      -> ConfiguredProgram
      -> [(SourceRepositoryPackage f, FilePath)]
      -> IO [MonitorFilePath]
    vcsSyncRepos :: forall (f :: * -> *).
Verbosity
-> ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> IO [MonitorFilePath]
vcsSyncRepos Verbosity
_ ConfiguredProgram
_ [] = [MonitorFilePath] -> IO [MonitorFilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    vcsSyncRepos
      Verbosity
verbosity
      ConfiguredProgram
pijulProg
      ((SourceRepositoryPackage f
primaryRepo, String
primaryLocalDir) : [(SourceRepositoryPackage f, String)]
secondaryRepos) = do
        Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
pijulProg SourceRepositoryPackage f
primaryRepo String
primaryLocalDir Maybe String
forall a. Maybe a
Nothing
        [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
          [ Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
forall {f :: * -> *}.
Verbosity
-> ConfiguredProgram
-> SourceRepositoryPackage f
-> String
-> Maybe String
-> IO ()
vcsSyncRepo Verbosity
verbosity ConfiguredProgram
pijulProg SourceRepositoryPackage f
repo String
localDir (String -> Maybe String
forall a. a -> Maybe a
Just String
primaryLocalDir)
          | (SourceRepositoryPackage f
repo, String
localDir) <- [(SourceRepositoryPackage f, String)]
secondaryRepos
          ]
        [MonitorFilePath] -> IO [MonitorFilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
          [ String -> MonitorFilePath
monitorDirectoryExistence String
dir
          | String
dir <- (String
primaryLocalDir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((SourceRepositoryPackage f, String) -> String)
-> [(SourceRepositoryPackage f, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (SourceRepositoryPackage f, String) -> String
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
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> String
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [String]
srpType :: RepoType
srpLocation :: String
srpTag :: Maybe String
srpBranch :: Maybe String
srpSubdir :: f String
srpCommand :: [String]
..} 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"] -- TODO: this probably doesn't work.
        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 (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
forall a b. (a -> b) -> a -> b
$
            (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
pijulProg [String]
args)
              { progInvokeCwd = Just cwd
              }

        cloneArgs :: [String]
        cloneArgs :: [String]
cloneArgs =
          [String
"clone", String
loc, String
localDir]
            [String] -> [String] -> [String]
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" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String
"--force", String
checkoutTarget, String
"--"]
        checkoutTarget :: String
checkoutTarget = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"HEAD" (Maybe String
srpBranch Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
srpTag) -- TODO: this is definitely wrong.

pijulProgram :: Program
pijulProgram :: Program
pijulProgram =
  (String -> Program
simpleProgram String
"pijul")
    { programFindVersion = findProgramVersion "--version" $ \String
str ->
        case String -> [String]
words String
str of
          -- "pijul 0.12.2
          (String
_ : String
ver : [String]
_) | (Char -> Bool) -> String -> Bool
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 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
'.'