Skip to content

Commit 0301b49

Browse files
v0d1chv0d1ch
committed
6432 - Split RepoType into type with known VCS and other
1 parent cf25742 commit 0301b49

File tree

22 files changed

+85
-57
lines changed

22 files changed

+85
-57
lines changed

‎Cabal/Cabal-quickcheck/src/Test/QuickCheck/Instances/Cabal.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -228,7 +228,7 @@ instance Arbitrary Verbosity where
228228
-------------------------------------------------------------------------------
229229

230230
instance Arbitrary RepoType where
231-
arbitrary = elements knownRepoTypes
231+
arbitrary = elements (KnownRepoType <$> knownRepoTypes)
232232

233233
instance Arbitrary RepoKind where
234234
arbitrary = elements [RepoHead, RepoThis]

‎Cabal/Distribution/PackageDescription.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -106,6 +106,7 @@ module Distribution.PackageDescription (
106106
SourceRepo(..),
107107
RepoKind(..),
108108
RepoType(..),
109+
KnownRepoType (..),
109110
knownRepoTypes,
110111
emptySourceRepo,
111112

‎Cabal/Distribution/PackageDescription/Check.hs

Lines changed: 11 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -760,7 +760,7 @@ checkSourceRepos pkg =
760760
PackageDistInexcusable
761761
"The source-repository 'location' is a required field."
762762

763-
, check (repoType repo == Just CVS && isNothing (repoModule repo)) $
763+
, check (repoType repo == Just (KnownRepoType CVS) && isNothing (repoModule repo)) $
764764
PackageDistInexcusable
765765
"For a CVS source-repository, the 'module' is a required field."
766766

@@ -1955,25 +1955,23 @@ checkMissingVcsInfo ops pkg | null (sourceRepos pkg) = do
19551955
else return []
19561956
where
19571957
repoDirnames = [ dirname | repo <- knownRepoTypes
1958-
, dirname <- repoTypeDirname repo ]
1958+
, dirname <- repoTypeDirname repo]
19591959
message = "When distributing packages it is encouraged to specify source "
19601960
++ "control information in the .cabal file using one or more "
19611961
++ "'source-repository' sections. See the Cabal user guide for "
19621962
++ "details."
19631963

19641964
checkMissingVcsInfo _ _ = return []
19651965

1966-
repoTypeDirname :: RepoType -> [FilePath]
1967-
repoTypeDirname Darcs = ["_darcs"]
1968-
repoTypeDirname Git = [".git"]
1969-
repoTypeDirname SVN = [".svn"]
1970-
repoTypeDirname CVS = ["CVS"]
1971-
repoTypeDirname Mercurial = [".hg"]
1972-
repoTypeDirname GnuArch = [".arch-params"]
1973-
repoTypeDirname Bazaar = [".bzr"]
1974-
repoTypeDirname Monotone = ["_MTN"]
1975-
repoTypeDirname _ = []
1976-
1966+
repoTypeDirname :: KnownRepoType -> [FilePath]
1967+
repoTypeDirname Darcs = ["_darcs"]
1968+
repoTypeDirname Git = [".git"]
1969+
repoTypeDirname SVN = [".svn"]
1970+
repoTypeDirname CVS = ["CVS"]
1971+
repoTypeDirname Mercurial = [".hg"]
1972+
repoTypeDirname GnuArch = [".arch-params"]
1973+
repoTypeDirname Bazaar = [".bzr"]
1974+
repoTypeDirname Monotone = ["_MTN"]
19771975

19781976
-- ------------------------------------------------------------
19791977
-- * Checks involving files in the package

‎Cabal/Distribution/Types/SourceRepo.hs

