Commit 28c9fd81 authored by Francesco Gazzetta's avatar Francesco Gazzetta Committed by GitHub
Browse files

Merge branch 'master' into new-exec/1

parents 442bb913 37300936
......@@ -3,5 +3,6 @@ Please include the following checklist in your PR:
* [ ] Patches conform to the [coding conventions](https://github.com/haskell/cabal/#conventions).
* [ ] Any changes that could be relevant to users have been recorded in the changelog.
* [ ] The documentation has been updated, if necessary.
* [ ] If the change is docs-only, `[ci skip]` is used to avoid triggering the build bots.
Please also shortly describe how you tested your change. Bonus points for added tests!
......@@ -47,16 +47,13 @@ matrix:
- env: GHCVER=7.10.3 SCRIPT=script USE_GOLD=YES
os: linux
sudo: required
- env: GHCVER=8.0.2 SCRIPT=script DEPLOY_DOCS=YES USE_GOLD=YES
- env: GHCVER=8.0.2 SCRIPT=script DEPLOY_DOCS=YES USE_GOLD=YES TEST_SOLVER_BENCHMARKS=YES
sudo: required
os: linux
- env: GHCVER=8.0.2 SCRIPT=solver-debug-flags USE_GOLD=YES
sudo: required
os: linux
- env: GHCVER=8.0.2 SCRIPT=script PARSEC=YES TAGSUFFIX="-parsec" USE_GOLD=YES
os: linux
sudo: required
- env: GHCVER=8.0.2 SCRIPT=script DEBUG_EXPENSIVE_ASSERTIONS=YES TAGSUFFIX="-fdebug-expensive-assertions" USE_GOLD=YES
os: linux
sudo: required
......
......@@ -32,6 +32,13 @@ extra-source-files:
-- Generated with 'misc/gen-extra-source-files.sh'
-- Do NOT edit this section manually; instead, run the script.
-- BEGIN gen-extra-source-files
tests/ParserTests/regressions/Octree-0.5.cabal
tests/ParserTests/regressions/elif.cabal
tests/ParserTests/regressions/encoding-0.8.cabal
tests/ParserTests/regressions/generics-sop.cabal
tests/ParserTests/regressions/issue-774.cabal
tests/ParserTests/regressions/nothing-unicode.cabal
tests/ParserTests/regressions/shake.cabal
tests/ParserTests/warnings/bom.cabal
tests/ParserTests/warnings/bool.cabal
tests/ParserTests/warnings/deprecatedfield.cabal
......@@ -64,11 +71,6 @@ flag old-directory
description: Use directory < 1.2 and old-time
default: False
flag parsec
description: Use parsec parser
default: False
manual: True
flag parsec-struct-diff
description: Use StructDiff in parsec tests. Affects only parsec tests.
default: False
......@@ -135,6 +137,7 @@ library
Distribution.Compat.Graph
Distribution.Compat.Internal.TempFile
Distribution.Compat.Map.Strict
Distribution.Compat.Newtype
Distribution.Compat.Prelude.Internal
Distribution.Compat.ReadP
Distribution.Compat.Semigroup
......@@ -210,6 +213,7 @@ library
Distribution.System
Distribution.TestSuite
Distribution.Text
Distribution.Pretty
Distribution.Types.AbiHash
Distribution.Types.AnnotatedId
Distribution.Types.Benchmark
......@@ -267,26 +271,44 @@ library
Language.Haskell.Extension
Distribution.Compat.Binary
if flag(parsec)
cpp-options: -DCABAL_PARSEC
build-depends:
transformers,
parsec >= 3.1.9 && <3.2
build-tools:
alex >=3.1.4 && <3.3
exposed-modules:
Distribution.Compat.Parsec
Distribution.PackageDescription.Parsec
Distribution.PackageDescription.Parsec.FieldDescr
Distribution.Parsec.Class
Distribution.Parsec.ConfVar
Distribution.Parsec.Lexer
Distribution.Parsec.LexerMonad
Distribution.Parsec.Parser
Distribution.Parsec.Types.Common
Distribution.Parsec.Types.Field
Distribution.Parsec.Types.FieldDescr
Distribution.Parsec.Types.ParseResult
-- Parsec parser relatedmodules
build-depends:
transformers,
parsec >= 3.1.9 && <3.2
exposed-modules:
Distribution.Compat.Parsec
Distribution.FieldGrammar
Distribution.FieldGrammar.Class
Distribution.FieldGrammar.Parsec
Distribution.FieldGrammar.Pretty
Distribution.PackageDescription.FieldGrammar
Distribution.PackageDescription.Parsec
Distribution.PackageDescription.Quirks
Distribution.Parsec.Class
Distribution.Parsec.Common
Distribution.Parsec.ConfVar
Distribution.Parsec.Field
Distribution.Parsec.Lexer
Distribution.Parsec.LexerMonad
Distribution.Parsec.Newtypes
Distribution.Parsec.ParseResult
Distribution.Parsec.Parser
-- Lens functionality
exposed-modules:
Distribution.Compat.Lens
Distribution.Types.Lens
Distribution.Types.Benchmark.Lens
Distribution.Types.BuildInfo.Lens
Distribution.Types.Executable.Lens
Distribution.Types.ForeignLib.Lens
Distribution.Types.GenericPackageDescription.Lens
Distribution.Types.Library.Lens
Distribution.Types.PackageDescription.Lens
Distribution.Types.PackageId.Lens
Distribution.Types.SetupBuildInfo.Lens
Distribution.Types.SourceRepo.Lens
Distribution.Types.TestSuite.Lens
other-modules:
Distribution.Backpack.PreExistingComponent
......@@ -382,12 +404,10 @@ test-suite unit-tests
default-language: Haskell2010
test-suite parser-tests
if !flag(parsec)
buildable: False
type: exitcode-stdio-1.0
hs-source-dirs: tests
main-is: ParserTests.hs
build-depends: containers
build-depends:
base,
bytestring,
......@@ -395,20 +415,40 @@ test-suite parser-tests
tasty,
tasty-hunit,
tasty-quickcheck,
tasty-golden >=2.3.1.1 && <2.4,
Diff >=0.3.4 && <0.4,
Cabal
ghc-options: -Wall
default-language: Haskell2010
test-suite parser-hackage-tests
if !flag(parsec)
buildable: False
test-suite check-tests
type: exitcode-stdio-1.0
hs-source-dirs: tests
main-is: CheckTests.hs
build-depends:
base,
bytestring,
filepath,
tasty,
tasty-golden >=2.3.1.1 && <2.4,
Diff >=0.3.4 && <0.4,
Cabal
ghc-options: -Wall
default-language: Haskell2010
test-suite parser-hackage-tests
type: exitcode-stdio-1.0
main-is: ParserHackageTests.hs
-- TODO: need to get 01-index.tar on appveyor
if os(windows)
buildable: False
hs-source-dirs: tests
build-depends:
base,
base-orphans == 0.6.*,
base-compat >=0.9.3 && <0.10,
containers,
tar >=0.5 && <0.6,
bytestring,
......@@ -418,7 +458,7 @@ test-suite parser-hackage-tests
if flag(parsec-struct-diff)
build-depends:
generics-sop ==0.2.*,
generics-sop >= 0.3.1.0 && <0.4,
these >=0.7.1 && <0.8,
singleton-bool >=0.1.1.0 && <0.2,
keys
......
......@@ -13,6 +13,7 @@ module Distribution.Compat.DList (
DList,
runDList,
singleton,
fromList,
snoc,
) where
......@@ -29,6 +30,9 @@ runDList (DList run) = run []
singleton :: a -> DList a
singleton a = DList (a:)
fromList :: [a] -> DList a
fromList as = DList (as ++)
snoc :: DList a -> a -> DList a
snoc xs x = xs <> singleton x
......
{-# LANGUAGE RankNTypes #-}
-- | This module provides very basic lens functionality, without extra dependencies.
--
-- For the documentation of the combinators see <http://hackage.haskell.org/package/lens lens> package.
-- This module uses the same vocabulary.
module Distribution.Compat.Lens (
-- * Types
Lens,
Lens',
Traversal,
Traversal',
-- ** LensLike
LensLike,
LensLike',
-- ** rank-1 types
Getting,
AGetter,
ASetter,
ALens,
ALens',
-- * Getter
view,
-- * Setter
set,
over,
-- * Fold
toDListOf,
toListOf,
toSetOf,
-- * Lens
cloneLens,
aview,
-- * Common lenses
_1, _2,
non,
fromNon,
-- * Operators
(&),
(^.), (.~), (%~),
(?~),
(^#), (#~), (#%~),
-- * Internal Comonads
Pretext (..),
-- * Cabal developer info
-- $development
) where
import Prelude()
import Distribution.Compat.Prelude
import Control.Applicative (Const (..))
import Data.Functor.Identity (Identity (..))
import qualified Distribution.Compat.DList as DList
import qualified Data.Set as Set
-------------------------------------------------------------------------------
-- Types
-------------------------------------------------------------------------------
type LensLike f s t a b = (a -> f b) -> s -> f t
type LensLike' f s a = (a -> f a) -> s -> f s
type Lens s t a b = forall f. Functor f => LensLike f s t a b
type Traversal s t a b = forall f. Applicative f => LensLike f s t a b
type Lens' s a = Lens s s a a
type Traversal' s a = Traversal s s a a
type Getting r s a = LensLike (Const r) s s a a
type AGetter s a = LensLike (Const a) s s a a -- this doens't exist in 'lens'
type ASetter s t a b = LensLike Identity s t a b
type ALens s t a b = LensLike (Pretext a b) s t a b
type ALens' s a = ALens s s a a
-------------------------------------------------------------------------------
-- Getter
-------------------------------------------------------------------------------
view :: Getting a s a -> s -> a
view l s = getConst (l Const s)
-------------------------------------------------------------------------------
-- Setter
-------------------------------------------------------------------------------
set :: ASetter s t a b -> b -> s -> t
set l x = over l (const x)
over :: ASetter s t a b -> (a -> b) -> s -> t
over l f s = runIdentity (l (\x -> Identity (f x)) s)
-------------------------------------------------------------------------------
-- Fold
-------------------------------------------------------------------------------
toDListOf :: Getting (DList.DList a) s a -> s -> DList.DList a
toDListOf l s = getConst (l (\x -> Const (DList.singleton x)) s)
toListOf :: Getting (DList.DList a) s a -> s -> [a]
toListOf l = DList.runDList . toDListOf l
toSetOf :: Getting (Set.Set a) s a -> s -> Set.Set a
toSetOf l s = getConst (l (\x -> Const (Set.singleton x)) s)
-------------------------------------------------------------------------------
-- Lens
-------------------------------------------------------------------------------
aview :: ALens s t a b -> s -> a
aview l = pretextPos . l pretextSell
{-# INLINE aview #-}
{-
lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
lens sa sbt afb s = sbt s <$> afb (sa s)
-}
-------------------------------------------------------------------------------
-- Common
-------------------------------------------------------------------------------
_1 :: Lens (a, c) (b, c) a b
_1 f (a, c) = flip (,) c <$> f a
_2 :: Lens (c, a) (c, b) a b
_2 f (c, a) = (,) c <$> f a
-- | /Note:/ not an isomorphism here.
non :: Eq a => a -> Lens' (Maybe a) a
non def f s = wrap <$> f (unwrap s)
where
wrap x | x == def = Nothing
wrap x = Just x
unwrap = fromMaybe def
fromNon :: Eq a => a -> Lens' a (Maybe a)
fromNon def f s = unwrap <$> f (wrap s)
where
wrap x | x == def = Nothing
wrap x = Just x
unwrap = fromMaybe def
-------------------------------------------------------------------------------
-- Operators
-------------------------------------------------------------------------------
-- | '&' is a reverse application operator
(&) :: a -> (a -> b) -> b
(&) = flip ($)
{-# INLINE (&) #-}
infixl 1 &
infixl 8 ^., ^#
infixr 4 .~, %~, ?~, #~, #%~
(^.) :: s -> Getting a s a -> a
s ^. l = getConst (l Const s)
{-# INLINE (^.) #-}
(.~) :: ASetter s t a b -> b -> s -> t
(.~) = set
{-# INLINE (.~) #-}
(?~) :: ASetter s t a (Maybe b) -> b -> s -> t
l ?~ b = set l (Just b)
{-# INLINE (?~) #-}
(%~) :: ASetter s t a b -> (a -> b) -> s -> t
(%~) = over
{-# INLINE (%~) #-}
(^#) :: s -> ALens s t a b -> a
s ^# l = aview l s
(#~) :: ALens s t a b -> b -> s -> t
(#~) l b s = pretextPeek b (l pretextSell s)
{-# INLINE (#~) #-}
(#%~) :: ALens s t a b -> (a -> b) -> s -> t
(#%~) l f s = pretextPeeks f (l pretextSell s)
{-# INLINE (#%~) #-}
pretextSell :: a -> Pretext a b b
pretextSell a = Pretext (\afb -> afb a)
{-# INLINE pretextSell #-}
pretextPeeks :: (a -> b) -> Pretext a b t -> t
pretextPeeks f (Pretext m) = runIdentity $ m (\x -> Identity (f x))
{-# INLINE pretextPeeks #-}
pretextPeek :: b -> Pretext a b t -> t
pretextPeek b (Pretext m) = runIdentity $ m (\_ -> Identity b)
{-# INLINE pretextPeek #-}
pretextPos :: Pretext a b t -> a
pretextPos (Pretext m) = getConst (m Const)
{-# INLINE pretextPos #-}
cloneLens :: Functor f => ALens s t a b -> LensLike f s t a b
cloneLens l f s = runPretext (l pretextSell s) f
{-# INLINE cloneLens #-}
-------------------------------------------------------------------------------
-- Comonads
-------------------------------------------------------------------------------
-- | @lens@ variant is also parametrised by profunctor.
data Pretext a b t = Pretext { runPretext :: forall f. Functor f => (a -> f b) -> f t }
instance Functor (Pretext a b) where
fmap f (Pretext pretext) = Pretext (\afb -> fmap f (pretext afb))
-------------------------------------------------------------------------------
-- Documentation
-------------------------------------------------------------------------------
-- $development
--
-- We cannot depend on @template-haskell@, because Cabal is a boot library.
-- This fact makes defining optics a manual task. Here is a small recipe to
-- make the process less tedious.
--
-- First start a repl
--
-- > cabal new-repl Cabal:parser-hackage-tests -fparsec-struct-diff
--
-- Because @--extra-package@ isn't yet implemented, we use a test-suite
-- with @generics-sop@ dependency.
--
-- In the repl, we load a helper script:
--
-- > :l ../generics-sop-lens.hs
--
-- Now we are set up to derive lenses!
--
-- > :m +Distribution.Types.SourceRepo
-- > putStr $ genericLenses (Proxy :: Proxy SourceRepo)
--
-- @
-- repoKind :: Lens' SourceRepo RepoKind
-- repoKind f s = fmap (\\x -> s { T.repoKind = x }) (f (T.repoKind s))
-- \{-# INLINE repoKind #-\}
-- ...
-- @
--
-- /Note:/ You may need to adjust type-aliases, e.g. `String` to `FilePath`.
......@@ -12,6 +12,7 @@ module Distribution.Compat.Map.Strict
#ifdef HAVE_containers_050
#else
, insertWith
, fromSet
#endif
) where
......@@ -20,7 +21,11 @@ import Data.Map.Strict as X
#else
import Data.Map as X hiding (insertWith, insertWith')
import qualified Data.Map
import qualified Data.Set
insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith = Data.Map.insertWith'
fromSet :: (k -> a) -> Data.Set.Set k -> Map k a
fromSet f = Data.Map.fromDistinctAscList . Prelude.map (\k -> (k, f k)) . Data.Set.toList
#endif
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
-- | Per Conor McBride, the 'Newtype' typeclass represents the packing and
-- unpacking of a newtype, and allows you to operatate under that newtype with
-- functions such as 'ala'.
module Distribution.Compat.Newtype (
Newtype (..),
ala,
alaf,
pack',
unpack',
) where
import Data.Functor.Identity (Identity (..))
import Data.Monoid (Sum (..), Product (..), Endo (..))
-- | The @FunctionalDependencies@ version of 'Newtype' type-class.
--
-- /Note:/ for actual newtypes the implementation can be
-- @pack = coerce; unpack = coerce@. We don't have default implementation,
-- because @Cabal@ have to support older than @base >= 4.7@ compilers.
-- Also, 'Newtype' could witness a non-structural isomorphism.
class Newtype n o | n -> o where
pack :: o -> n
unpack :: n -> o
instance Newtype (Identity a) a where
pack = Identity
unpack = runIdentity
instance Newtype (Sum a) a where
pack = Sum
unpack = getSum
instance Newtype (Product a) a where
pack = Product
unpack = getProduct
instance Newtype (Endo a) (a -> a) where
pack = Endo
unpack = appEndo
-- |
--
-- >>> ala Sum foldMap [1, 2, 3, 4 :: Int]
-- 10
--
-- /Note:/ the user supplied function for the newtype is /ignored/.
--
-- >>> ala (Sum . (+1)) foldMap [1, 2, 3, 4 :: Int]
-- 10
ala :: (Newtype n o, Newtype n' o') => (o -> n) -> ((o -> n) -> b -> n') -> (b -> o')
ala pa hof = alaf pa hof id
-- |
--
-- >>> alaf Sum foldMap length ["cabal", "install"]
-- 12
--
-- /Note:/ as with 'ala', the user supplied function for the newtype is /ignored/.
alaf :: (Newtype n o, Newtype n' o') => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o')
alaf _ hof f = unpack . hof (pack . f)
-- | Variant of 'pack', which takes a phantom type.
pack' :: Newtype n o => (o -> n) -> o -> n
pack' _ = pack
-- | Variant of 'pack', which takes a phantom type.
unpack' :: Newtype n o => (o -> n) -> n -> o
unpack' _ = unpack
......@@ -16,6 +16,7 @@ module Distribution.Compat.Parsec (
P.sepBy,
P.sepBy1,
P.choice,
P.eof,
-- * Char
integral,
......@@ -24,6 +25,7 @@ module Distribution.Compat.Parsec (
P.satisfy,
P.space,
P.spaces,
skipSpaces1,
P.string,
munch,
munch1,
......@@ -71,3 +73,6 @@ munch
=> (Char -> Bool)
-> P.ParsecT s u m String
munch = many . P.satisfy
skipSpaces1 :: P.Stream s m Char => P.ParsecT s u m ()
skipSpaces1 = P.skipMany1 P.space
......@@ -64,6 +64,7 @@ module Distribution.Compat.Prelude (
null, length,
find, foldl',
traverse_, for_,
any, all,
-- * Data.Traversable
Traversable, traverse, sequenceA,
......@@ -94,7 +95,7 @@ module Distribution.Compat.Prelude (
-- We also could hide few partial function
import Prelude as BasePrelude hiding
( IO, mapM, mapM_, sequence, null, length, foldr
( IO, mapM, mapM_, sequence, null, length, foldr, any, all
#if MINVER_base_48
, Word
-- We hide them, as we import only some members
......@@ -110,7 +111,7 @@ import Distribution.Compat.Semigroup (Monoid (..))
import Data.Foldable (length, null)
#endif
import Data.Foldable (Foldable (foldMap, foldr), find, foldl', for_, traverse_)
import Data.Foldable (Foldable (foldMap, foldr), find, foldl', for_, traverse_, any, all)
import Data.Traversable (Traversable (traverse, sequenceA), for)
import Control.Applicative (Alternative (..))
......
......@@ -67,17 +67,23 @@ module Distribution.Compat.ReadP
-- * Running a parser
ReadS, -- :: *; = String -> [(a,String)]
readP_to_S, -- :: ReadP a -> ReadS a
readS_to_P -- :: ReadS a -> ReadP a
readS_to_P, -- :: ReadS a -> ReadP a
-- ** Parsec
parsecToReadP,
)
where
import Prelude ()
import Distribution.Compat.Prelude hiding (many, get)
import Control.Applicative (liftA2)
import qualified Distribution.Compat.MonadFail as Fail
import Control.Monad( replicateM, (>=>) )