Commit fc3dc42e authored by Alex Washburn's avatar Alex Washburn
Browse files

Merging changes to use the new Lens based package description parser(s).

parents 3b5fedcb d1739de0
......@@ -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!
......@@ -46,6 +46,7 @@ Duncan Coutts <duncan@community.haskell.org> unknown <unkn
Edward Z. Yang <ezyang@cs.stanford.edu> <ezyang@mit.edu>
Einar Karttunen <ekarttun@cs.helsinki.fi>
Federico Mastellone <fmaste@users.noreply.github.com>
Francesco Gazzetta <francygazz@gmail.com> <fgaz@users.noreply.github.com>
Ganesh Sittampalam <ganesh.sittampalam@credit-suisse.com> <ganesh@earth.li>
Geoff Nixon <geoff-codes@users.noreply.github.com> <geoff.nixon@aol.com>
Gershom Bazerman <gershomb@gmail.com>
......@@ -72,6 +73,8 @@ Jens Petersen <juhpetersen@gmail.com> <petersen@red
Jeremy Shaw <jeremy.shaw@linspireinc.com>
Jeremy Shaw <jeremy.shaw@linspireinc.com> <jeremy@n-heptane.com>
Jim Burton <jim@sdf-eu.org>
Joel Bitrauser <jo.da@posteo.de> <bitrauser@users.noreply.github.com>
Joel Bitrauser <jo.da@posteo.de> Bitrauser <jo.da@posteo.de>
Joe Quinn <headprogrammingczar@gmail.com>
Joel Stanley <intractable@gmail.com>
Joeri van Eekelen <tchakkazulu@gmail.com>
......
......@@ -37,30 +37,27 @@ matrix:
- env: GHCVER=7.6.3 SCRIPT=script
os: linux
sudo: required
- env: GHCVER=7.8.4 SCRIPT=script
- env: GHCVER=7.8.4 SCRIPT=script USE_GOLD=YES
os: linux
sudo: required
# Ugh, we'd like to drop 'sudo: required' and use the
# apt plugin for the next two
# but the GCE instance we get has more memory, which makes
# a big difference
- env: GHCVER=7.10.3 SCRIPT=script
- env: GHCVER=7.10.3 SCRIPT=script USE_GOLD=YES
os: linux
sudo: required
- env: GHCVER=8.0.2 SCRIPT=script DEPLOY_DOCS=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
- 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"
- env: GHCVER=8.0.2 SCRIPT=script DEBUG_EXPENSIVE_ASSERTIONS=YES TAGSUFFIX="-fdebug-expensive-assertions" USE_GOLD=YES
os: linux
sudo: required
- env: GHCVER=8.0.2 SCRIPT=script DEBUG_EXPENSIVE_ASSERTIONS=YES TAGSUFFIX="-fdebug-expensive-assertions"
os: linux
sudo: required
- env: GHCVER=8.0.2 SCRIPT=bootstrap
- env: GHCVER=8.0.2 SCRIPT=bootstrap USE_GOLD=YES
sudo: required
os: linux
- env: GHCVER=8.2.1 SCRIPT=script
......@@ -105,9 +102,12 @@ before_install:
- export PATH=$HOME/bin:$PATH
- export PATH=$HOME/.cabal/bin:$PATH
- export PATH=$HOME/.local/bin:$PATH
- export PATH=/opt/cabal/1.24/bin:$PATH
- export PATH=/opt/cabal/2.0/bin:$PATH
- export PATH=/opt/happy/1.19.5/bin:$PATH
- export PATH=/opt/alex/3.1.7/bin:$PATH
- if [ "$USE_GOLD" = "YES" ]; then sudo update-alternatives --install "/usr/bin/ld" "ld" "/usr/bin/ld.gold" 20; fi
- if [ "$USE_GOLD" = "YES" ]; then sudo update-alternatives --install "/usr/bin/ld" "ld" "/usr/bin/ld.bfd" 10; fi
- ld -v
- ./travis-install.sh
install:
......
......@@ -9,8 +9,10 @@ Albert Krewinkel <tarleb@moltkeplatz.de>
Alex Biehl <alexbiehl@gmail.com>
Alexander Kjeldaas <alexander.kjeldaas@gmail.com>
Alexander Vershilov <alexander.vershilov@gmail.com>
Alexei Pastuchov <alexei.pastuchov@telecolumbus.de>
Alistair Bailey <alistair@abayley.org>
Alson Kemp <alson@alsonkemp.com>
Amir Mohammad Saied <amirsaied@gmail.com>
Anders Kaseorg <andersk@mit.edu>
Andrea Vezzosi <sanzhiyan@gmail.com>
Andres Löh <andres.loeh@gmail.com>
......@@ -53,6 +55,7 @@ Chris Wong <lambda.fairy@gmail.com>
Christiaan Baaij <christiaan.baaij@gmail.com>
Clemens Fruhwirth <clemens@endorphin.org>
Clint Adams <clint@debian.org>
Colin Wahl <colin.t.wahl@gmail.com>
Conal Elliott <conal@conal.net>
Curtis Gagliardi <curtis@curtis.io>
Dan Burton <danburton.email@gmail.com>
......@@ -76,6 +79,7 @@ Dmitry Astapov <dastapov@gmail.com>
Dominic Steinitz <dominic@steinitz.org>
Don Stewart <dons00@gmail.com>
Doug Beardsley <mightybyte@gmail.com>
Douglas Wilson <douglas.wilson@gmail.com>
Duncan Coutts <duncan@community.haskell.org>
Echo Nolan <echo@echonolan.net>
Edsko de Vries <edsko@well-typed.com>
......@@ -119,6 +123,7 @@ Ilya Smelkov <triplepointfive@gmail.com>
Isaac Potoczny-Jones <ijones@syntaxpolice.org>
Isamu Mogi <saturday6c@gmail.com>
Iustin Pop <iusty@k1024.org>
Ivan Lazar Miljenovic <Ivan.Miljenovic@gmail.com>
Iñaki García Etxebarria <garetxe@gmail.com>
JP Moresmau <jp@moresmau.fr>
Jacco Krijnen <jaccokrijnen@gmail.com>
......@@ -131,6 +136,7 @@ Jeremy Shaw <jeremy.shaw@linspireinc.com>
Jim Burton <jim@sdf-eu.org>
Joachim Breitner <mail@joachim-breitner.de>
Joe Quinn <headprogrammingczar@gmail.com>
Joel Bitrauser <jo.da@posteo.de>
Joel Stanley <intractable@gmail.com>
Joeri van Eekelen <tchakkazulu@gmail.com>
Johan Tibell <johan.tibell@gmail.com>
......
......@@ -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
......@@ -126,6 +128,7 @@ library
Distribution.Backpack.ModSubst
Distribution.Backpack.ModuleShape
Distribution.Backpack.PreModuleShape
Distribution.Utils.IOData
Distribution.Utils.LogProgress
Distribution.Utils.MapAccum
Distribution.Compat.CreatePipe
......@@ -134,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
......@@ -191,6 +195,7 @@ library
Distribution.Simple.Program.Hpc
Distribution.Simple.Program.Internal
Distribution.Simple.Program.Ld
Distribution.Simple.Program.ResponseFile
Distribution.Simple.Program.Run
Distribution.Simple.Program.Script
Distribution.Simple.Program.Strip
......@@ -208,6 +213,7 @@ library
Distribution.System
Distribution.TestSuite
Distribution.Text
Distribution.Pretty
Distribution.Types.AbiHash
Distribution.Types.AnnotatedId
Distribution.Types.Benchmark
......@@ -265,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
......@@ -380,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,
......@@ -393,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,
......@@ -416,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
......
......@@ -27,7 +27,7 @@ import System.Directory
import System.FilePath
( takeDirectory )
import System.IO
( IOMode(ReadMode), hClose, hGetBuf, hPutBuf
( IOMode(ReadMode), hClose, hGetBuf, hPutBuf, hFileSize
, withBinaryFile )
import Foreign
( allocaBytes )
......@@ -93,7 +93,8 @@ copyFileChanged src dest = do
unless equal $ copyFile src dest
-- | Checks if two files are byte-identical.
-- Returns False if either of the files do not exist.
-- Returns False if either of the files do not exist or if files
-- are of different size.
filesEqual :: FilePath -> FilePath -> NoCallStackIO Bool
filesEqual f1 f2 = do
ex1 <- doesFileExist f1
......@@ -101,6 +102,11 @@ filesEqual f1 f2 = do
if not (ex1 && ex2) then return False else
withBinaryFile f1 ReadMode $ \h1 ->
withBinaryFile f2 ReadMode $ \h2 -> do
c1 <- BSL.hGetContents h1
c2 <- BSL.hGetContents h2
return $! c1 == c2
s1 <- hFileSize h1
s2 <- hFileSize h2
if s1 /= s2
then return False
else do
c1 <- BSL.hGetContents h1
c2 <- BSL.hGetContents h2
return $! c1 == c2
......@@ -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 #-}