Skip to content

Commit

Permalink
Merge pull request #5723 from haskell/per-compiler-flavor
Browse files Browse the repository at this point in the history 
Refactor options fields to use PerCompilerFlavor type
  • Loading branch information
@phadej
phadej authored Dec 2, 2018
2 parents 1f56603 + 3ac7605 commit dd745a9
Show file tree
Hide file tree
Showing 33 changed files with 1,235 additions and 380 deletions.
3 changes: 3 additions & 0 deletions Cabal/Cabal.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
29 changes: 29 additions & 0 deletions Cabal/Distribution/Compiler.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,10 @@ module Distribution.Compiler (
classifyCompilerFlavor,
knownCompilerFlavors,

-- * Per compiler flavor
PerCompilerFlavor (..),
perCompilerFlavorToList,

-- * Compiler id
CompilerId(..),

Expand Down Expand Up @@ -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
-- ------------------------------------------------------------
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/PackageDescription/Check.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 ]
++
Expand Down
46 changes: 13 additions & 33 deletions Cabal/Distribution/PackageDescription/FieldGrammar.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
17 changes: 7 additions & 10 deletions Cabal/Distribution/Simple/GHC.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
4 changes: 2 additions & 2 deletions Cabal/Distribution/Simple/Program/GHC.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down
26 changes: 14 additions & 12 deletions Cabal/Distribution/Types/BuildInfo.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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 = []
Expand Down Expand Up @@ -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
10 changes: 5 additions & 5 deletions Cabal/Distribution/Types/BuildInfo/Lens.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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 #-}

Expand Down
4 changes: 3 additions & 1 deletion Cabal/tests/Instances/TreeDiff.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions Cabal/tests/ParserTests.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
36 changes: 21 additions & 15 deletions Cabal/tests/ParserTests/regressions/Octree-0.5.expr
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit dd745a9

Please sign in to comment.