Commits (8)
......@@ -6,16 +6,20 @@ sudo: false
matrix:
include:
- env: CABALVER=1.18 GHCVER=7.4.2
- env: CABALVER=1.18 CABALUPGR=1.24.* GHCVER=7.4.2
addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2], sources: [hvr-ghc]}}
- env: CABALVER=1.18 GHCVER=7.6.3
- env: CABALVER=1.18 CABALUPGR=1.24.* GHCVER=7.6.3
addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.8.4
- env: CABALVER=1.22 CABALUPGR=1.24.* GHCVER=7.8.4
addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.10.3
- env: CABALVER=1.22 CABALUPGR=1.24.* GHCVER=7.10.3
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.0.1
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.0.2
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.2.2
addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.2], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.4.3
addons: {apt: {packages: [cabal-install-1.24,ghc-8.4.3], sources: [hvr-ghc]}}
- env: CABALVER=head GHCVER=head
addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
......@@ -33,8 +37,11 @@ install:
- cabal sandbox init
# can't use "cabal install --only-dependencies --enable-tests --enable-benchmarks" due to dep-cycle.
# must split in two separate 'cabal install's since cabal doesn't update the cabal library before it's needed in 'cabal-version' constraints.
- cabal install "bytestring >= 0.10.4" 'Cabal == 1.24.*' -j
- cabal install criterion deepseq mtl "QuickCheck >= 2.8" HUnit "test-framework-quickcheck2 >= 0.3" "random >= 1.0.1.0" attoparsec cereal tar zlib -j
- cabal install "bytestring >= 0.10.4" -j
- if [ -n "$CABALUPGR" ]; then
cabal install "Cabal == $CABALUPGR" -j;
fi
- cabal install "generic-deriving >= 0.10" criterion deepseq mtl "QuickCheck >= 2.8" HUnit "test-framework-quickcheck2 >= 0.3" "random >= 1.0.1.0" attoparsec cereal tar zlib -j
script:
- cabal configure --enable-tests --enable-benchmarks -v2 --ghc-options=-fno-spec-constr
......
......@@ -189,7 +189,9 @@ putWord64N16Host = loop 0
------------------------------------------------------------------------
-- Utilities
#if !MIN_VERSION_base(4,11,0)
infixr 6 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#endif
{-# LANGUAGE DeriveGeneric #-}
-- | This module contains type definitions copied from Cabal-1.24.2.0
-- to avoid a dependency on Cabal. Their contents for the benchmark are read
-- from a cache file using their 'Read' instance, see "GenericsBenchCache".
--
module Cabal24 where
import Data.Version (Version)
import GHC.Generics (Generic)
import Data.Map (Map)
data Benchmark = Benchmark {
benchmarkName :: String,
benchmarkInterface :: BenchmarkInterface,
benchmarkBuildInfo :: BuildInfo,
benchmarkEnabled :: Bool
} deriving (Generic, Eq, Ord, Read, Show)
data BenchmarkInterface =
BenchmarkExeV10 Version FilePath
| BenchmarkUnsupported BenchmarkType
deriving (Generic, Eq, Ord, Read, Show)
data BenchmarkType = BenchmarkTypeExe Version
| BenchmarkTypeUnknown String Version
deriving (Generic, Eq, Ord, Read, Show)
data BuildInfo = BuildInfo {
buildable :: Bool,
buildTools :: [Dependency],
cppOptions :: [String],
ccOptions :: [String],
ldOptions :: [String],
pkgconfigDepends :: [Dependency],
frameworks :: [String],
extraFrameworkDirs:: [String],
cSources :: [FilePath],
jsSources :: [FilePath],
hsSourceDirs :: [FilePath],
otherModules :: [ModuleName],
defaultLanguage :: Maybe Language,
otherLanguages :: [Language],
defaultExtensions :: [Extension],
otherExtensions :: [Extension],
oldExtensions :: [Extension],
extraLibs :: [String],
extraGHCiLibs :: [String],
extraLibDirs :: [String],
includeDirs :: [FilePath],
includes :: [FilePath],
installIncludes :: [FilePath],
options :: [(CompilerFlavor,[String])],
profOptions :: [(CompilerFlavor,[String])],
sharedOptions :: [(CompilerFlavor,[String])],
customFieldsBI :: [(String,String)],
targetBuildDepends :: [Dependency],
targetBuildRenaming :: Map PackageName ModuleRenaming
} deriving (Generic, Eq, Ord, Read, Show)
data BuildType
= Simple
| Configure
| Make
| Custom
| UnknownBuildType String
deriving (Generic, Eq, Ord, Read, Show)
data CompilerFlavor = GHC | GHCJS | NHC | YHC | Hugs | HBC | Helium
| JHC | LHC | UHC
| HaskellSuite String
| OtherCompiler String
deriving (Generic, Eq, Ord, Read, Show)
data Dependency = Dependency PackageName VersionRange
deriving (Generic, Eq, Ord, Read, Show)
data Executable = Executable {
exeName :: String,
modulePath :: FilePath,
buildInfo :: BuildInfo
}
deriving (Generic, Eq, Ord, Read, Show)
data Extension =
EnableExtension KnownExtension
| DisableExtension KnownExtension
| UnknownExtension String
deriving (Generic, Eq, Ord, Read, Show)
newtype FlagName = FlagName String
deriving (Generic, Eq, Ord, Read, Show)
data KnownExtension =
OverlappingInstances
| UndecidableInstances
| IncoherentInstances
| DoRec
| RecursiveDo
| ParallelListComp
| MultiParamTypeClasses
| MonomorphismRestriction
| FunctionalDependencies
| Rank2Types
| RankNTypes
| PolymorphicComponents
| ExistentialQuantification
| ScopedTypeVariables
| PatternSignatures
| ImplicitParams
| FlexibleContexts
| FlexibleInstances
| EmptyDataDecls
| CPP
| KindSignatures
| BangPatterns
| TypeSynonymInstances
| TemplateHaskell
| ForeignFunctionInterface
| Arrows
| Generics
| ImplicitPrelude
| NamedFieldPuns
| PatternGuards
| GeneralizedNewtypeDeriving
| ExtensibleRecords
| RestrictedTypeSynonyms
| HereDocuments
| MagicHash
| TypeFamilies
| StandaloneDeriving
| UnicodeSyntax
| UnliftedFFITypes
| InterruptibleFFI
| CApiFFI
| LiberalTypeSynonyms
| TypeOperators
| RecordWildCards
| RecordPuns
| DisambiguateRecordFields
| TraditionalRecordSyntax
| OverloadedStrings
| GADTs
| GADTSyntax
| MonoPatBinds
| RelaxedPolyRec
| ExtendedDefaultRules
| UnboxedTuples
| DeriveDataTypeable
| DeriveGeneric
| DefaultSignatures
| InstanceSigs
| ConstrainedClassMethods
| PackageImports
| ImpredicativeTypes
| NewQualifiedOperators
| PostfixOperators
| QuasiQuotes
| TransformListComp
| MonadComprehensions
| ViewPatterns
| XmlSyntax
| RegularPatterns
| TupleSections
| GHCForeignImportPrim
| NPlusKPatterns
| DoAndIfThenElse
| MultiWayIf
| LambdaCase
| RebindableSyntax
| ExplicitForAll
| DatatypeContexts
| MonoLocalBinds
| DeriveFunctor
| DeriveTraversable
| DeriveFoldable
| NondecreasingIndentation
| SafeImports
| Safe
| Trustworthy
| Unsafe
| ConstraintKinds
| PolyKinds
| DataKinds
| ParallelArrays
| RoleAnnotations
| OverloadedLists
| EmptyCase
| AutoDeriveTypeable
| NegativeLiterals
| BinaryLiterals
| NumDecimals
| NullaryTypeClasses
| ExplicitNamespaces
| AllowAmbiguousTypes
| JavaScriptFFI
| PatternSynonyms
| PartialTypeSignatures
| NamedWildCards
| DeriveAnyClass
| DeriveLift
| StaticPointers
| StrictData
| Strict
| ApplicativeDo
| DuplicateRecordFields
| TypeApplications
| TypeInType
| UndecidableSuperClasses
| MonadFailDesugaring
| TemplateHaskellQuotes
| OverloadedLabels
deriving (Generic, Eq, Ord, Read, Show)
data Language =
Haskell98
| Haskell2010
| UnknownLanguage String
deriving (Generic, Eq, Ord, Read, Show)
data Library = Library {
exposedModules :: [ModuleName],
reexportedModules :: [ModuleReexport],
requiredSignatures:: [ModuleName],
exposedSignatures:: [ModuleName],
libExposed :: Bool,
libBuildInfo :: BuildInfo
}
deriving (Generic, Eq, Ord, Read, Show)
data License =
GPL (Maybe Version)
| AGPL (Maybe Version)
| LGPL (Maybe Version)
| BSD2
| BSD3
| BSD4
| MIT
| ISC
| MPL Version
| Apache (Maybe Version)
| PublicDomain
| AllRightsReserved
| UnspecifiedLicense
| OtherLicense
| UnknownLicense String
deriving (Generic, Eq, Ord, Read, Show)
newtype ModuleName = ModuleName [String]
deriving (Generic, Eq, Ord, Read, Show)
data ModuleReexport = ModuleReexport {
moduleReexportOriginalPackage :: Maybe PackageName,
moduleReexportOriginalName :: ModuleName,
moduleReexportName :: ModuleName
} deriving (Generic, Eq, Ord, Read, Show)
data ModuleRenaming = ModuleRenaming Bool [(ModuleName, ModuleName)]
deriving (Generic, Eq, Ord, Read, Show)
data PackageDescription
= PackageDescription {
package :: PackageIdentifier,
license :: License,
licenseFiles :: [FilePath],
copyright :: String,
maintainer :: String,
author :: String,
stability :: String,
testedWith :: [(CompilerFlavor,VersionRange)],
homepage :: String,
pkgUrl :: String,
bugReports :: String,
sourceRepos :: [SourceRepo],
synopsis :: String,
description :: String,
category :: String,
customFieldsPD :: [(String,String)],
buildDepends :: [Dependency],
specVersionRaw :: Either Version VersionRange,
buildType :: Maybe BuildType,
setupBuildInfo :: Maybe SetupBuildInfo,
library :: Maybe Library,
executables :: [Executable],
testSuites :: [TestSuite],
benchmarks :: [Benchmark],
dataFiles :: [FilePath],
dataDir :: FilePath,
extraSrcFiles :: [FilePath],
extraTmpFiles :: [FilePath],
extraDocFiles :: [FilePath]
} deriving (Generic, Eq, Ord, Read, Show)
data PackageIdentifier
= PackageIdentifier {
pkgName :: PackageName,
pkgVersion :: Version
}
deriving (Generic, Eq, Ord, Read, Show)
newtype PackageName = PackageName { unPackageName :: String }
deriving (Generic, Eq, Ord, Read, Show)
data RepoKind =
RepoHead
| RepoThis
| RepoKindUnknown String
deriving (Generic, Eq, Ord, Read, Show)
data RepoType = Darcs | Git | SVN | CVS
| Mercurial | GnuArch | Bazaar | Monotone
| OtherRepoType String
deriving (Generic, Eq, Ord, Read, Show)
data SetupBuildInfo = SetupBuildInfo {
setupDepends :: [Dependency],
defaultSetupDepends :: Bool
}
deriving (Generic, Eq, Ord, Read, Show)
data SourceRepo = SourceRepo {
repoKind :: RepoKind,
repoType :: Maybe RepoType,
repoLocation :: Maybe String,
repoModule :: Maybe String,
repoBranch :: Maybe String,
repoTag :: Maybe String,
repoSubdir :: Maybe FilePath
}
deriving (Generic, Eq, Ord, Read, Show)
data TestSuite = TestSuite {
testName :: String,
testInterface :: TestSuiteInterface,
testBuildInfo :: BuildInfo,
testEnabled :: Bool
}
deriving (Generic, Eq, Ord, Read, Show)
data TestSuiteInterface =
TestSuiteExeV10 Version FilePath
| TestSuiteLibV09 Version ModuleName
| TestSuiteUnsupported TestType
deriving (Generic, Eq, Ord, Read, Show)
data TestType = TestTypeExe Version
| TestTypeLib Version
| TestTypeUnknown String Version
deriving (Generic, Eq, Ord, Read, Show)
data VersionRange
= AnyVersion
| ThisVersion Version
| LaterVersion Version
| EarlierVersion Version
| WildcardVersion Version
| UnionVersionRanges VersionRange VersionRange
| IntersectVersionRanges VersionRange VersionRange
| VersionRangeParens VersionRange
deriving (Generic, Eq, Ord, Read, Show)
......@@ -2,7 +2,7 @@
module Main where
import qualified Data.ByteString.Lazy as L
import Distribution.PackageDescription
import Cabal24 (PackageDescription)
import Criterion.Main
......
{-# LANGUAGE DeriveGeneric, StandaloneDeriving, BangPatterns, CPP #-}
module GenericsBenchCache (readPackageDescriptionCache) where
import qualified Text.ParserCombinators.ReadP as Read
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as LC8
import qualified Codec.Compression.GZip as GZip
import Data.Version (parseVersion)
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parse
import Distribution.Version (Version)
import Cabal24 (PackageDescription)
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Compression.GZip as GZip
import qualified Data.HashMap.Lazy as Map
import System.Directory
import System.Exit
......@@ -24,66 +16,25 @@ import GenericsBenchTypes ()
import Control.Applicative ((<$>))
#endif
readTar :: String -> Int -> IO [PackageDescription]
readTar tarPath limit = do
entries <- Tar.read . GZip.decompress <$> L.readFile tarPath
let contents = Tar.foldEntries unpack [] (error "tar error") entries
let !pkgs = Map.fromListWith pick
[ (pkg, (version, content))
| (path, content) <- contents
, Just (pkg, version) <- return (readFilePath path) ]
return $ take limit [ flattenPackageDescription gpd
| (_, (_, content)) <- Map.toList pkgs
, ParseOk _warns gpd <- return (parsePackageDescription (LC8.unpack content)) ]
where
pick (v,a) (w,b) | v >= w = (v,a)
| otherwise = (w,b)
unpack e acc =
case Tar.entryContent e of
Tar.NormalFile content _ -> (Tar.entryPath e, content):acc
_ -> acc
readFilePath :: String -> Maybe (String, Version)
readFilePath str = extract (Read.readP_to_S parse str)
where
extract [(result,_)] = Just result
extract _ = Nothing
parse = do
packageName <- Read.many1 (Read.satisfy (/='/'))
_ <- Read.char '/'
version <- parseVersion
_ <- Read.char '/'
return (packageName, version)
writePackageDescriptionCache :: String -> [PackageDescription] -> IO ()
writePackageDescriptionCache path = writeFile path . show
readPackageDescriptionCache :: Int -> IO [PackageDescription]
readPackageDescriptionCache amount = do
let cacheFilePath' = cacheFilePath ++ "-" ++ (show amount)
createPackageDescriptionCache cacheFilePath' amount
pds <- read <$> readFile cacheFilePath'
cacheExists <- doesFileExist cacheFilePath
bs <-
if cacheExists
then do
putStrLn "reading the cache file, might take a moment..."
L.readFile cacheFilePath
else do
-- In older versions of this benchmark, there was machinery to
-- regenerate the cache using the data in @~/.cabal@. Now the cache is
-- simply stored in the repo to avoid a dependency on Cabal the library.
putStrLn (cacheFilePath ++ " missing, aborting")
exitFailure
let str = LC8.unpack (GZip.decompress bs)
pds = take amount (read str)
-- PackageDescription doesn't implement NFData, let's force with the following line
(length (show pds)) `seq` return pds
(length (show pds)) `seq` putStrLn "done reading the cache file"
return pds
cacheFilePath :: String
cacheFilePath = "generics-bench.cache"
createPackageDescriptionCache :: String -> Int -> IO ()
createPackageDescriptionCache path amount = do
cacheExists <- doesFileExist path
if cacheExists
then putStrLn "reusing cache from previous run"
else do
putStr "creating cabal cache file... "
tarFilePath <- (++"/.cabal/packages/hackage.haskell.org/00-index.tar.gz") <$> getHomeDirectory
fileExists <- doesFileExist tarFilePath
if fileExists
then do
pds <- readTar tarFilePath amount
writePackageDescriptionCache path pds
putStrLn "done"
else do
putStrLn (tarFilePath ++ " missing, aborting")
exitFailure
cacheFilePath = "generics-bench.cache.gz"
{-# LANGUAGE CPP, DeriveGeneric, StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GenericsBenchTypes where
import Distribution.Compiler
import Distribution.License
import Distribution.ModuleName hiding (main)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Version
import Language.Haskell.Extension
import GHC.Generics (Generic)
import Data.Binary
#if ! MIN_VERSION_base(4,9,0)
deriving instance Generic Version
#endif
import Cabal24
import Generics.Deriving.Instances ()
import Data.Binary
instance Binary Benchmark
instance Binary BenchmarkInterface
......
......@@ -70,7 +70,7 @@ test-suite qc
random>=1.0.1.0,
test-framework,
test-framework-quickcheck2 >= 0.3,
QuickCheck == 2.9.*
QuickCheck >= 2.9
-- build dependencies from using binary source rather than depending on the library
build-depends: array, containers
......@@ -162,15 +162,18 @@ benchmark generics-bench
build-depends:
base >= 4.5.0.0 && < 5,
bytestring >= 0.10.4,
Cabal == 1.24.*,
-- The benchmark already depended on 'generic-deriving' transitively. That's
-- what caused one of the problems, as both 'generic-deriving' and
-- 'GenericsBenchTypes' used to define 'instance Generic Version'.
generic-deriving >= 0.10,
directory,
filepath,
tar,
unordered-containers,
zlib,
criterion
other-modules:
Cabal24
GenericsBenchCache
GenericsBenchTypes
Data.Binary.Generic
......
......@@ -60,6 +60,9 @@ import Data.Monoid (mempty)
#endif
import qualified Data.Monoid as Monoid
import Data.Monoid ((<>))
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity (Identity (..))
#endif
#if MIN_VERSION_base(4,9,0)
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup as Semigroup
......@@ -566,6 +569,12 @@ instance (Binary a, Binary b, Binary c, Binary d, Binary e,
------------------------------------------------------------------------
-- Container types
#if MIN_VERSION_base(4,8,0)
instance Binary a => Binary (Identity a) where
put (Identity x) = put x
get = Identity <$> get
#endif
instance Binary a => Binary [a] where
put = putList
get = do n <- get :: Get Int
......
......@@ -3,6 +3,10 @@
{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ >= 800
#define HAS_DATA_KIND
#endif
-----------------------------------------------------------------------------
-- |
-- Module : Data.Binary.Generic
......@@ -27,6 +31,9 @@ import Data.Binary.Put
import Data.Bits
import Data.Word
import Data.Monoid ((<>))
#ifdef HAS_DATA_KIND
import Data.Kind
#endif
import GHC.Generics
import Prelude -- Silence AMP warning.
......@@ -136,7 +143,11 @@ instance GBinaryPut a => GSumPut (C1 c a) where
class SumSize f where
sumSize :: Tagged f Word64
newtype Tagged (s :: * -> *) b = Tagged {unTagged :: b}
#ifdef HAS_DATA_KIND
newtype Tagged (s :: Type -> Type) b = Tagged {unTagged :: b}
#else
newtype Tagged (s :: * -> *) b = Tagged {unTagged :: b}
#endif
instance (SumSize a, SumSize b) => SumSize (a :+: b) where
sumSize = Tagged $ unTagged (sumSize :: Tagged a Word64) +
......