Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Refactor options fields to use PerCompilerFlavor type #5723

Merged
merged 1 commit into from
Dec 2, 2018
Merged

Refactor options fields to use PerCompilerFlavor type #5723

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions Cabal/Cabal.cabal
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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