ModSubst.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards #-}

-- | A type class 'ModSubst' for objects which can have 'ModuleSubst'
-- applied to them.
--
-- See also <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.ModSubst
  ( ModSubst (..)
  ) where

import Distribution.Compat.Prelude hiding (mod)
import Prelude ()

import Distribution.Backpack
import Distribution.ModuleName

import qualified Data.Map as Map
import qualified Data.Set as Set

-- | Applying module substitutions to semantic objects.
class ModSubst a where
  -- In notation, substitution is postfix, which implies
  -- putting it on the right hand side, but for partial
  -- application it's more convenient to have it on the left
  -- hand side.
  modSubst :: OpenModuleSubst -> a -> a

instance ModSubst OpenModule where
  modSubst subst (OpenModule cid mod_name) = OpenModule (modSubst subst cid) mod_name
  modSubst subst mod@(OpenModuleVar mod_name)
    | Just mod' <- Map.lookup mod_name subst = mod'
    | otherwise = mod

instance ModSubst OpenUnitId where
  modSubst subst (IndefFullUnitId cid insts) = IndefFullUnitId cid (modSubst subst insts)
  modSubst _subst uid = uid

instance ModSubst (Set ModuleName) where
  modSubst subst reqs =
    Set.union
      (Set.difference reqs (Map.keysSet subst))
      (openModuleSubstFreeHoles subst)

-- Substitutions are functorial.  NB: this means that
-- there is an @instance 'ModSubst' 'ModuleSubst'@!
instance ModSubst a => ModSubst (Map k a) where
  modSubst subst = fmap (modSubst subst)
instance ModSubst a => ModSubst [a] where
  modSubst subst = fmap (modSubst subst)
instance ModSubst a => ModSubst (k, a) where
  modSubst subst (x, y) = (x, modSubst subst y)