{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
module Distribution.Types.PackageDescription.Lens (
    PackageDescription,
    module Distribution.Types.PackageDescription.Lens,
    ) where

import Distribution.Compat.Lens
import Distribution.Compat.Prelude
import Prelude ()

import Distribution.CabalSpecVersion         (CabalSpecVersion)
import Distribution.Compiler                 (CompilerFlavor)
import Distribution.License                  (License)
import Distribution.ModuleName               (ModuleName)
import Distribution.Types.Benchmark          (Benchmark, benchmarkModules)
import Distribution.Types.Benchmark.Lens     (benchmarkBuildInfo, benchmarkName)
import Distribution.Types.BuildInfo          (BuildInfo)
import Distribution.Types.BuildType          (BuildType)
import Distribution.Types.ComponentName      (ComponentName (..))
import Distribution.Types.Executable         (Executable, exeModules)
import Distribution.Types.Executable.Lens    (exeBuildInfo, exeName)
import Distribution.Types.ForeignLib         (ForeignLib, foreignLibModules)
import Distribution.Types.ForeignLib.Lens    (foreignLibBuildInfo, foreignLibName)
import Distribution.Types.Library            (Library, explicitLibModules)
import Distribution.Types.Library.Lens       (libBuildInfo, libName)
import Distribution.Types.PackageDescription (PackageDescription)
import Distribution.Types.PackageId          (PackageIdentifier)
import Distribution.Types.SetupBuildInfo     (SetupBuildInfo)
import Distribution.Types.SourceRepo         (SourceRepo)
import Distribution.Types.TestSuite          (TestSuite, testModules)
import Distribution.Types.TestSuite.Lens     (testBuildInfo, testName)
import Distribution.Utils.Path               (LicenseFile, PackageDir, SymbolicPath)
import Distribution.Utils.ShortText          (ShortText)
import Distribution.Version                  (VersionRange)

import qualified Distribution.SPDX                     as SPDX
import qualified Distribution.Types.PackageDescription as T

package :: Lens' PackageDescription PackageIdentifier
package :: Lens' PackageDescription PackageIdentifier
package PackageIdentifier -> f PackageIdentifier
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PackageIdentifier
x -> PackageDescription
s { package :: PackageIdentifier
T.package = PackageIdentifier
x }) (PackageIdentifier -> f PackageIdentifier
f (PackageDescription -> PackageIdentifier
T.package PackageDescription
s))
{-# INLINE package #-}

licenseRaw :: Lens' PackageDescription (Either SPDX.License License)
licenseRaw :: Lens' PackageDescription (Either License License)
licenseRaw Either License License -> f (Either License License)
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Either License License
x -> PackageDescription
s { licenseRaw :: Either License License
T.licenseRaw = Either License License
x }) (Either License License -> f (Either License License)
f (PackageDescription -> Either License License
T.licenseRaw PackageDescription
s))
{-# INLINE licenseRaw #-}

licenseFiles :: Lens' PackageDescription [SymbolicPath PackageDir LicenseFile]
licenseFiles :: Lens' PackageDescription [SymbolicPath PackageDir LicenseFile]
licenseFiles [SymbolicPath PackageDir LicenseFile]
-> f [SymbolicPath PackageDir LicenseFile]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[SymbolicPath PackageDir LicenseFile]
x -> PackageDescription
s { licenseFiles :: [SymbolicPath PackageDir LicenseFile]
T.licenseFiles = [SymbolicPath PackageDir LicenseFile]
x }) ([SymbolicPath PackageDir LicenseFile]
-> f [SymbolicPath PackageDir LicenseFile]
f (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
T.licenseFiles PackageDescription
s))
{-# INLINE licenseFiles #-}

copyright :: Lens' PackageDescription ShortText
copyright :: Lens' PackageDescription ShortText
copyright ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { copyright :: ShortText
T.copyright = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.copyright PackageDescription
s))
{-# INLINE copyright #-}

maintainer :: Lens' PackageDescription ShortText
maintainer :: Lens' PackageDescription ShortText
maintainer ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { maintainer :: ShortText
T.maintainer = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.maintainer PackageDescription
s))
{-# INLINE maintainer #-}

author :: Lens' PackageDescription ShortText
author :: Lens' PackageDescription ShortText
author ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { author :: ShortText
T.author = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.author PackageDescription
s))
{-# INLINE author #-}

stability :: Lens' PackageDescription ShortText
stability :: Lens' PackageDescription ShortText
stability ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { stability :: ShortText
T.stability = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.stability PackageDescription
s))
{-# INLINE stability #-}

testedWith :: Lens' PackageDescription [(CompilerFlavor,VersionRange)]
testedWith :: Lens' PackageDescription [(CompilerFlavor, VersionRange)]
testedWith [(CompilerFlavor, VersionRange)]
-> f [(CompilerFlavor, VersionRange)]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(CompilerFlavor, VersionRange)]
x -> PackageDescription
s { testedWith :: [(CompilerFlavor, VersionRange)]
T.testedWith = [(CompilerFlavor, VersionRange)]
x }) ([(CompilerFlavor, VersionRange)]
-> f [(CompilerFlavor, VersionRange)]
f (PackageDescription -> [(CompilerFlavor, VersionRange)]
T.testedWith PackageDescription
s))
{-# INLINE testedWith #-}

homepage :: Lens' PackageDescription ShortText
homepage :: Lens' PackageDescription ShortText
homepage ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { homepage :: ShortText
T.homepage = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.homepage PackageDescription
s))
{-# INLINE homepage #-}

pkgUrl :: Lens' PackageDescription ShortText
pkgUrl :: Lens' PackageDescription ShortText
pkgUrl ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { pkgUrl :: ShortText
T.pkgUrl = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.pkgUrl PackageDescription
s))
{-# INLINE pkgUrl #-}

bugReports :: Lens' PackageDescription ShortText
bugReports :: Lens' PackageDescription ShortText
bugReports ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { bugReports :: ShortText
T.bugReports = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.bugReports PackageDescription
s))
{-# INLINE bugReports #-}

sourceRepos :: Lens' PackageDescription [SourceRepo]
sourceRepos :: Lens' PackageDescription [SourceRepo]
sourceRepos [SourceRepo] -> f [SourceRepo]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[SourceRepo]
x -> PackageDescription
s { sourceRepos :: [SourceRepo]
T.sourceRepos = [SourceRepo]
x }) ([SourceRepo] -> f [SourceRepo]
f (PackageDescription -> [SourceRepo]
T.sourceRepos PackageDescription
s))
{-# INLINE sourceRepos #-}

synopsis :: Lens' PackageDescription ShortText
synopsis :: Lens' PackageDescription ShortText
synopsis ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { synopsis :: ShortText
T.synopsis = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.synopsis PackageDescription
s))
{-# INLINE synopsis #-}

description :: Lens' PackageDescription ShortText
description :: Lens' PackageDescription ShortText
description ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { description :: ShortText
T.description = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.description PackageDescription
s))
{-# INLINE description #-}

category :: Lens' PackageDescription ShortText
category :: Lens' PackageDescription ShortText
category ShortText -> f ShortText
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ShortText
x -> PackageDescription
s { category :: ShortText
T.category = ShortText
x }) (ShortText -> f ShortText
f (PackageDescription -> ShortText
T.category PackageDescription
s))
{-# INLINE category #-}

customFieldsPD :: Lens' PackageDescription [(String,String)]
customFieldsPD :: Lens' PackageDescription [(String, String)]
customFieldsPD [(String, String)] -> f [(String, String)]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(String, String)]
x -> PackageDescription
s { customFieldsPD :: [(String, String)]
T.customFieldsPD = [(String, String)]
x }) ([(String, String)] -> f [(String, String)]
f (PackageDescription -> [(String, String)]
T.customFieldsPD PackageDescription
s))
{-# INLINE customFieldsPD #-}

specVersion :: Lens' PackageDescription CabalSpecVersion
specVersion :: Lens' PackageDescription CabalSpecVersion
specVersion CabalSpecVersion -> f CabalSpecVersion
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CabalSpecVersion
x -> PackageDescription
s { specVersion :: CabalSpecVersion
T.specVersion = CabalSpecVersion
x }) (CabalSpecVersion -> f CabalSpecVersion
f (PackageDescription -> CabalSpecVersion
T.specVersion PackageDescription
s))
{-# INLINE specVersion #-}

buildTypeRaw :: Lens' PackageDescription (Maybe BuildType)
buildTypeRaw :: Lens' PackageDescription (Maybe BuildType)
buildTypeRaw Maybe BuildType -> f (Maybe BuildType)
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe BuildType
x -> PackageDescription
s { buildTypeRaw :: Maybe BuildType
T.buildTypeRaw = Maybe BuildType
x }) (Maybe BuildType -> f (Maybe BuildType)
f (PackageDescription -> Maybe BuildType
T.buildTypeRaw PackageDescription
s))
{-# INLINE buildTypeRaw #-}

setupBuildInfo :: Lens' PackageDescription (Maybe SetupBuildInfo)
setupBuildInfo :: Lens' PackageDescription (Maybe SetupBuildInfo)
setupBuildInfo Maybe SetupBuildInfo -> f (Maybe SetupBuildInfo)
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe SetupBuildInfo
x -> PackageDescription
s { setupBuildInfo :: Maybe SetupBuildInfo
T.setupBuildInfo = Maybe SetupBuildInfo
x }) (Maybe SetupBuildInfo -> f (Maybe SetupBuildInfo)
f (PackageDescription -> Maybe SetupBuildInfo
T.setupBuildInfo PackageDescription
s))
{-# INLINE setupBuildInfo #-}

library :: Lens' PackageDescription (Maybe Library)
library :: Lens' PackageDescription (Maybe Library)
library Maybe Library -> f (Maybe Library)
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Library
x -> PackageDescription
s { library :: Maybe Library
T.library = Maybe Library
x }) (Maybe Library -> f (Maybe Library)
f (PackageDescription -> Maybe Library
T.library PackageDescription
s))
{-# INLINE library #-}

subLibraries :: Lens' PackageDescription [Library]
subLibraries :: Lens' PackageDescription [Library]
subLibraries [Library] -> f [Library]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Library]
x -> PackageDescription
s { subLibraries :: [Library]
T.subLibraries = [Library]
x }) ([Library] -> f [Library]
f (PackageDescription -> [Library]
T.subLibraries PackageDescription
s))
{-# INLINE subLibraries #-}

executables :: Lens' PackageDescription [Executable]
executables :: Lens' PackageDescription [Executable]
executables [Executable] -> f [Executable]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Executable]
x -> PackageDescription
s { executables :: [Executable]
T.executables = [Executable]
x }) ([Executable] -> f [Executable]
f (PackageDescription -> [Executable]
T.executables PackageDescription
s))
{-# INLINE executables #-}

foreignLibs :: Lens' PackageDescription [ForeignLib]
foreignLibs :: Lens' PackageDescription [ForeignLib]
foreignLibs [ForeignLib] -> f [ForeignLib]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[ForeignLib]
x -> PackageDescription
s { foreignLibs :: [ForeignLib]
T.foreignLibs = [ForeignLib]
x }) ([ForeignLib] -> f [ForeignLib]
f (PackageDescription -> [ForeignLib]
T.foreignLibs PackageDescription
s))
{-# INLINE foreignLibs #-}

testSuites :: Lens' PackageDescription [TestSuite]
testSuites :: Lens' PackageDescription [TestSuite]
testSuites [TestSuite] -> f [TestSuite]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[TestSuite]
x -> PackageDescription
s { testSuites :: [TestSuite]
T.testSuites = [TestSuite]
x }) ([TestSuite] -> f [TestSuite]
f (PackageDescription -> [TestSuite]
T.testSuites PackageDescription
s))
{-# INLINE testSuites #-}

benchmarks :: Lens' PackageDescription [Benchmark]
benchmarks :: Lens' PackageDescription [Benchmark]
benchmarks [Benchmark] -> f [Benchmark]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Benchmark]
x -> PackageDescription
s { benchmarks :: [Benchmark]
T.benchmarks = [Benchmark]
x }) ([Benchmark] -> f [Benchmark]
f (PackageDescription -> [Benchmark]
T.benchmarks PackageDescription
s))
{-# INLINE benchmarks #-}

dataFiles :: Lens' PackageDescription [FilePath]
dataFiles :: Lens' PackageDescription [String]
dataFiles [String] -> f [String]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[String]
x -> PackageDescription
s { dataFiles :: [String]
T.dataFiles = [String]
x }) ([String] -> f [String]
f (PackageDescription -> [String]
T.dataFiles PackageDescription
s))
{-# INLINE dataFiles #-}

dataDir :: Lens' PackageDescription FilePath
dataDir :: Lens' PackageDescription String
dataDir String -> f String
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> PackageDescription
s { dataDir :: String
T.dataDir = String
x }) (String -> f String
f (PackageDescription -> String
T.dataDir PackageDescription
s))
{-# INLINE dataDir #-}

extraSrcFiles :: Lens' PackageDescription [String]
extraSrcFiles :: Lens' PackageDescription [String]
extraSrcFiles [String] -> f [String]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[String]
x -> PackageDescription
s { extraSrcFiles :: [String]
T.extraSrcFiles = [String]
x }) ([String] -> f [String]
f (PackageDescription -> [String]
T.extraSrcFiles PackageDescription
s))
{-# INLINE extraSrcFiles #-}

extraTmpFiles :: Lens' PackageDescription [String]
extraTmpFiles :: Lens' PackageDescription [String]
extraTmpFiles [String] -> f [String]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[String]
x -> PackageDescription
s { extraTmpFiles :: [String]
T.extraTmpFiles = [String]
x }) ([String] -> f [String]
f (PackageDescription -> [String]
T.extraTmpFiles PackageDescription
s))
{-# INLINE extraTmpFiles #-}

extraDocFiles :: Lens' PackageDescription [String]
extraDocFiles :: Lens' PackageDescription [String]
extraDocFiles [String] -> f [String]
f PackageDescription
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[String]
x -> PackageDescription
s { extraDocFiles :: [String]
T.extraDocFiles = [String]
x }) ([String] -> f [String]
f (PackageDescription -> [String]
T.extraDocFiles PackageDescription
s))
{-# INLINE extraDocFiles #-}

-- | @since 3.0.0.0
allLibraries :: Traversal' PackageDescription Library
allLibraries :: Traversal' PackageDescription Library
allLibraries Library -> f Library
f PackageDescription
pd = Maybe Library -> [Library] -> PackageDescription
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Library -> f Library
f (PackageDescription -> Maybe Library
T.library PackageDescription
pd) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Library -> f Library
f (PackageDescription -> [Library]
T.subLibraries PackageDescription
pd)
  where
    mk :: Maybe Library -> [Library] -> PackageDescription
mk Maybe Library
l [Library]
ls = PackageDescription
pd { library :: Maybe Library
T.library = Maybe Library
l, subLibraries :: [Library]
T.subLibraries = [Library]
ls }

-- | @since 2.4
componentModules :: Monoid r => ComponentName -> Getting r PackageDescription [ModuleName]
componentModules :: forall r.
Monoid r =>
ComponentName -> Getting r PackageDescription [ModuleName]
componentModules ComponentName
cname = case ComponentName
cname of
    CLibName    LibraryName
name ->
      forall name r a.
(Eq name, Monoid r) =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> (a -> [ModuleName])
-> Getting r PackageDescription [ModuleName]
componentModules' LibraryName
name Traversal' PackageDescription Library
allLibraries             Lens' Library LibraryName
libName            Library -> [ModuleName]
explicitLibModules
    CFLibName   UnqualComponentName
name ->
      forall name r a.
(Eq name, Monoid r) =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> (a -> [ModuleName])
-> Getting r PackageDescription [ModuleName]
componentModules' UnqualComponentName
name (Lens' PackageDescription [ForeignLib]
foreignLibs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Lens' ForeignLib UnqualComponentName
foreignLibName     ForeignLib -> [ModuleName]
foreignLibModules
    CExeName    UnqualComponentName
name ->
      forall name r a.
(Eq name, Monoid r) =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> (a -> [ModuleName])
-> Getting r PackageDescription [ModuleName]
componentModules' UnqualComponentName
name (Lens' PackageDescription [Executable]
executables forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Lens' Executable UnqualComponentName
exeName            Executable -> [ModuleName]
exeModules
    CTestName   UnqualComponentName
name ->
      forall name r a.
(Eq name, Monoid r) =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> (a -> [ModuleName])
-> Getting r PackageDescription [ModuleName]
componentModules' UnqualComponentName
name (Lens' PackageDescription [TestSuite]
testSuites  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Lens' TestSuite UnqualComponentName
testName           TestSuite -> [ModuleName]
testModules
    CBenchName  UnqualComponentName
name ->
      forall name r a.
(Eq name, Monoid r) =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> (a -> [ModuleName])
-> Getting r PackageDescription [ModuleName]
componentModules' UnqualComponentName
name (Lens' PackageDescription [Benchmark]
benchmarks  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Lens' Benchmark UnqualComponentName
benchmarkName      Benchmark -> [ModuleName]
benchmarkModules
  where
    componentModules'
        :: (Eq name, Monoid r)
        => name
        -> Traversal' PackageDescription a
        -> Lens' a name
        -> (a -> [ModuleName])
        -> Getting r PackageDescription [ModuleName]
    componentModules' :: forall name r a.
(Eq name, Monoid r) =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> (a -> [ModuleName])
-> Getting r PackageDescription [ModuleName]
componentModules' name
name Traversal' PackageDescription a
pdL Lens' a name
nameL a -> [ModuleName]
modules =
        Traversal' PackageDescription a
pdL
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Traversal' a a
filtered ((forall a. Eq a => a -> a -> Bool
== name
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting a s a -> s -> a
view Lens' a name
nameL)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a r. (s -> a) -> Getting r s a
getting a -> [ModuleName]
modules

    filtered :: (a -> Bool) -> Traversal' a a
    filtered :: forall a. (a -> Bool) -> Traversal' a a
filtered a -> Bool
p a -> f a
f a
s = if a -> Bool
p a
s then a -> f a
f a
s else forall (f :: * -> *) a. Applicative f => a -> f a
pure a
s

-- | @since 2.4
componentBuildInfo :: ComponentName -> Traversal' PackageDescription BuildInfo
componentBuildInfo :: ComponentName -> Traversal' PackageDescription BuildInfo
componentBuildInfo ComponentName
cname = case ComponentName
cname of
    CLibName    LibraryName
name ->
      forall name a.
Eq name =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> Traversal' a BuildInfo
-> Traversal' PackageDescription BuildInfo
componentBuildInfo' LibraryName
name Traversal' PackageDescription Library
allLibraries             Lens' Library LibraryName
libName            Lens' Library BuildInfo
libBuildInfo
    CFLibName   UnqualComponentName
name ->
      forall name a.
Eq name =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> Traversal' a BuildInfo
-> Traversal' PackageDescription BuildInfo
componentBuildInfo' UnqualComponentName
name (Lens' PackageDescription [ForeignLib]
foreignLibs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Lens' ForeignLib UnqualComponentName
foreignLibName     Lens' ForeignLib BuildInfo
foreignLibBuildInfo
    CExeName    UnqualComponentName
name ->
      forall name a.
Eq name =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> Traversal' a BuildInfo
-> Traversal' PackageDescription BuildInfo
componentBuildInfo' UnqualComponentName
name (Lens' PackageDescription [Executable]
executables forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Lens' Executable UnqualComponentName
exeName            Lens' Executable BuildInfo
exeBuildInfo
    CTestName   UnqualComponentName
name ->
      forall name a.
Eq name =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> Traversal' a BuildInfo
-> Traversal' PackageDescription BuildInfo
componentBuildInfo' UnqualComponentName
name (Lens' PackageDescription [TestSuite]
testSuites  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Lens' TestSuite UnqualComponentName
testName           Lens' TestSuite BuildInfo
testBuildInfo
    CBenchName  UnqualComponentName
name ->
      forall name a.
Eq name =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> Traversal' a BuildInfo
-> Traversal' PackageDescription BuildInfo
componentBuildInfo' UnqualComponentName
name (Lens' PackageDescription [Benchmark]
benchmarks  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Lens' Benchmark UnqualComponentName
benchmarkName      Lens' Benchmark BuildInfo
benchmarkBuildInfo
  where
    componentBuildInfo' :: Eq name
                        => name
                        -> Traversal' PackageDescription a
                        -> Lens' a name
                        -> Traversal' a BuildInfo
                        -> Traversal' PackageDescription BuildInfo
    componentBuildInfo' :: forall name a.
Eq name =>
name
-> Traversal' PackageDescription a
-> Lens' a name
-> Traversal' a BuildInfo
-> Traversal' PackageDescription BuildInfo
componentBuildInfo' name
name Traversal' PackageDescription a
pdL Lens' a name
nameL Traversal' a BuildInfo
biL =
        Traversal' PackageDescription a
pdL
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Traversal' a a
filtered ((forall a. Eq a => a -> a -> Bool
== name
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting a s a -> s -> a
view Lens' a name
nameL)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' a BuildInfo
biL

    filtered :: (a -> Bool) -> Traversal' a a
    filtered :: forall a. (a -> Bool) -> Traversal' a a
filtered a -> Bool
p a -> f a
f a
s = if a -> Bool
p a
s then a -> f a
f a
s else forall (f :: * -> *) a. Applicative f => a -> f a
pure a
s