{-# 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 Prelude ()
import Distribution.Compat.Prelude hiding (mod)

import Distribution.ModuleName

import Distribution.Backpack

import qualified Data.Map as Map
import Data.Set (Set)
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)