Lines changed: 42 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ module Distribution.Types.SourceRepo (
55
SourceRepo(..),
66
RepoKind(..),
77
RepoType(..),
8+
KnownRepoType (..),
89
knownRepoTypes,
910
emptySourceRepo,
1011
classifyRepoType,
@@ -19,9 +20,11 @@ import Distribution.Utils.Generic (lowercase)
1920
import Distribution.Pretty
2021
import Distribution.Parsec
2122
import Distribution.FieldGrammar.Described
23+
import Data.Map.Strict (Map)
2224

2325
import qualified Distribution.Compat.CharParsing as P
2426
import qualified Text.PrettyPrint as Disp
27+
import qualified Data.Map.Strict as M
2528

2629
-- ------------------------------------------------------------
2730
-- * Source repos
@@ -123,20 +126,37 @@ instance NFData RepoKind where rnf = genericRnf
123126
-- 'SourceRepo' depend on the type of repo. The tools and methods used to
124127
-- obtain and track the repo depend on the repo type.
125128
--
126-
data RepoType = Darcs | Git | SVN | CVS
127-
| Mercurial | GnuArch | Bazaar | Monotone
129+
data KnownRepoType = Darcs | Git | SVN | CVS
130+
| Mercurial | GnuArch | Bazaar | Monotone
131+
deriving (Eq, Generic, Ord, Read, Show, Typeable, Data, Enum, Bounded)
132+
133+
instance Binary KnownRepoType
134+
instance Structured KnownRepoType
135+
instance NFData KnownRepoType where rnf = genericRnf
136+
137+
instance Parsec KnownRepoType where
138+
parsec = do
139+
str <- P.munch1 isIdent
140+
maybe
141+
(P.unexpected $ "Could not parse KnownRepoType from " ++ str)
142+
return
143+
(M.lookup str knownRepoTypeMap)
144+
145+
instance Pretty KnownRepoType where
146+
pretty = Disp.text . lowercase . show
147+
148+
data RepoType = KnownRepoType KnownRepoType
128149
| OtherRepoType String
129150
deriving (Eq, Generic, Ord, Read, Show, Typeable, Data)
130151

131152
instance Binary RepoType
132153
instance Structured RepoType
133154
instance NFData RepoType where rnf = genericRnf
134155

135-
knownRepoTypes :: [RepoType]
136-
knownRepoTypes = [Darcs, Git, SVN, CVS
137-
,Mercurial, GnuArch, Bazaar, Monotone]
156+
knownRepoTypes :: [KnownRepoType]
157+
knownRepoTypes = [minBound .. maxBound]
138158

139-
repoTypeAliases :: RepoType -> [String]
159+
repoTypeAliases :: KnownRepoType -> [String]
140160
repoTypeAliases Bazaar = ["bzr"]
141161
repoTypeAliases Mercurial = ["hg"]
142162
repoTypeAliases GnuArch = ["arch"]
@@ -156,23 +176,30 @@ classifyRepoKind name = case lowercase name of
156176
"this" -> RepoThis
157177
_ -> RepoKindUnknown name
158178

159-
instance Pretty RepoType where
160-
pretty (OtherRepoType other) = Disp.text other
161-
pretty other = Disp.text (lowercase (show other))
162-
163179
instance Parsec RepoType where
164180
parsec = classifyRepoType <$> P.munch1 isIdent
165181

166182
instance Described RepoType where
167183
describe _ = reMunch1CS $ csAlphaNum <> csChar '_' <> csChar '-'
168184

185+
instance Pretty RepoType where
186+
pretty (OtherRepoType other) = Disp.text other
187+
pretty (KnownRepoType t) = pretty t
188+
169189
classifyRepoType :: String -> RepoType
170190
classifyRepoType s =
171-
fromMaybe (OtherRepoType s) $ lookup (lowercase s) repoTypeMap
172-
where
173-
repoTypeMap = [ (name, repoType')
174-
| repoType' <- knownRepoTypes
175-
, name <- prettyShow repoType' : repoTypeAliases repoType' ]
191+
maybe
192+
(OtherRepoType s)
193+
KnownRepoType
194+
(M.lookup (lowercase s) knownRepoTypeMap)
195+
196+
knownRepoTypeMap :: Map String KnownRepoType
197+
knownRepoTypeMap =
198+
M.fromList
199+
[ (name, repoType')
200+
| repoType' <- knownRepoTypes
201+
, name <- prettyShow repoType' : repoTypeAliases repoType'
202+
]
176203

177204
isIdent :: Char -> Bool
178205
isIdent c = isAlphaNum c || c == '_' || c == '-'

‎Cabal/tests/Instances/TreeDiff.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -87,6 +87,7 @@ instance ToExpr PackageIdentifier
8787
instance ToExpr PackageName where toExpr = defaultExprViaShow
8888
instance ToExpr PkgconfigDependency where toExpr = defaultExprViaShow
8989
instance ToExpr RepoKind
90+
instance ToExpr KnownRepoType
9091
instance ToExpr RepoType
9192
instance ToExpr SetupBuildInfo
9293
instance ToExpr SourceRepo

‎Cabal/tests/ParserTests/regressions/Octree-0.5.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -317,7 +317,7 @@ GenericPackageDescription
317317
repoModule = Nothing,
318318
repoSubdir = Nothing,
319319
repoTag = Nothing,
320-
repoType = Just Git}],
320+
repoType = Just (KnownRepoType Git)}],
321321
specVersionRaw = Right (OrLaterVersion `mkVersion [1,8]`),
322322
stability = "beta",
323323
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/common-conditional.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -624,7 +624,7 @@ GenericPackageDescription
624624
repoModule = Nothing,
625625
repoSubdir = Nothing,
626626
repoTag = Nothing,
627-
repoType = Just Git}],
627+
repoType = Just (KnownRepoType Git)}],
628628
specVersionRaw = Left `mkVersion [2,6]`,
629629
stability = "",
630630
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/common.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -163,7 +163,7 @@ GenericPackageDescription
163163
repoModule = Nothing,
164164
repoSubdir = Nothing,
165165
repoTag = Nothing,
166-
repoType = Just Git}],
166+
repoType = Just (KnownRepoType Git)}],
167167
specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`),
168168
stability = "",
169169
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/common2.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -652,7 +652,7 @@ GenericPackageDescription
652652
repoModule = Nothing,
653653
repoSubdir = Nothing,
654654
repoTag = Nothing,
655-
repoType = Just Git}],
655+
repoType = Just (KnownRepoType Git)}],
656656
specVersionRaw = Left `mkVersion [2,1]`,
657657
stability = "",
658658
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/common3.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -187,7 +187,7 @@ GenericPackageDescription
187187
repoModule = Nothing,
188188
repoSubdir = Nothing,
189189
repoTag = Nothing,
190-
repoType = Just Git}],
190+
repoType = Just (KnownRepoType Git)}],
191191
specVersionRaw = Left `mkVersion [2,2]`,
192192
stability = "",
193193
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/elif.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -165,7 +165,7 @@ GenericPackageDescription
165165
repoModule = Nothing,
166166
repoSubdir = Nothing,
167167
repoTag = Nothing,
168-
repoType = Just Git}],
168+
repoType = Just (KnownRepoType Git)}],
169169
specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`),
170170
stability = "",
171171
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/elif2.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -361,7 +361,7 @@ GenericPackageDescription
361361
repoModule = Nothing,
362362
repoSubdir = Nothing,
363363
repoTag = Nothing,
364-
repoType = Just Git}],
364+
repoType = Just (KnownRepoType Git)}],
365365
specVersionRaw = Left `mkVersion [2,1]`,
366366
stability = "",
367367
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/generics-sop.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -725,7 +725,7 @@ GenericPackageDescription
725725
repoModule = Nothing,
726726
repoSubdir = Nothing,
727727
repoTag = Nothing,
728-
repoType = Just Git}],
728+
repoType = Just (KnownRepoType Git)}],
729729
specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`),
730730
stability = "",
731731
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/jaeger-flamegraph.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -382,7 +382,7 @@ GenericPackageDescription
382382
repoModule = Nothing,
383383
repoSubdir = Nothing,
384384
repoTag = Nothing,
385-
repoType = Just Git}],
385+
repoType = Just (KnownRepoType Git)}],
386386
specVersionRaw = Left `mkVersion [2,2]`,
387387
stability = "",
388388
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/nothing-unicode.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -161,7 +161,7 @@ GenericPackageDescription
161161
repoModule = Nothing,
162162
repoSubdir = Nothing,
163163
repoTag = Nothing,
164-
repoType = Just Git}],
164+
repoType = Just (KnownRepoType Git)}],
165165
specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`),
166166
stability = "",
167167
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/shake.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2132,7 +2132,7 @@ GenericPackageDescription
21322132
repoModule = Nothing,
21332133
repoSubdir = Nothing,
21342134
repoTag = Nothing,
2135-
repoType = Just Git}],
2135+
repoType = Just (KnownRepoType Git)}],
21362136
specVersionRaw = Right (OrLaterVersion `mkVersion [1,18]`),
21372137
stability = "",
21382138
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/th-lift-instances.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -508,7 +508,7 @@ GenericPackageDescription
508508
repoModule = Nothing,
509509
repoSubdir = Nothing,
510510
repoTag = Nothing,
511-
repoType = Just Git}],
511+
repoType = Just (KnownRepoType Git)}],
512512
specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`),
513513
stability = "experimental",
514514
subLibraries = [],

‎Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -194,7 +194,7 @@ GenericPackageDescription
194194
repoModule = Nothing,
195195
repoSubdir = Nothing,
196196
repoTag = Nothing,
197-
repoType = Just Git}],
197+
repoType = Just (KnownRepoType Git)}],
198198
specVersionRaw = Right (OrLaterVersion `mkVersion [1,6]`),
199199
stability = "",
200200
subLibraries = [],

‎Cabal/tests/UnitTests/Distribution/Utils/Structured.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,6 @@ tests = testGroup "Distribution.Utils.Structured"
2323
, testCase "SPDX.License" $ structureHash (Proxy :: Proxy License) @?= Fingerprint 0xd3d4a09f517f9f75 0xbc3d16370d5a853a
2424
-- The difference is in encoding of newtypes
2525
#if MIN_VERSION_base(4,7,0)
26-
, testCase "LocalBuildInfo" $ structureHash (Proxy :: Proxy LocalBuildInfo) @?= Fingerprint 0x2b983b5312a676b1 0x3edb7b476c2fd11e
26+
, testCase "LocalBuildInfo" $ structureHash (Proxy :: Proxy LocalBuildInfo) @?= Fingerprint 0xe2909c4dccc1d2de 0xa065d96aa3d0d915
2727
#endif
2828
]

‎cabal-install/Distribution/Client/VCS.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ import Prelude ()
3434
import Distribution.Client.Compat.Prelude
3535

3636
import Distribution.Types.SourceRepo
37-
( RepoType(..) )
37+
( RepoType(..), KnownRepoType (..) )
3838
import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy)
3939
import Distribution.Client.RebuildMonad
4040
( Rebuild, monitorFiles, MonitorFilePath, monitorDirectoryExistence )
@@ -234,7 +234,7 @@ knownVCSs = Map.fromList [ (vcsRepoType vcs, vcs) | vcs <- vcss ]
234234
vcsBzr :: VCS Program
235235
vcsBzr =
236236
VCS {
237-
vcsRepoType = Bazaar,
237+
vcsRepoType = KnownRepoType Bazaar,
238238
vcsProgram = bzrProgram,
239239
vcsCloneRepo,
240240
vcsSyncRepos
@@ -280,7 +280,7 @@ bzrProgram = (simpleProgram "bzr") {
280280
vcsDarcs :: VCS Program
281281
vcsDarcs =
282282
VCS {
283-
vcsRepoType = Darcs,
283+
vcsRepoType = KnownRepoType Darcs,
284284
vcsProgram = darcsProgram,
285285
vcsCloneRepo,
286286
vcsSyncRepos
@@ -325,7 +325,7 @@ darcsProgram = (simpleProgram "darcs") {
325325
vcsGit :: VCS Program
326326
vcsGit =
327327
VCS {
328-
vcsRepoType = Git,
328+
vcsRepoType = KnownRepoType Git,
329329
vcsProgram = gitProgram,
330330
vcsCloneRepo,
331331
vcsSyncRepos
@@ -418,7 +418,7 @@ gitProgram = (simpleProgram "git") {
418418
vcsHg :: VCS Program
419419
vcsHg =
420420
VCS {
421-
vcsRepoType = Mercurial,
421+
vcsRepoType = KnownRepoType Mercurial,
422422
vcsProgram = hgProgram,
423423
vcsCloneRepo,
424424
vcsSyncRepos
@@ -464,7 +464,7 @@ hgProgram = (simpleProgram "hg") {
464464
vcsSvn :: VCS Program
465465
vcsSvn =
466466
VCS {
467-
vcsRepoType = SVN,
467+
vcsRepoType = KnownRepoType SVN,
468468
vcsProgram = svnProgram,
469469
vcsCloneRepo,
470470
vcsSyncRepos

0 commit comments

Comments
 (0)