Add WithStage

Author: andreabedini

cabal-install/cabal-install.cabal

@@ -184,6 +184,7 @@ library
         Distribution.Client.ProjectPlanOutput
         Distribution.Client.ProjectPlanning
         Distribution.Client.ProjectPlanning.SetupPolicy
+        Distribution.Client.ProjectPlanning.Stage
         Distribution.Client.ProjectPlanning.Types
         Distribution.Client.RebuildMonad
         Distribution.Client.Reconfigure

cabal-install/src/Distribution/Client/ProjectPlanning/Stage.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE TypeFamilies #-}
+module Distribution.Client.ProjectPlanning.Stage
+  ( WithStage(..)
+  , Stage(..)
+  , HasStage(..)
+  ) where
+
+import Distribution.Client.Compat.Prelude
+import Prelude ()
+
+import Distribution.Compat.Graph (IsNode (..))
+import Distribution.Package (HasUnitId(..), Package(..))
+import Distribution.Client.Types.ConfiguredId (HasConfiguredId(..))
+import Distribution.Solver.Types.Stage (Stage(..))
+import Text.PrettyPrint (colon)
+
+  -- FIXME: blaaah
+data WithStage a = WithStage Stage a
+    deriving (Eq, Ord, Show, Generic, Functor, Foldable, Traversable)
+
+instance Binary a => Binary (WithStage a)
+instance Structured a => Structured (WithStage a)
+
+instance Package pkg => Package (WithStage pkg) where
+  packageId (WithStage _stage pkg) = packageId pkg
+
+instance IsNode a => IsNode (WithStage a) where
+  type Key (WithStage a) = WithStage (Key a)
+  nodeKey = fmap nodeKey
+  nodeNeighbors = traverse nodeNeighbors
+
+instance HasUnitId a => HasUnitId (WithStage a) where
+  installedUnitId (WithStage _stage pkg) = installedUnitId pkg
+
+instance HasConfiguredId a => HasConfiguredId (WithStage a) where
+  configuredId (WithStage _stage pkg) = configuredId pkg
+
+instance Pretty a => Pretty (WithStage a) where
+  pretty (WithStage s pkg) = pretty s <> colon <> pretty pkg
+
+class HasStage a where
+  stageOf :: a -> Stage
+
+instance HasStage (WithStage a) where
+  stageOf (WithStage s _) = s

cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs

@@ -58,6 +58,9 @@ module Distribution.Client.ProjectPlanning.Types
   , isBenchComponentTarget
   , componentOptionalStanza
 
+  -- * Blaah
+  , WithStage(..)
+  
     -- * Toolchain
   , Toolchain (..)
   , Toolchains
@@ -117,6 +120,7 @@ import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
 import qualified Distribution.Solver.Types.ComponentDeps as CD
 import Distribution.Solver.Types.OptionalStanza
 import Distribution.Solver.Types.Toolchain
+import Distribution.Client.ProjectPlanning.Stage
 import Distribution.Types.ComponentRequestedSpec
 import qualified Distribution.Types.LocalBuildConfig as LBC
 import Distribution.Types.PackageDescription (PackageDescription (..))