Commit 048dac5a authored by Oleg Grenrus's avatar Oleg Grenrus

Resolve #5472: Add SourceRepositoryPackage..

which can be parametrised over container of subdirs: [], Maybe, Proxy...
parent 1d2ff345
......@@ -13,7 +13,9 @@
module Distribution.Client.Compat.Prelude
( module Distribution.Compat.Prelude.Internal
, Prelude.IO
, Proxy (..)
) where
import Prelude (IO)
import Distribution.Compat.Prelude.Internal hiding (IO)
import Data.Proxy (Proxy (..))
......@@ -24,6 +24,7 @@ module Distribution.Client.Get (
import Prelude ()
import Distribution.Client.Compat.Prelude hiding (get)
import Data.Ord (comparing)
import Distribution.Compat.Directory
( listDirectory )
import Distribution.Package
......@@ -38,6 +39,8 @@ import Distribution.Deprecated.Text (display)
import qualified Distribution.PackageDescription as PD
import Distribution.Simple.Program
( programName )
import Distribution.Types.SourceRepo (RepoKind (..))
import Distribution.Client.SourceRepo (SourceRepositoryPackage (..), SourceRepoProxy, srpToProxy)
import Distribution.Client.Setup
( GlobalFlags(..), GetFlags(..), RepoContext(..) )
......@@ -114,7 +117,7 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do
. map (\pkg -> (packageId pkg, packageSourceRepos pkg))
where
kind = fromFlag . getSourceRepository $ getFlags
packageSourceRepos :: SourcePackage loc -> [SourceRepo]
packageSourceRepos :: SourcePackage loc -> [PD.SourceRepo]
packageSourceRepos = PD.sourceRepos
. PD.packageDescription
. packageDescription
......@@ -197,11 +200,11 @@ unpackPackage verbosity prefix pkgid descOverride pkgPath = do
data ClonePackageException =
ClonePackageNoSourceRepos PackageId
| ClonePackageNoSourceReposOfKind PackageId (Maybe RepoKind)
| ClonePackageNoRepoType PackageId SourceRepo
| ClonePackageUnsupportedRepoType PackageId SourceRepo RepoType
| ClonePackageNoRepoLocation PackageId SourceRepo
| ClonePackageNoRepoType PackageId PD.SourceRepo
| ClonePackageUnsupportedRepoType PackageId SourceRepoProxy RepoType
| ClonePackageNoRepoLocation PackageId PD.SourceRepo
| ClonePackageDestinationExists PackageId FilePath Bool
| ClonePackageFailedWithExitCode PackageId SourceRepo String ExitCode
| ClonePackageFailedWithExitCode PackageId SourceRepoProxy String ExitCode
deriving (Show, Eq)
instance Exception ClonePackageException where
......@@ -237,7 +240,7 @@ instance Exception ClonePackageException where
displayException (ClonePackageFailedWithExitCode
pkgid repo vcsprogname exitcode) =
"Failed to fetch the source repository for package " ++ display pkgid
++ maybe "" (", repository location " ++) (PD.repoLocation repo) ++ " ("
++ ", repository location " ++ srpLocation repo ++ " ("
++ vcsprogname ++ " failed with " ++ show exitcode ++ ")."
......@@ -248,7 +251,7 @@ instance Exception ClonePackageException where
clonePackagesFromSourceRepo :: Verbosity
-> FilePath -- ^ destination dir prefix
-> Maybe RepoKind -- ^ preferred 'RepoKind'
-> [(PackageId, [SourceRepo])]
-> [(PackageId, [PD.SourceRepo])]
-- ^ the packages and their
-- available 'SourceRepo's
-> IO ()
......@@ -268,14 +271,14 @@ clonePackagesFromSourceRepo verbosity destDirPrefix
[ cloneSourceRepo verbosity vcs' repo destDir
`catch` \exitcode ->
throwIO (ClonePackageFailedWithExitCode
pkgid repo (programName (vcsProgram vcs)) exitcode)
pkgid (srpToProxy repo) (programName (vcsProgram vcs)) exitcode)
| (pkgid, repo, vcs, destDir) <- pkgrepos'
, let Just vcs' = Map.lookup (vcsRepoType vcs) vcss
]
where
preCloneChecks :: (PackageId, [SourceRepo])
-> IO (PackageId, SourceRepo, VCS Program, FilePath)
preCloneChecks :: (PackageId, [PD.SourceRepo])
-> IO (PackageId, SourceRepositoryPackage Maybe, VCS Program, FilePath)
preCloneChecks (pkgid, repos) = do
repo <- case selectPackageSourceRepo preferredRepoKind repos of
Just repo -> return repo
......@@ -283,13 +286,13 @@ clonePackagesFromSourceRepo verbosity destDirPrefix
Nothing -> throwIO (ClonePackageNoSourceReposOfKind
pkgid preferredRepoKind)
vcs <- case validateSourceRepo repo of
Right (_, _, _, vcs) -> return vcs
(repo', vcs) <- case validatePDSourceRepo repo of
Right (repo', _, _, vcs) -> return (repo', vcs)
Left SourceRepoRepoTypeUnspecified ->
throwIO (ClonePackageNoRepoType pkgid repo)
Left (SourceRepoRepoTypeUnsupported repoType) ->
throwIO (ClonePackageUnsupportedRepoType pkgid repo repoType)
Left (SourceRepoRepoTypeUnsupported repo' repoType) ->
throwIO (ClonePackageUnsupportedRepoType pkgid repo' repoType)
Left SourceRepoLocationUnspecified ->
throwIO (ClonePackageNoRepoLocation pkgid repo)
......@@ -300,5 +303,37 @@ clonePackagesFromSourceRepo verbosity destDirPrefix
when (destDirExists || destFileExists) $
throwIO (ClonePackageDestinationExists pkgid destDir destDirExists)
return (pkgid, repo, vcs, destDir)
return (pkgid, repo', vcs, destDir)
-------------------------------------------------------------------------------
-- Selecting
-------------------------------------------------------------------------------
-- | Pick the 'SourceRepo' to use to get the package sources from.
--
-- Note that this does /not/ depend on what 'VCS' drivers we are able to
-- successfully configure. It is based only on the 'SourceRepo's declared
-- in the package, and optionally on a preferred 'RepoKind'.
--
selectPackageSourceRepo :: Maybe RepoKind
-> [PD.SourceRepo]
-> Maybe PD.SourceRepo
selectPackageSourceRepo preferredRepoKind =
listToMaybe
-- Sort repositories by kind, from This to Head to Unknown. Repositories
-- with equivalent kinds are selected based on the order they appear in
-- the Cabal description file.
. sortBy (comparing thisFirst)
-- If the user has specified the repo kind, filter out the repositories
-- they're not interested in.
. filter (\repo -> maybe True (PD.repoKind repo ==) preferredRepoKind)
where
thisFirst :: PD.SourceRepo -> Int
thisFirst r = case PD.repoKind r of
RepoThis -> 0
RepoHead -> case PD.repoTag r of
-- If the type is 'head' but the author specified a tag, they
-- probably meant to create a 'this' repository but screwed up.
Just _ -> 0
Nothing -> 1
RepoKindUnknown _ -> 2
......@@ -15,7 +15,7 @@ module Distribution.Client.HttpUtils (
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Client.Compat.Prelude hiding (Proxy (..))
import Network.HTTP
( Request (..), Response (..), RequestMethod (..)
......
......@@ -100,7 +100,9 @@ import Distribution.Fields
( runParseResult, PError, PWarning, showPWarning)
import Distribution.Pretty ()
import Distribution.Types.SourceRepo
( SourceRepo(..), RepoType(..), )
( RepoType(..) )
import Distribution.Client.SourceRepo
( SourceRepoList, SourceRepositoryPackage (..), srpFanOut )
import Distribution.Simple.Compiler
( Compiler, compilerInfo )
import Distribution.Simple.Program
......@@ -139,6 +141,7 @@ import Data.Either
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import qualified Data.List.NonEmpty as NE
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Hashable as Hashable
......@@ -647,7 +650,7 @@ data ProjectPackageLocation =
| ProjectPackageLocalDirectory FilePath FilePath -- dir and .cabal file
| ProjectPackageLocalTarball FilePath
| ProjectPackageRemoteTarball URI
| ProjectPackageRemoteRepo SourceRepo
| ProjectPackageRemoteRepo SourceRepoList
| ProjectPackageNamed PackageVersionConstraint
deriving Show
......@@ -1108,7 +1111,7 @@ syncAndReadSourcePackagesRemoteRepos
:: Verbosity
-> DistDirLayout
-> ProjectConfigShared
-> [SourceRepo]
-> [SourceRepoList]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
syncAndReadSourcePackagesRemoteRepos verbosity
DistDirLayout{distDownloadSrcDirectory}
......@@ -1123,7 +1126,7 @@ syncAndReadSourcePackagesRemoteRepos verbosity
-- All 'SourceRepo's grouped by referring to the "same" remote repo
-- instance. So same location but can differ in commit/tag/branch/subdir.
let reposByLocation :: Map (RepoType, String)
[(SourceRepo, RepoType)]
[(SourceRepoList, RepoType)]
reposByLocation = Map.fromListWith (++)
[ ((rtype, rloc), [(repo, vcsRepoType vcs)])
| (repo, rloc, rtype, vcs) <- repos' ]
......@@ -1143,7 +1146,7 @@ syncAndReadSourcePackagesRemoteRepos verbosity
pathStem = distDownloadSrcDirectory
</> localFileNameForRemoteRepo primaryRepo
monitor :: FileMonitor
[SourceRepo]
[SourceRepoList]
[PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
monitor = newFileMonitor (pathStem <.> "cache")
]
......@@ -1151,7 +1154,7 @@ syncAndReadSourcePackagesRemoteRepos verbosity
syncRepoGroupAndReadSourcePackages
:: VCS ConfiguredProgram
-> FilePath
-> [SourceRepo]
-> [SourceRepoList]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
syncRepoGroupAndReadSourcePackages vcs pathStem repoGroup = do
liftIO $ createDirectoryIfMissingVerbose verbosity False
......@@ -1168,24 +1171,33 @@ syncAndReadSourcePackagesRemoteRepos verbosity
sequence
[ readPackageFromSourceRepo repoWithSubdir repoPath
| (_, reposWithSubdir, repoPath) <- repoGroupWithPaths
, repoWithSubdir <- reposWithSubdir ]
, repoWithSubdir <- NE.toList reposWithSubdir ]
where
-- So to do both things above, we pair them up here.
repoGroupWithPaths
:: [(SourceRepositoryPackage Proxy, NonEmpty (SourceRepositoryPackage Maybe), FilePath)]
repoGroupWithPaths =
zipWith (\(x, y) z -> (x,y,z))
(Map.toList
(Map.fromListWith (++)
[ (repo { repoSubdir = Nothing }, [repo])
| repo <- repoGroup ]))
(mapGroup
[ (repo { srpSubdir = Proxy }, repo)
| repo <- foldMap (NE.toList . srpFanOut) repoGroup
])
repoPaths
mapGroup :: Ord k => [(k, v)] -> [(k, NonEmpty v)]
mapGroup = Map.toList . Map.fromListWith (<>) . map (\(k, v) -> (k, pure v))
-- The repos in a group are given distinct names by simple enumeration
-- foo, foo-2, foo-3 etc
repoPaths :: [FilePath]
repoPaths = pathStem
: [ pathStem ++ "-" ++ show (i :: Int) | i <- [2..] ]
readPackageFromSourceRepo
:: SourceRepositoryPackage Maybe -> FilePath
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readPackageFromSourceRepo repo repoPath = do
let packageDir = maybe repoPath (repoPath </>) (repoSubdir repo)
let packageDir = maybe repoPath (repoPath </>) (srpSubdir repo)
entries <- liftIO $ getDirectoryContents packageDir
--TODO: wrap exceptions
case filter (\e -> takeExtension e == ".cabal") entries of
......@@ -1201,10 +1213,10 @@ syncAndReadSourcePackagesRemoteRepos verbosity
location = RemoteSourceRepoPackage repo packageDir
reportSourceRepoProblems :: [(SourceRepo, SourceRepoProblem)] -> Rebuild a
reportSourceRepoProblems :: [(SourceRepoList, SourceRepoProblem)] -> Rebuild a
reportSourceRepoProblems = liftIO . die' verbosity . renderSourceRepoProblems
renderSourceRepoProblems :: [(SourceRepo, SourceRepoProblem)] -> String
renderSourceRepoProblems :: [(SourceRepoList, SourceRepoProblem)] -> String
renderSourceRepoProblems = unlines . map show -- "TODO: the repo problems"
......@@ -1357,10 +1369,9 @@ localFileNameForRemoteTarball uri =
-- This is deterministic based on the source repo identity details, and
-- intended to produce non-clashing file names for different repos.
--
localFileNameForRemoteRepo :: SourceRepo -> FilePath
localFileNameForRemoteRepo SourceRepo{repoType, repoLocation, repoModule} =
maybe "" ((++ "-") . mangleName) repoLocation
++ showHex locationHash ""
localFileNameForRemoteRepo :: SourceRepoList -> FilePath
localFileNameForRemoteRepo SourceRepositoryPackage {srpType, srpLocation} =
mangleName srpLocation ++ "-" ++ showHex locationHash ""
where
mangleName = truncateString 10 . dropExtension
. takeFileName . dropTrailingPathSeparator
......@@ -1368,7 +1379,7 @@ localFileNameForRemoteRepo SourceRepo{repoType, repoLocation, repoModule} =
-- just the parts that make up the "identity" of the repo
locationHash :: Word
locationHash =
fromIntegral (Hashable.hash (show repoType, repoLocation, repoModule))
fromIntegral (Hashable.hash (show srpType, srpLocation))
-- | Truncate a string, with a visual indication that it is truncated.
......
......@@ -29,6 +29,7 @@ import Distribution.Client.ProjectConfig.Types
import Distribution.Client.Types
( RemoteRepo(..), emptyRemoteRepo
, AllowNewer(..), AllowOlder(..) )
import Distribution.Client.SourceRepo (sourceRepositoryPackageGrammar, SourceRepoList)
import Distribution.Client.Config
( SavedConfig(..), remoteRepoFields )
......@@ -41,9 +42,7 @@ import Distribution.Solver.Types.ConstraintSource
import Distribution.Package
import Distribution.PackageDescription
( SourceRepo(..), RepoKind(..)
, dispFlagAssignment )
import Distribution.PackageDescription.FieldGrammar (sourceRepoFieldGrammar)
( dispFlagAssignment )
import Distribution.Simple.Compiler
( OptimisationLevel(..), DebugInfoLevel(..) )
import Distribution.Simple.InstallDirs ( CopyDest (NoCopyDest) )
......@@ -89,6 +88,7 @@ import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint )
import qualified Data.Map as Map
------------------------------------------------------------------
-- Representing the project config file in terms of legacy types
--
......@@ -105,7 +105,7 @@ import qualified Data.Map as Map
data LegacyProjectConfig = LegacyProjectConfig {
legacyPackages :: [String],
legacyPackagesOptional :: [String],
legacyPackagesRepo :: [SourceRepo],
legacyPackagesRepo :: [SourceRepoList],
legacyPackagesNamed :: [PackageVersionConstraint],
legacySharedConfig :: LegacySharedConfig,
......@@ -1194,7 +1194,7 @@ legacyPackageConfigSectionDescrs =
packageRepoSectionDescr :: FGSectionDescr LegacyProjectConfig
packageRepoSectionDescr = FGSectionDescr
{ fgSectionName = "source-repository-package"
, fgSectionGrammar = sourceRepoFieldGrammar (RepoKindUnknown "unused")
, fgSectionGrammar = sourceRepositoryPackageGrammar
, fgSectionGet = map (\x->("", x)) . legacyPackagesRepo
, fgSectionSet =
\lineno unused pkgrepo projconf -> do
......
......@@ -29,6 +29,7 @@ import Distribution.Client.Targets
( UserConstraint )
import Distribution.Client.BuildReports.Types
( ReportLevel(..) )
import Distribution.Client.SourceRepo (SourceRepoList)
import Distribution.Client.IndexUtils.Timestamp
( IndexState )
......@@ -48,7 +49,7 @@ import Distribution.Version
import Distribution.System
( Platform )
import Distribution.PackageDescription
( FlagAssignment, SourceRepo(..) )
( FlagAssignment )
import Distribution.Simple.Compiler
( Compiler, CompilerFlavor
, OptimisationLevel(..), ProfDetailLevel, DebugInfoLevel(..) )
......@@ -107,7 +108,7 @@ data ProjectConfig
projectPackagesOptional :: [String],
-- | Packages in this project from remote source repositories.
projectPackagesRepo :: [SourceRepo],
projectPackagesRepo :: [SourceRepoList],
-- | Packages in this project from hackage repositories.
projectPackagesNamed :: [PackageVersionConstraint],
......
......@@ -20,6 +20,7 @@ import Distribution.Client.ProjectBuilding.Types
import Distribution.Client.DistDirLayout
import Distribution.Client.Types (Repo(..), RemoteRepo(..), PackageLocation(..), confInstId)
import Distribution.Client.PackageHash (showHashValue, hashValue)
import Distribution.Client.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..))
import qualified Distribution.Client.InstallPlan as InstallPlan
import qualified Distribution.Client.Utils.Json as J
......@@ -212,15 +213,14 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
, "uri" J..= J.String (show (remoteRepoURI repoRemote))
]
sourceRepoToJ :: PD.SourceRepo -> J.Value
sourceRepoToJ PD.SourceRepo{..} =
sourceRepoToJ :: SourceRepoMaybe -> J.Value
sourceRepoToJ SourceRepositoryPackage{..} =
J.object $ filter ((/= J.Null) . snd) $
[ "type" J..= fmap jdisplay repoType
, "location" J..= fmap J.String repoLocation
, "module" J..= fmap J.String repoModule
, "branch" J..= fmap J.String repoBranch
, "tag" J..= fmap J.String repoTag
, "subdir" J..= fmap J.String repoSubdir
[ "type" J..= jdisplay srpType
, "location" J..= J.String srpLocation
, "branch" J..= fmap J.String srpBranch
, "tag" J..= fmap J.String srpTag
, "subdir" J..= fmap J.String srpSubdir
]
dist_dir = distBuildDirectory distDirLayout
......
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Distribution.Client.SourceRepo where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Compat.Lens (Lens, Lens')
import Distribution.Types.SourceRepo
( RepoType(..))
import Distribution.FieldGrammar (FieldGrammar, ParsecFieldGrammar', PrettyFieldGrammar', uniqueField, uniqueFieldAla, optionalFieldAla, monoidalFieldAla)
import Distribution.Parsec.Newtypes (Token (..), FilePathNT (..), alaList', NoCommaFSep (..))
-- | @source-repository-package@ definition
--
data SourceRepositoryPackage f = SourceRepositoryPackage
{ srpType :: !RepoType
, srpLocation :: !String
, srpTag :: !(Maybe String)
, srpBranch :: !(Maybe String)
, srpSubdir :: !(f FilePath)
}
deriving (Generic)
deriving instance (Eq (f FilePath)) => Eq (SourceRepositoryPackage f)
deriving instance (Ord (f FilePath)) => Ord (SourceRepositoryPackage f)
deriving instance (Show (f FilePath)) => Show (SourceRepositoryPackage f)
deriving instance (Binary (f FilePath)) => Binary (SourceRepositoryPackage f)
-- | Read from @cabal.project@
type SourceRepoList = SourceRepositoryPackage []
-- | Distilled from 'Distribution.Types.SourceRepo.SourceRepo'
type SourceRepoMaybe = SourceRepositoryPackage Maybe
-- | 'SourceRepositoryPackage' without subdir. Used in clone errors. Cloning doesn't care about subdirectory.
type SourceRepoProxy = SourceRepositoryPackage Proxy
srpHoist :: (forall x. f x -> g x) -> SourceRepositoryPackage f -> SourceRepositoryPackage g
srpHoist nt s = s { srpSubdir = nt (srpSubdir s) }
srpToProxy :: SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy s = s { srpSubdir = Proxy }
-- | Split single @source-repository-package@ declaration with multiple subdirs,
-- into multiple ones with at most single subdir.
srpFanOut :: SourceRepositoryPackage [] -> NonEmpty (SourceRepositoryPackage Maybe)
srpFanOut s@SourceRepositoryPackage { srpSubdir = [] } =
s { srpSubdir = Nothing } :| []
srpFanOut s@SourceRepositoryPackage { srpSubdir = d:ds } = f d :| map f ds where
f subdir = s { srpSubdir = Just subdir }
-------------------------------------------------------------------------------
-- Lens
-------------------------------------------------------------------------------
srpTypeLens :: Lens' (SourceRepositoryPackage f) RepoType
srpTypeLens f s = fmap (\x -> s { srpType = x }) (f (srpType s))
{-# INLINE srpTypeLens #-}
srpLocationLens :: Lens' (SourceRepositoryPackage f) String
srpLocationLens f s = fmap (\x -> s { srpLocation = x }) (f (srpLocation s))
{-# INLINE srpLocationLens #-}
srpTagLens :: Lens' (SourceRepositoryPackage f) (Maybe String)
srpTagLens f s = fmap (\x -> s { srpTag = x }) (f (srpTag s))
{-# INLINE srpTagLens #-}
srpBranchLens :: Lens' (SourceRepositoryPackage f) (Maybe String)
srpBranchLens f s = fmap (\x -> s { srpBranch = x }) (f (srpBranch s))
{-# INLINE srpBranchLens #-}
srpSubdirLens :: Lens (SourceRepositoryPackage f) (SourceRepositoryPackage g) (f FilePath) (g FilePath)
srpSubdirLens f s = fmap (\x -> s { srpSubdir = x }) (f (srpSubdir s))
{-# INLINE srpSubdirLens #-}
-------------------------------------------------------------------------------
-- Parser & PPrinter
-------------------------------------------------------------------------------
sourceRepositoryPackageGrammar
:: (FieldGrammar g, Applicative (g SourceRepoList))
=> g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar = SourceRepositoryPackage
<$> uniqueField "type" srpTypeLens
<*> uniqueFieldAla "location" Token srpLocationLens
<*> optionalFieldAla "tag" Token srpTagLens
<*> optionalFieldAla "branch" Token srpBranchLens
<*> monoidalFieldAla "subdir" (alaList' NoCommaFSep FilePathNT) srpSubdirLens -- note: NoCommaFSep is somewhat important for roundtrip, as "." is there...
{-# SPECIALIZE sourceRepositoryPackageGrammar :: ParsecFieldGrammar' SourceRepoList #-}
{-# SPECIALIZE sourceRepositoryPackageGrammar :: PrettyFieldGrammar' SourceRepoList #-}
module Distribution.Client.SourceRepoParse where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Deprecated.ParseUtils (FieldDescr (..), syntaxError)
import Distribution.FieldGrammar.FieldDescrs (fieldDescrsToList)
import Distribution.PackageDescription.FieldGrammar (sourceRepoFieldGrammar)
import Distribution.Parsec (explicitEitherParsec)
import Distribution.Simple.Utils (fromUTF8BS)
import Distribution.Types.SourceRepo (RepoKind (..), SourceRepo)
sourceRepoFieldDescrs :: [FieldDescr SourceRepo]
sourceRepoFieldDescrs =
map toDescr . fieldDescrsToList $ sourceRepoFieldGrammar (RepoKindUnknown "unused")
where
toDescr (name, pretty, parse) = FieldDescr
{ fieldName = fromUTF8BS name
, fieldGet = pretty
, fieldSet = \lineNo str x ->
either (syntaxError lineNo) return
$ explicitEitherParsec (parse x) str
}
......@@ -48,8 +48,8 @@ import Distribution.Types.ComponentName
( ComponentName(..) )
import Distribution.Types.LibraryName
( LibraryName(..) )
import Distribution.Types.SourceRepo
( SourceRepo )
import Distribution.Client.SourceRepo
( SourceRepoMaybe )
import Distribution.Solver.Types.PackageIndex
( PackageIndex )
......@@ -287,7 +287,7 @@ data PackageLocation local =
| RepoTarballPackage Repo PackageId local
-- | A package available from a version control system source repository
| RemoteSourceRepoPackage SourceRepo local
| RemoteSourceRepoPackage SourceRepoMaybe local
deriving (Show, Functor, Eq, Ord, Generic, Typeable)
instance Binary local => Binary (PackageLocation local)
......
{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns, RecordWildCards, RankNTypes #-}
module Distribution.Client.VCS (
-- * VCS driver type
VCS,
vcsRepoType,
vcsProgram,
-- ** Type re-exports
SourceRepo,
RepoType,
RepoKind,
Program,
ConfiguredProgram,
-- * Selecting amongst source repos
selectPackageSourceRepo,
-- * Validating 'SourceRepo's and configuring VCS drivers
validatePDSourceRepo,
validateSourceRepo,
validateSourceRepos,
SourceRepoProblem(..),
......@@ -38,7 +34,8 @@ import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Types.SourceRepo
( SourceRepo(..), RepoType(..), RepoKind(..) )
( RepoType(..) )
import Distribution.Client.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy)
import Distribution.Client.RebuildMonad
( Rebuild, monitorFiles, MonitorFilePath, monitorDirectoryExistence )
import Distribution.Verbosity as Verbosity
......@@ -51,6 +48,7 @@ import Distribution.Simple.Program
, emptyProgramDb, requireProgram )
import Distribution.Version
( mkVersion )
import qualified Distribution.PackageDescription as PD
import Control.Monad
( mapM_ )
......@@ -58,8 +56,6 @@ import Control.Monad.Trans
( liftIO )
import qualified Data.Char as Char
import qualified Data.Map as Map
import Data.Ord
( comparing )
import Data.Either
( partitionEithers )
import System.FilePath
......@@ -80,9 +76,9 @@ data VCS program = VCS {
-- | The program invocation(s) to get\/clone a repository into a fresh
-- local directory.
vcsCloneRepo :: Verbosity
vcsCloneRepo :: forall f. Verbosity
-> ConfiguredProgram
-> SourceRepo
-> SourceRepositoryPackage f
-> FilePath -- Source URI
-> FilePath -- Destination directory
-> [ProgramInvocation],
......@@ -90,9 +86,9 @@ data VCS program = VCS {
-- | 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.
vcsSyncRepos :: Verbosity