Cabal-syntax/src/Distribution/Types/GenericPackageDescription.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3 {-# LANGUAGE FlexibleContexts #-}
   4 {-# LANGUAGE ScopedTypeVariables #-}
   5
   6 module Distribution.Types.GenericPackageDescription
   7   ( GenericPackageDescription (..)
   8   , emptyGenericPackageDescription
   9   ) where
  10
  11 import Distribution.Compat.Prelude
  12 import Prelude ()
  13
  14 -- lens
  15 import Distribution.Compat.Lens as L
  16 import qualified Distribution.Types.BuildInfo.Lens as L
  17
  18 import Distribution.Types.PackageDescription
  19
  20 import Distribution.Package
  21 import Distribution.Types.Benchmark
  22 import Distribution.Types.CondTree
  23 import Distribution.Types.ConfVar
  24 import Distribution.Types.Executable
  25 import Distribution.Types.Flag
  26 import Distribution.Types.ForeignLib
  27 import Distribution.Types.Library
  28 import Distribution.Types.TestSuite
  29 import Distribution.Types.UnqualComponentName
  30 import Distribution.Version
  31
  32 -- ---------------------------------------------------------------------------
  33 -- The 'GenericPackageDescription' type
  34
  35 data GenericPackageDescription = GenericPackageDescription
  36   { packageDescription :: PackageDescription
  37   , gpdScannedVersion :: Maybe Version
  38   -- ^ This is a version as specified in source.
  39   --   We populate this field in index reading for dummy GPDs,
  40   --   only when GPD reading failed, but scanning haven't.
  41   --
  42   --   Cabal-the-library never produces GPDs with Just as gpdScannedVersion.
  43   --
  44   --   Perfectly, PackageIndex should have sum type, so we don't need to
  45   --   have dummy GPDs.
  46   , genPackageFlags :: [PackageFlag]
  47   , condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
  48   , condSubLibraries
  49       :: [ ( UnqualComponentName
  50            , CondTree ConfVar [Dependency] Library
  51            )
  52          ]
  53   , condForeignLibs
  54       :: [ ( UnqualComponentName
  55            , CondTree ConfVar [Dependency] ForeignLib
  56            )
  57          ]
  58   , condExecutables
  59       :: [ ( UnqualComponentName
  60            , CondTree ConfVar [Dependency] Executable
  61            )
  62          ]
  63   , condTestSuites
  64       :: [ ( UnqualComponentName
  65            , CondTree ConfVar [Dependency] TestSuite
  66            )
  67          ]
  68   , condBenchmarks
  69       :: [ ( UnqualComponentName
  70            , CondTree ConfVar [Dependency] Benchmark
  71            )
  72          ]
  73   }
  74   deriving (Show, Eq, Typeable, Data, Generic)
  75
  76 instance Package GenericPackageDescription where
  77   packageId = packageId . packageDescription
  78
  79 instance Binary GenericPackageDescription
  80 instance Structured GenericPackageDescription
  81 instance NFData GenericPackageDescription where rnf = genericRnf
  82
  83 emptyGenericPackageDescription :: GenericPackageDescription
  84 emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescription Nothing [] Nothing [] [] [] [] []
  85
  86 -- -----------------------------------------------------------------------------
  87 -- Traversal Instances
  88
  89 instance L.HasBuildInfos GenericPackageDescription where
  90   traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) =
  91     GenericPackageDescription
  92       <$> L.traverseBuildInfos f p
  93       <*> pure v
  94       <*> pure a1
  95       <*> (traverse . traverseCondTreeBuildInfo) f x1
  96       <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x2
  97       <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x3
  98       <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x4
  99       <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x5
 100       <*> (traverse . L._2 . traverseCondTreeBuildInfo) f x6
 101
 102 -- We use this traversal to keep [Dependency] field in CondTree up to date.
 103 traverseCondTreeBuildInfo
 104   :: forall f comp v
 105    . (Applicative f, L.HasBuildInfo comp)
 106   => LensLike' f (CondTree v [Dependency] comp) L.BuildInfo
 107 traverseCondTreeBuildInfo g = node
 108   where
 109     mkCondNode :: comp -> [CondBranch v [Dependency] comp] -> CondTree v [Dependency] comp
 110     mkCondNode comp = CondNode comp (view L.targetBuildDepends comp)
 111
 112     node (CondNode comp _ branches) =
 113       mkCondNode
 114         <$> L.buildInfo g comp
 115         <*> traverse branch branches
 116
 117     branch (CondBranch v x y) =
 118       CondBranch v
 119         <$> node x
 120         <*> traverse node y