Commit 3ac76056 authored by Oleg Grenrus's avatar Oleg Grenrus

Refactor options fields to use PerCompilerFlavor type

E.g. jaeger-flamegraph.cabal failed to roundtrip 'pretty . parse';

Making the list business work didn't feel right,
so I made a bit bigger refactor.
parent 33c58616
......@@ -122,6 +122,9 @@ extra-source-files:
tests/ParserTests/regressions/issue-774.check
tests/ParserTests/regressions/issue-774.expr
tests/ParserTests/regressions/issue-774.format
tests/ParserTests/regressions/jaeger-flamegraph.cabal
tests/ParserTests/regressions/jaeger-flamegraph.expr
tests/ParserTests/regressions/jaeger-flamegraph.format
tests/ParserTests/regressions/leading-comma.cabal
tests/ParserTests/regressions/leading-comma.expr
tests/ParserTests/regressions/leading-comma.format
......
......@@ -33,6 +33,10 @@ module Distribution.Compiler (
classifyCompilerFlavor,
knownCompilerFlavors,
-- * Per compiler flavor
PerCompilerFlavor (..),
perCompilerFlavorToList,
-- * Compiler id
CompilerId(..),
......@@ -109,6 +113,31 @@ defaultCompilerFlavor = case buildCompilerFlavor of
OtherCompiler _ -> Nothing
_ -> Just buildCompilerFlavor
-------------------------------------------------------------------------------
-- Per compiler data
-------------------------------------------------------------------------------
-- | 'PerCompilerFlavor' carries only info per GHC and GHCJS
--
-- Cabal parses only @ghc-options@ and @ghcjs-options@, others are omitted.
--
data PerCompilerFlavor v = PerCompilerFlavor v v
deriving (Generic, Show, Read, Eq, Typeable, Data)
instance Binary a => Binary (PerCompilerFlavor a)
instance NFData a => NFData (PerCompilerFlavor a)
perCompilerFlavorToList :: PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList (PerCompilerFlavor a b) = [(GHC, a), (GHCJS, b)]
instance Semigroup a => Semigroup (PerCompilerFlavor a) where
PerCompilerFlavor a b <> PerCompilerFlavor a' b' = PerCompilerFlavor
(a <> a') (b <> b')
instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where
mempty = PerCompilerFlavor mempty mempty
mappend = (<>)
-- ------------------------------------------------------------
-- * Compiler Id
-- ------------------------------------------------------------
......
......@@ -1057,7 +1057,7 @@ checkPaths pkg =
++ "manager). In addition the layout of the 'dist' directory is subject "
++ "to change in future versions of Cabal."
| bi <- allBuildInfo pkg
, (GHC, flags) <- options bi
, (GHC, flags) <- perCompilerFlavorToList $ options bi
, path <- flags
, isInsideDist path ]
++
......
......@@ -44,7 +44,7 @@ import Distribution.Compat.Prelude
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Compiler (CompilerFlavor (..))
import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..))
import Distribution.FieldGrammar
import Distribution.ModuleName (ModuleName)
import Distribution.Package
......@@ -427,7 +427,7 @@ buildInfoFieldGrammar = BuildInfo
<*> optionsFieldGrammar
<*> profOptionsFieldGrammar
<*> sharedOptionsFieldGrammar
<*> pure [] -- static-options ???
<*> pure mempty -- static-options ???
<*> prefixedFields "x-" L.customFieldsBI
<*> monoidalFieldAla "build-depends" (alaList CommaVCat) L.targetBuildDepends
<*> monoidalFieldAla "mixins" (alaList CommaVCat) L.mixins
......@@ -450,8 +450,8 @@ hsSourceDirsGrammar = (++)
optionsFieldGrammar
:: (FieldGrammar g, Applicative (g BuildInfo))
=> g BuildInfo [(CompilerFlavor, [String])]
optionsFieldGrammar = combine
=> g BuildInfo (PerCompilerFlavor [String])
optionsFieldGrammar = PerCompilerFlavor
<$> monoidalFieldAla "ghc-options" (alaList' NoCommaFSep Token') (extract GHC)
<*> monoidalFieldAla "ghcjs-options" (alaList' NoCommaFSep Token') (extract GHCJS)
-- NOTE: Hugs, NHC and JHC are not supported anymore, but these
......@@ -464,51 +464,31 @@ optionsFieldGrammar = combine
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract flavor = L.options . lookupLens flavor
combine ghc ghcjs =
f GHC ghc ++ f GHCJS ghcjs
where
f _flavor [] = []
f flavor opts = [(flavor, opts)]
profOptionsFieldGrammar
:: (FieldGrammar g, Applicative (g BuildInfo))
=> g BuildInfo [(CompilerFlavor, [String])]
profOptionsFieldGrammar = combine
=> g BuildInfo (PerCompilerFlavor [String])
profOptionsFieldGrammar = PerCompilerFlavor
<$> monoidalFieldAla "ghc-prof-options" (alaList' NoCommaFSep Token') (extract GHC)
<*> monoidalFieldAla "ghcjs-prof-options" (alaList' NoCommaFSep Token') (extract GHCJS)
where
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract flavor = L.profOptions . lookupLens flavor
combine ghc ghcjs = f GHC ghc ++ f GHCJS ghcjs
where
f _flavor [] = []
f flavor opts = [(flavor, opts)]
sharedOptionsFieldGrammar
:: (FieldGrammar g, Applicative (g BuildInfo))
=> g BuildInfo [(CompilerFlavor, [String])]
sharedOptionsFieldGrammar = combine
=> g BuildInfo (PerCompilerFlavor [String])
sharedOptionsFieldGrammar = PerCompilerFlavor
<$> monoidalFieldAla "ghc-shared-options" (alaList' NoCommaFSep Token') (extract GHC)
<*> monoidalFieldAla "ghcjs-shared-options" (alaList' NoCommaFSep Token') (extract GHCJS)
where
extract :: CompilerFlavor -> ALens' BuildInfo [String]
extract flavor = L.sharedOptions . lookupLens flavor
combine ghc ghcjs = f GHC ghc ++ f GHCJS ghcjs
where
f _flavor [] = []
f flavor opts = [(flavor, opts)]
lookupLens :: (Functor f, Ord k) => k -> LensLike' f [(k, [v])] [v]
lookupLens k f kvs = str kvs <$> f (gtr kvs)
where
gtr = fromMaybe [] . lookup k
str [] v = [(k, v)]
str (x@(k',_):xs) v
| k == k' = (k, v) : xs
| otherwise = x : str xs v
lookupLens :: (Functor f, Monoid v) => CompilerFlavor -> LensLike' f (PerCompilerFlavor v) v
lookupLens k f p@(PerCompilerFlavor ghc ghcjs)
| k == GHC = (\n -> PerCompilerFlavor n ghcjs) <$> f ghc
| k == GHCJS = (\n -> PerCompilerFlavor ghc n) <$> f ghcjs
| otherwise = p <$ f mempty
-------------------------------------------------------------------------------
-- Flag
......
......@@ -1659,16 +1659,13 @@ popThreadedFlag bi =
where
filterHcOptions :: (String -> Bool)
-> [(CompilerFlavor, [String])]
-> [(CompilerFlavor, [String])]
filterHcOptions p hcoptss =
[ (hc, if hc == GHC then filter p opts else opts)
| (hc, opts) <- hcoptss ]
hasThreaded :: [(CompilerFlavor, [String])] -> Bool
hasThreaded hcoptss =
or [ if hc == GHC then elem "-threaded" opts else False
| (hc, opts) <- hcoptss ]
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
filterHcOptions p (PerCompilerFlavor ghc ghcjs) =
PerCompilerFlavor (filter p ghc) ghcjs
hasThreaded :: PerCompilerFlavor [String] -> Bool
hasThreaded (PerCompilerFlavor ghc _) = elem "-threaded" ghc
-- | Extracts a String representing a hash of the ABI of a built
-- library. It can fail if the library has not yet been built.
......
......@@ -85,8 +85,8 @@ normaliseGhcArgs (Just ghcVersion) PackageDescription{..} ghcArgs
checkComponent = foldMap fun . filterGhcOptions . allGhcOptions
allGhcOptions :: BuildInfo -> [(CompilerFlavor, [String])]
allGhcOptions =
mconcat [options, profOptions, sharedOptions, staticOptions]
allGhcOptions = foldMap (perCompilerFlavorToList .)
[options, profOptions, sharedOptions, staticOptions]
filterGhcOptions :: [(CompilerFlavor, [String])] -> [[String]]
filterGhcOptions l = [opts | (GHC, opts) <- l]
......
......@@ -95,10 +95,10 @@ data BuildInfo = BuildInfo {
includeDirs :: [FilePath], -- ^directories to find .h files
includes :: [FilePath], -- ^ The .h files to be found in includeDirs
installIncludes :: [FilePath], -- ^ .h files to install with the package
options :: [(CompilerFlavor,[String])],
profOptions :: [(CompilerFlavor,[String])],
sharedOptions :: [(CompilerFlavor,[String])],
staticOptions :: [(CompilerFlavor,[String])],
options :: PerCompilerFlavor [String],
profOptions :: PerCompilerFlavor [String],
sharedOptions :: PerCompilerFlavor [String],
staticOptions :: PerCompilerFlavor [String],
customFieldsBI :: [(String,String)], -- ^Custom fields starting
-- with x-, stored in a
-- simple assoc-list.
......@@ -148,10 +148,10 @@ instance Monoid BuildInfo where
includeDirs = [],
includes = [],
installIncludes = [],
options = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
options = mempty,
profOptions = mempty,
sharedOptions = mempty,
staticOptions = mempty,
customFieldsBI = [],
targetBuildDepends = [],
mixins = []
......@@ -250,8 +250,10 @@ hcSharedOptions = lookupHcOptions sharedOptions
hcStaticOptions :: CompilerFlavor -> BuildInfo -> [String]
hcStaticOptions = lookupHcOptions staticOptions
lookupHcOptions :: (BuildInfo -> [(CompilerFlavor,[String])])
lookupHcOptions :: (BuildInfo -> PerCompilerFlavor [String])
-> CompilerFlavor -> BuildInfo -> [String]
lookupHcOptions f hc bi = [ opt | (hc',opts) <- f bi
, hc' == hc
, opt <- opts ]
lookupHcOptions f hc bi = case f bi of
PerCompilerFlavor ghc ghcjs
| hc == GHC -> ghc
| hc == GHCJS -> ghcjs
| otherwise -> mempty
......@@ -8,7 +8,7 @@ import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Compat.Lens
import Distribution.Compiler (CompilerFlavor)
import Distribution.Compiler (PerCompilerFlavor)
import Distribution.ModuleName (ModuleName)
import Distribution.Types.BuildInfo (BuildInfo)
import Distribution.Types.Dependency (Dependency)
......@@ -164,19 +164,19 @@ class HasBuildInfo a where
installIncludes = buildInfo . installIncludes
{-# INLINE installIncludes #-}
options :: Lens' a [(CompilerFlavor,[String])]
options :: Lens' a (PerCompilerFlavor [String])
options = buildInfo . options
{-# INLINE options #-}
profOptions :: Lens' a [(CompilerFlavor,[String])]
profOptions :: Lens' a (PerCompilerFlavor [String])
profOptions = buildInfo . profOptions
{-# INLINE profOptions #-}
sharedOptions :: Lens' a [(CompilerFlavor,[String])]
sharedOptions :: Lens' a (PerCompilerFlavor [String])
sharedOptions = buildInfo . sharedOptions
{-# INLINE sharedOptions #-}
staticOptions :: Lens' a [(CompilerFlavor,[String])]
staticOptions :: Lens' a (PerCompilerFlavor [String])
staticOptions = buildInfo . staticOptions
{-# INLINE staticOptions #-}
......
......@@ -16,7 +16,7 @@ import Instances.TreeDiff.Version ()
-------------------------------------------------------------------------------
import Distribution.Backpack (OpenModule, OpenUnitId)
import Distribution.Compiler (CompilerFlavor)
import Distribution.Compiler (CompilerFlavor, PerCompilerFlavor)
import Distribution.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo)
import Distribution.ModuleName (ModuleName)
import Distribution.Package (Dependency, PackageIdentifier, PackageName)
......@@ -45,6 +45,8 @@ instance (Eq a, Show a) => ToExpr (Condition a) where toExpr = defaultExprViaSho
instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondTree a b c)
instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondBranch a b c)
instance ToExpr a => ToExpr (PerCompilerFlavor a)
instance ToExpr AbiDependency where toExpr = defaultExprViaShow
instance ToExpr AbiHash where toExpr = defaultExprViaShow
instance ToExpr Benchmark
......
......@@ -150,6 +150,7 @@ regressionTests = testGroup "regressions"
, regressionTest "spdx-2.cabal"
, regressionTest "spdx-3.cabal"
, regressionTest "hidden-main-lib.cabal"
, regressionTest "jaeger-flamegraph.cabal"
]
regressionTest :: FilePath -> TestTree
......
......@@ -55,14 +55,14 @@ GenericPackageDescription
mixins = [],
oldExtensions = [EnableExtension
ScopedTypeVariables],
options = [],
options = PerCompilerFlavor [] [],
otherExtensions = [],
otherLanguages = [],
otherModules = [`ModuleName ["Data","Octree","Internal"]`],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor [] [],
sharedOptions = PerCompilerFlavor [] [],
staticOptions = PerCompilerFlavor [] [],
targetBuildDepends = [Dependency
`PackageName "base"`
(IntersectVersionRanges
......@@ -143,14 +143,17 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor [] [],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor
[] [],
sharedOptions = PerCompilerFlavor
[] [],
staticOptions = PerCompilerFlavor
[] [],
targetBuildDepends = [Dependency
`PackageName "base"`
(IntersectVersionRanges
......@@ -233,17 +236,20 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [_×_
GHC
["-pgmL",
"markdown-unlit"]],
options = PerCompilerFlavor
["-pgmL",
"markdown-unlit"]
[],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor
[] [],
sharedOptions = PerCompilerFlavor
[] [],
staticOptions = PerCompilerFlavor
[] [],
targetBuildDepends = [Dependency
`PackageName "base"`
(IntersectVersionRanges
......
......@@ -44,14 +44,14 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor [] [],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor [] [],
sharedOptions = PerCompilerFlavor [] [],
staticOptions = PerCompilerFlavor [] [],
targetBuildDepends = [Dependency
`PackageName "ghc-prim"`
AnyVersion
......@@ -106,14 +106,17 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor [] [],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor
[] [],
sharedOptions = PerCompilerFlavor
[] [],
staticOptions = PerCompilerFlavor
[] [],
targetBuildDepends = [Dependency
`PackageName "HUnit"`
AnyVersion
......
......@@ -49,14 +49,22 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor
[]
[],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor
[]
[],
sharedOptions = PerCompilerFlavor
[]
[],
staticOptions = PerCompilerFlavor
[]
[],
targetBuildDepends = [Dependency
`PackageName "unix"`
AnyVersion
......@@ -104,14 +112,14 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor [] [],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor [] [],
sharedOptions = PerCompilerFlavor [] [],
staticOptions = PerCompilerFlavor [] [],
targetBuildDepends = [],
virtualModules = []},
libExposed = True,
......
......@@ -49,14 +49,22 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor
[]
[],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor
[]
[],
sharedOptions = PerCompilerFlavor
[]
[],
staticOptions = PerCompilerFlavor
[]
[],
targetBuildDepends = [],
virtualModules = []},
libExposed = True,
......@@ -106,14 +114,22 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor
[]
[],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor
[]
[],
sharedOptions = PerCompilerFlavor
[]
[],
staticOptions = PerCompilerFlavor
[]
[],
targetBuildDepends = [Dependency
`PackageName "Win32"`
AnyVersion
......@@ -161,14 +177,22 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor
[]
[],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor
[]
[],
sharedOptions = PerCompilerFlavor
[]
[],
staticOptions = PerCompilerFlavor
[]
[],
targetBuildDepends = [],
virtualModules = []},
libExposed = True,
......@@ -218,14 +242,22 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor
[]
[],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor
[]
[],
sharedOptions = PerCompilerFlavor
[]
[],
staticOptions = PerCompilerFlavor
[]
[],
targetBuildDepends = [Dependency
`PackageName "unix"`
AnyVersion
......@@ -273,14 +305,14 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [],
options = PerCompilerFlavor [] [],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],
sharedOptions = [],
staticOptions = [],
profOptions = PerCompilerFlavor [] [],
sharedOptions = PerCompilerFlavor [] [],
staticOptions = PerCompilerFlavor [] [],
targetBuildDepends = [],
virtualModules = []},
libExposed = True,
......
......@@ -47,20 +47,20 @@ GenericPackageDescription
ldOptions = [],
mixins = [],
oldExtensions = [],
options = [_×_
GHC
["-Wall",
"-O2",
"-threaded",
"-rtsopts",
"-with-rtsopts=-N1 -A64m"]],
options = PerCompilerFlavor
["-Wall",
"-O2",
"-threaded",
"-rtsopts",
"-with-rtsopts=-N1 -A64m"]
[],
otherExtensions = [],
otherLanguages = [],
otherModules = [],
pkgconfigDepends = [],
profOptions = [],