Skip to content

Commit 90b14ae

Browse files
phadejphadej
committed
Add buildinfo-reference-generator
Note all Described instances are implemented. This is just a start.
1 parent c0dc305 commit 90b14ae

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

46 files changed

+2226
-40
lines changed

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

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,16 +3,30 @@
33
module Test.QuickCheck.Instances.Cabal () where
44

55
import Control.Applicative (liftA2)
6+
import Data.Char (isAlphaNum, isDigit)
7+
import Data.List (intercalate)
68
import Test.QuickCheck
79

810
import Distribution.SPDX
911
import Distribution.Version
12+
import Distribution.Types.PackageName
1013
import Distribution.Types.VersionRange.Internal
1114

1215
#if !MIN_VERSION_base(4,8,0)
1316
import Control.Applicative (pure, (<$>), (<*>))
1417
#endif
1518

19+
-------------------------------------------------------------------------------
20+
-- PackageName
21+
-------------------------------------------------------------------------------
22+
23+
instance Arbitrary PackageName where
24+
arbitrary = mkPackageName . intercalate "-" <$> shortListOf1 2 nameComponent
25+
where
26+
nameComponent = shortListOf1 5 (elements packageChars)
27+
`suchThat` (not . all isDigit)
28+
packageChars = filter isAlphaNum ['\0'..'\127']
29+
1630
-------------------------------------------------------------------------------
1731
-- Version
1832
-------------------------------------------------------------------------------
@@ -150,3 +164,11 @@ instance Arbitrary LicenseExpression where
150164
shrink (EOr a b) = a : b : map (uncurry EOr) (shrink (a, b))
151165
shrink _ = []
152166

167+
-------------------------------------------------------------------------------
168+
-- Helpers
169+
-------------------------------------------------------------------------------
170+
171+
shortListOf1 :: Int -> Gen a -> Gen [a]
172+
shortListOf1 bound gen = sized $ \n -> do
173+
k <- choose (1, 1 `max` ((n `div` 2) `min` bound))
174+
vectorOf k gen

‎Cabal/Cabal.cabal

Lines changed: 18 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -303,6 +303,9 @@ library
303303
-- already depends on `fail` and `semigroups` transitively
304304
build-depends: fail == 4.9.*, semigroups >= 0.18.3 && < 0.20
305305

306+
if !impl(ghc >= 7.10)
307+
build-depends: void >= 0.7.3 && < 0.8
308+
306309
if !impl(ghc >= 7.8)
307310
-- semigroups depends on tagged.
308311
build-depends: tagged >=0.8.6 && <0.9
@@ -481,6 +484,8 @@ library
481484
Distribution.Types.VersionInterval
482485
Distribution.Types.GivenComponent
483486
Distribution.Types.PackageVersionConstraint
487+
Distribution.Utils.CharSet
488+
Distribution.Utils.Regex
484489
Distribution.Utils.Generic
485490
Distribution.Utils.NubList
486491
Distribution.Utils.ShortText
@@ -504,6 +509,7 @@ library
504509
Distribution.Compat.CharParsing
505510
Distribution.FieldGrammar
506511
Distribution.FieldGrammar.Class
512+
Distribution.FieldGrammar.Described
507513
Distribution.FieldGrammar.FieldDescrs
508514
Distribution.FieldGrammar.Parsec
509515
Distribution.FieldGrammar.Pretty
@@ -614,13 +620,15 @@ test-suite unit-tests
614620
UnitTests.Distribution.Compat.CreatePipe
615621
UnitTests.Distribution.Compat.Graph
616622
UnitTests.Distribution.Compat.Time
623+
UnitTests.Distribution.Described
617624
UnitTests.Distribution.Simple.Glob
618625
UnitTests.Distribution.Simple.Program.GHC
619626
UnitTests.Distribution.Simple.Program.Internal
620627
UnitTests.Distribution.Simple.Utils
621628
UnitTests.Distribution.SPDX
622629
UnitTests.Distribution.System
623630
UnitTests.Distribution.Types.GenericPackageDescription
631+
UnitTests.Distribution.Utils.CharSet
624632
UnitTests.Distribution.Utils.Generic
625633
UnitTests.Distribution.Utils.NubList
626634
UnitTests.Distribution.Utils.ShortText
@@ -644,6 +652,7 @@ test-suite unit-tests
644652
directory,
645653
filepath,
646654
integer-logarithms >= 1.0.2 && <1.1,
655+
rere >=0.1 && <0.2,
647656
tasty >= 1.2.3 && < 1.3,
648657
tasty-hunit,
649658
tasty-quickcheck,
@@ -657,6 +666,14 @@ test-suite unit-tests
657666
ghc-options: -Wall
658667
default-language: Haskell2010
659668

