Cabal/src/Distribution/Backpack/ModSubst.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE PatternGuards #-}
   3
   4 -- | A type class 'ModSubst' for objects which can have 'ModuleSubst'
   5 -- applied to them.
   6 --
   7 -- See also <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
   8 module Distribution.Backpack.ModSubst
   9   ( ModSubst (..)
  10   ) where
  11
  12 import Distribution.Compat.Prelude hiding (mod)
  13 import Prelude ()
  14
  15 import Distribution.Backpack
  16 import Distribution.ModuleName
  17
  18 import qualified Data.Map as Map
  19 import qualified Data.Set as Set
  20
  21 -- | Applying module substitutions to semantic objects.
  22 class ModSubst a where
  23   -- In notation, substitution is postfix, which implies
  24   -- putting it on the right hand side, but for partial
  25   -- application it's more convenient to have it on the left
  26   -- hand side.
  27   modSubst :: OpenModuleSubst -> a -> a
  28
  29 instance ModSubst OpenModule where
  30   modSubst subst (OpenModule cid mod_name) = OpenModule (modSubst subst cid) mod_name
  31   modSubst subst mod@(OpenModuleVar mod_name)
  32     | Just mod' <- Map.lookup mod_name subst = mod'
  33     | otherwise = mod
  34
  35 instance ModSubst OpenUnitId where
  36   modSubst subst (IndefFullUnitId cid insts) = IndefFullUnitId cid (modSubst subst insts)
  37   modSubst _subst uid = uid
  38
  39 instance ModSubst (Set ModuleName) where
  40   modSubst subst reqs =
  41     Set.union
  42       (Set.difference reqs (Map.keysSet subst))
  43       (openModuleSubstFreeHoles subst)
  44
  45 -- Substitutions are functorial.  NB: this means that
  46 -- there is an @instance 'ModSubst' 'ModuleSubst'@!
  47 instance ModSubst a => ModSubst (Map k a) where
  48   modSubst subst = fmap (modSubst subst)
  49 instance ModSubst a => ModSubst [a] where
  50   modSubst subst = fmap (modSubst subst)
  51 instance ModSubst a => ModSubst (k, a) where
  52   modSubst subst (x, y) = (x, modSubst subst y)