1{-# LANGUAGE Rank2Types #-}
2module Distribution.Types.GenericPackageDescription.Lens (
3    GenericPackageDescription,
4    PackageFlag,
5    FlagName,
6    ConfVar (..),
7    module Distribution.Types.GenericPackageDescription.Lens,
8    ) where
9
10import Prelude()
11import Distribution.Compat.Prelude
12import Distribution.Compat.Lens
13
14import qualified Distribution.Types.GenericPackageDescription as T
15
16-- We import types from their packages, so we can remove unused imports
17-- and have wider inter-module dependency graph
18import Distribution.Types.CondTree (CondTree)
19import Distribution.Types.Dependency (Dependency)
20import Distribution.Types.Executable (Executable)
21import Distribution.Types.PackageDescription (PackageDescription)
22import Distribution.Types.Benchmark (Benchmark)
23import Distribution.Types.ForeignLib (ForeignLib)
24import Distribution.Types.GenericPackageDescription (GenericPackageDescription(GenericPackageDescription) )
25import Distribution.Types.Flag (PackageFlag(MkPackageFlag), FlagName)
26import Distribution.Types.ConfVar (ConfVar (..))
27import Distribution.Types.Library (Library)
28import Distribution.Types.TestSuite (TestSuite)
29import Distribution.Types.UnqualComponentName (UnqualComponentName)
30import Distribution.System (Arch, OS)
31import Distribution.Compiler (CompilerFlavor)
32import Distribution.Version (Version, VersionRange)
33
34-------------------------------------------------------------------------------
35-- GenericPackageDescription
36-------------------------------------------------------------------------------
37
38packageDescription :: Lens' GenericPackageDescription PackageDescription
39packageDescription f s = fmap (\x -> s { T.packageDescription = x }) (f (T.packageDescription s))
40{-# INLINE packageDescription #-}
41
42gpdScannedVersion :: Lens' GenericPackageDescription (Maybe Version)
43gpdScannedVersion f s = fmap (\x -> s { T.gpdScannedVersion = x }) (f (T.gpdScannedVersion s))
44{-# INLINE gpdScannedVersion #-}
45
46genPackageFlags :: Lens' GenericPackageDescription [PackageFlag]
47genPackageFlags f s = fmap (\x -> s { T.genPackageFlags = x }) (f (T.genPackageFlags s))
48{-# INLINE genPackageFlags #-}
49
50condLibrary :: Lens' GenericPackageDescription (Maybe (CondTree ConfVar [Dependency] Library))
51condLibrary f s = fmap (\x -> s { T.condLibrary = x }) (f (T.condLibrary s))
52{-# INLINE condLibrary #-}
53
54condSubLibraries :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] Library))]
55condSubLibraries f s = fmap (\x -> s { T.condSubLibraries = x }) (f (T.condSubLibraries s))
56{-# INLINE condSubLibraries #-}
57
58condForeignLibs :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] ForeignLib))]
59condForeignLibs f s = fmap (\x -> s { T.condForeignLibs = x }) (f (T.condForeignLibs s))
60{-# INLINE condForeignLibs #-}
61
62condExecutables :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] Executable))]
63condExecutables f s = fmap (\x -> s { T.condExecutables = x }) (f (T.condExecutables s))
64{-# INLINE condExecutables #-}
65
66condTestSuites :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] TestSuite))]
67condTestSuites f s = fmap (\x -> s { T.condTestSuites = x }) (f (T.condTestSuites s))
68{-# INLINE condTestSuites #-}
69
70condBenchmarks :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] Benchmark))]
71condBenchmarks f s = fmap (\x -> s { T.condBenchmarks = x }) (f (T.condBenchmarks s))
72{-# INLINE condBenchmarks #-}
73
74allCondTrees
75  :: Applicative f
76  => (forall a. CondTree ConfVar [Dependency] a
77          -> f (CondTree ConfVar [Dependency] a))
78  -> GenericPackageDescription
79  -> f GenericPackageDescription
80allCondTrees f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) =
81    GenericPackageDescription
82        <$> pure p
83        <*> pure v
84        <*> pure a1
85        <*> traverse f x1
86        <*> (traverse . _2) f x2
87        <*> (traverse . _2) f x3
88        <*> (traverse . _2) f x4
89        <*> (traverse . _2) f x5
90        <*> (traverse . _2) f x6
91
92
93-------------------------------------------------------------------------------
94-- Flag
95-------------------------------------------------------------------------------
96
97flagName :: Lens' PackageFlag FlagName
98flagName f (MkPackageFlag x1 x2 x3 x4) = fmap (\y1 -> MkPackageFlag y1 x2 x3 x4) (f x1)
99{-# INLINE flagName #-}
100
101flagDescription :: Lens' PackageFlag String
102flagDescription f (MkPackageFlag x1 x2 x3 x4) = fmap (\y1 -> MkPackageFlag x1 y1 x3 x4) (f x2)
103{-# INLINE flagDescription #-}
104
105flagDefault :: Lens' PackageFlag Bool
106flagDefault f (MkPackageFlag x1 x2 x3 x4) = fmap (\y1 -> MkPackageFlag x1 x2 y1 x4) (f x3)
107{-# INLINE flagDefault #-}
108
109flagManual :: Lens' PackageFlag Bool
110flagManual f (MkPackageFlag x1 x2 x3 x4) = fmap (\y1 -> MkPackageFlag x1 x2 x3 y1) (f x4)
111{-# INLINE flagManual #-}
112
113-------------------------------------------------------------------------------
114-- ConfVar
115-------------------------------------------------------------------------------
116
117_OS :: Traversal' ConfVar OS
118_OS f (OS os) = OS <$> f os
119_OS _ x       = pure x
120
121_Arch :: Traversal' ConfVar Arch
122_Arch f (Arch arch) = Arch <$> f arch
123_Arch _ x           = pure x
124
125_PackageFlag :: Traversal' ConfVar FlagName
126_PackageFlag f (PackageFlag flag) = PackageFlag <$> f flag
127_PackageFlag _ x                  = pure x
128
129_Impl :: Traversal' ConfVar (CompilerFlavor, VersionRange)
130_Impl f (Impl cf vr) = uncurry Impl <$> f (cf, vr)
131_Impl _ x            = pure x
132