Cabal/src/Distribution/Backpack/PreModuleShape.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3
   4 module Distribution.Backpack.PreModuleShape
   5   ( PreModuleShape (..)
   6   , toPreModuleShape
   7   , renamePreModuleShape
   8   , mixLinkPreModuleShape
   9   ) where
  10
  11 import Distribution.Compat.Prelude
  12 import Prelude ()
  13
  14 import qualified Data.Map as Map
  15 import qualified Data.Set as Set
  16
  17 import Distribution.Backpack.ModuleShape
  18 import Distribution.ModuleName
  19 import Distribution.Types.IncludeRenaming
  20 import Distribution.Types.ModuleRenaming
  21
  22 data PreModuleShape = PreModuleShape
  23   { preModShapeProvides :: Set ModuleName
  24   , preModShapeRequires :: Set ModuleName
  25   }
  26   deriving (Eq, Show, Generic)
  27
  28 toPreModuleShape :: ModuleShape -> PreModuleShape
  29 toPreModuleShape (ModuleShape provs reqs) = PreModuleShape (Map.keysSet provs) reqs
  30
  31 renamePreModuleShape :: PreModuleShape -> IncludeRenaming -> PreModuleShape
  32 renamePreModuleShape (PreModuleShape provs reqs) (IncludeRenaming prov_rn req_rn) =
  33   PreModuleShape
  34     (Set.fromList (mapMaybe prov_fn (Set.toList provs)))
  35     (Set.map req_fn reqs)
  36   where
  37     prov_fn = interpModuleRenaming prov_rn
  38     req_fn k = fromMaybe k (interpModuleRenaming req_rn k)
  39
  40 mixLinkPreModuleShape :: [PreModuleShape] -> PreModuleShape
  41 mixLinkPreModuleShape shapes = PreModuleShape provs (Set.difference reqs provs)
  42   where
  43     provs = Set.unions (map preModShapeProvides shapes)
  44     reqs = Set.unions (map preModShapeRequires shapes)