669+
if !impl(ghc >= 7.10)
670+
build-depends: void
671+
672+
-- Cabal-quickcheck
673+
hs-source-dirs: Cabal-quickcheck/src
674+
other-modules:
675+
Test.QuickCheck.Instances.Cabal
676+
660677
test-suite parser-tests
661678
type: exitcode-stdio-1.0
662679
hs-source-dirs: tests
@@ -677,7 +694,7 @@ test-suite parser-tests
677694
default-language: Haskell2010
678695

679696
if !impl(ghc >= 8.0)
680-
build-depends: semigroups
697+
build-depends: semigroups
681698

682699
if impl(ghc >= 7.8)
683700
build-depends:

‎Cabal/Distribution/Compat/Prelude.hs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE TypeOperators #-}
33
{-# LANGUAGE RankNTypes #-}
44
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE Trustworthy #-}
56

67
#ifdef MIN_VERSION_base
78
#define MINVER_base_411 MIN_VERSION_base(4,11,0)
@@ -48,6 +49,7 @@ module Distribution.Compat.Prelude (
4849
Set,
4950
Identity (..),
5051
Proxy (..),
52+
Void,
5153

5254
-- * Data.Maybe
5355
catMaybes, mapMaybe,
@@ -92,6 +94,9 @@ module Distribution.Compat.Prelude (
9294
chr, ord,
9395
toLower, toUpper,
9496

97+
-- * Data.Void
98+
absurd, vacuous,
99+
95100
-- * Data.Word & Data.Int
96101
Word,
97102
Word8, Word16, Word32, Word64,
@@ -160,6 +165,7 @@ import Data.Maybe
160165
import Data.String (IsString (..))
161166
import Data.Int
162167
import Data.Word
168+
import Data.Void (Void, absurd, vacuous)
163169
import Text.Read (readMaybe)
164170

165171
import qualified Text.PrettyPrint as Disp

‎Cabal/Distribution/FieldGrammar/Class.hs

Lines changed: 11 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -11,11 +11,10 @@ import Distribution.Compat.Lens
1111
import Distribution.Compat.Prelude
1212
import Prelude ()
1313

14-
import Distribution.CabalSpecVersion (CabalSpecVersion)
15-
import Distribution.Compat.Newtype (Newtype)
14+
import Distribution.CabalSpecVersion (CabalSpecVersion)
15+
import Distribution.Compat.Newtype (Newtype)
16+
import Distribution.FieldGrammar.Described (Described)
1617
import Distribution.Fields.Field
17-
import Distribution.Parsec (Parsec)
18-
import Distribution.Pretty (Pretty)
1918
import Distribution.Utils.ShortText
2019

2120
-- | 'FieldGrammar' is parametrised by
@@ -33,7 +32,7 @@ class FieldGrammar g where
3332

3433
-- | Field which should be defined, exactly once.
3534
uniqueFieldAla
36-
:: (Parsec b, Pretty b, Newtype a b)
35+
:: (Described b, Newtype a b)
3736
=> FieldName -- ^ field name
3837
-> (a -> b) -- ^ 'Newtype' pack
3938
-> ALens' s a -- ^ lens into the field
@@ -48,15 +47,15 @@ class FieldGrammar g where
4847

4948
-- | Optional field.
5049
optionalFieldAla
51-
:: (Parsec b, Pretty b, Newtype a b)
50+
:: (Described b, Newtype a b)
5251
=> FieldName -- ^ field name
5352
-> (a -> b) -- ^ 'pack'
5453
-> ALens' s (Maybe a) -- ^ lens into the field
5554
-> g s (Maybe a)
5655

5756
-- | Optional field with default value.
5857
optionalFieldDefAla
59-
:: (Parsec b, Pretty b, Newtype a b, Eq a)
58+
:: (Described b, Newtype a b, Eq a)
6059
=> FieldName -- ^ field name
6160
-> (a -> b) -- ^ 'Newtype' pack
6261
-> ALens' s a -- ^ @'Lens'' s a@: lens into the field
@@ -94,7 +93,7 @@ class FieldGrammar g where
9493
-- /Note:/ 'optionalFieldAla' is a @monoidalField@ with 'Last' monoid.
9594
--
9695
monoidalFieldAla
97-
:: (Parsec b, Pretty b, Monoid a, Newtype a b)
96+
:: (Described b, Monoid a, Newtype a b)
9897
=> FieldName -- ^ field name
9998
-> (a -> b) -- ^ 'pack'
10099
-> ALens' s a -- ^ lens into the field
@@ -135,23 +134,23 @@ class FieldGrammar g where
135134

136135
-- | Field which can be defined at most once.
137136
uniqueField
138-
:: (FieldGrammar g, Parsec a, Pretty a)
137+
:: (FieldGrammar g, Described a)
139138
=> FieldName -- ^ field name
140139
-> ALens' s a -- ^ lens into the field
141140
-> g s a
142141
uniqueField fn = uniqueFieldAla fn Identity
143142

144143
-- | Field which can be defined at most once.
145144
optionalField
146-
:: (FieldGrammar g, Parsec a, Pretty a)
145+
:: (FieldGrammar g, Described a)
147146
=> FieldName -- ^ field name
148147
-> ALens' s (Maybe a) -- ^ lens into the field
149148
-> g s (Maybe a)
150149
optionalField fn = optionalFieldAla fn Identity
151150

152151
-- | Optional field with default value.
153152
optionalFieldDef
154-
:: (FieldGrammar g, Functor (g s), Parsec a, Pretty a, Eq a)
153+
:: (FieldGrammar g, Functor (g s), Described a, Eq a)
155154
=> FieldName -- ^ field name
156155
-> ALens' s a -- ^ @'Lens'' s a@: lens into the field
157156
-> a -- ^ default value
@@ -160,7 +159,7 @@ optionalFieldDef fn = optionalFieldDefAla fn Identity
160159

161160
-- | Field which can be define multiple times, and the results are @mappend@ed.
162161
monoidalField
163-
:: (FieldGrammar g, Parsec a, Pretty a, Monoid a)
162+
:: (FieldGrammar g, Described a, Monoid a)
164163
=> FieldName -- ^ field name
165164
-> ALens' s a -- ^ lens into the field
166165
-> g s a

‎Cabal/Distribution/FieldGrammar/Described.hs

Lines changed: 135 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,135 @@
1+
{-# LANGUAGE DeriveFoldable #-}
2+
{-# LANGUAGE DeriveFunctor #-}
3+
{-# LANGUAGE DeriveTraversable #-}
4+
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE ScopedTypeVariables #-}
6+
module Distribution.FieldGrammar.Described (
7+
Described (..),
8+
describeDoc,
9+
-- * Regular expressions
10+
Regex (..),
11+
reEps,
12+
reChar,
13+
reChars,
14+
reMunchCS,
15+
reMunch1CS,
16+
-- * Variables
17+
reVar0,
18+
reVar1,
19+
-- * Special expressions
20+
reDot,
21+
reComma,
22+
reSpacedComma,
23+
reHsString,
24+
reUnqualComponent,
25+
-- * Lists
26+
reSpacedList,
27+
reCommaList,
28+
reOptCommaList,
29+
-- * Character Sets
30+
csChar,
31+
csAlphaNum,
32+
csNotSpace,
33+
csNotSpaceOrComma,
34+
) where
35+
36+
import Distribution.Compat.Prelude
37+
import Prelude ()
38+
39+
import Distribution.Parsec (Parsec)
40+
import Distribution.Pretty (Pretty)
41+
42+
import Distribution.Utils.Regex
43+
44+
import qualified Distribution.Utils.CharSet as CS
45+
import qualified Text.PrettyPrint as PP
46+
47+
-- | Class describing the pretty/parsec format of a.
48+
class (Pretty a, Parsec a) => Described a where
49+
-- | A pretty document of "regex" describing the field format
50+
describe :: proxy a -> Regex void
51+
52+
-- | Pretty-print description.
53+
--
54+
-- >>> describeDoc ([] :: [Bool])
55+
-- \left\{ \mathop{\mathord{``}\mathtt{True}\mathord{"}}\mid\mathop{\mathord{``}\mathtt{False}\mathord{"}} \right\}
56+
--
57+
describeDoc :: Described a => proxy a -> PP.Doc
58+
describeDoc p = regexDoc (describe p)
59+
60+
instance Described Bool where
61+
describe _ = REUnion ["True", "False"]
62+
63+
instance Described a => Described (Identity a) where
64+
describe _ = describe ([] :: [a])
65+
66+
-------------------------------------------------------------------------------
67+
-- Lists
68+
------------------------------------------------------------------------------
69+
70+
reSpacedList :: Regex a -> Regex a
71+
reSpacedList = REMunch RESpaces1
72+
73+
reCommaList :: Regex a -> Regex a
74+
reCommaList = RECommaList
75+
76+
reOptCommaList :: Regex a -> Regex a
77+
reOptCommaList = REOptCommaList
78+
79+
-------------------------------------------------------------------------------
80+
-- Specific grammars
81+
-------------------------------------------------------------------------------
82+
83+
reHsString :: Regex a
84+
reHsString = RENamed "hs-string" impl where
85+
impl = reChar '"' <> REMunch reEps (REUnion [strChar, escChar]) <> reChar '"'
86+
strChar = RECharSet $ CS.difference CS.universe (CS.fromList "\"\\")
87+
88+
escChar = REUnion
89+
[ "\\&"
90+
, "\\\\"
91+
, REUnion ["\\n", RENamed "escapes" "\\n"] -- TODO
92+
, "\\" <> RECharSet "0123456789"
93+
, "\\o" <> RECharSet "01234567"
94+
, "\\x" <> RECharSet "0123456789abcdefABCDEF"
95+
, REUnion ["\\^@", RENamed "control" "\\^@"] -- TODO
96+
, REUnion ["\\NUL", RENamed "ascii" "\\NUL"] -- TODO
97+
]
98+
99+
reUnqualComponent :: Regex a
100+
reUnqualComponent = RENamed "unqual-name" $
101+
REMunch1 (reChar '-') component
102+
where
103+
component
104+
= REMunch reEps (RECharSet csAlphaNum)
105+
-- currently the parser accepts "csAlphaNum `difference` "0123456789"
106+
-- which is larger set than CS.alpha
107+
--
108+
-- Hackage rejects non ANSI names, so it's not so relevant.
109+
<> RECharSet CS.alpha
110+
<> REMunch reEps (RECharSet csAlphaNum)
111+
112+
reDot :: Regex a
113+
reDot = reChar '.'
114+
115+
reComma :: Regex a
116+
reComma = reChar ','
117+
118+
reSpacedComma :: Regex a
119+
reSpacedComma = RESpaces <> reComma <> RESpaces
120+
121+
-------------------------------------------------------------------------------
122+
-- Character sets
123+
-------------------------------------------------------------------------------
124+
125+
csChar :: Char -> CS.CharSet
126+
csChar = CS.singleton
127+
128+
csAlphaNum :: CS.CharSet
129+
csAlphaNum = CS.alphanum
130+
131+
csNotSpace :: CS.CharSet
132+
csNotSpace = CS.difference CS.universe $ CS.singleton ' '
133+
134+
csNotSpaceOrComma :: CS.CharSet
135+
csNotSpaceOrComma = CS.difference csNotSpace $ CS.singleton ','

‎Cabal/Distribution/ModuleName.hs

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,10 +26,11 @@ module Distribution.ModuleName (
2626
import Distribution.Compat.Prelude
2727
import Prelude ()
2828

29+
import Distribution.FieldGrammar.Described
2930
import Distribution.Parsec
3031
import Distribution.Pretty
31-
import Distribution.Utils.ShortText (ShortText, fromShortText, toShortText)
32-
import System.FilePath (pathSeparator)
32+
import Distribution.Utils.ShortText (ShortText, fromShortText, toShortText)
33+
import System.FilePath (pathSeparator)
3334

3435
import qualified Distribution.Compat.CharParsing as P
3536
import qualified Text.PrettyPrint as Disp
@@ -57,6 +58,9 @@ instance Parsec ModuleName where
5758
cs <- P.munch validModuleChar
5859
return (c:cs)
5960

61+
instance Described ModuleName where
62+
describe _ = RETodo
63+
6064
validModuleChar :: Char -> Bool
6165
validModuleChar c = isAlphaNum c || c == '_' || c == '\''
6266

0 commit comments

Comments
 (0)