    {-# 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.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 :: OpenModuleSubst -> OpenModule -> OpenModule
    modSubst OpenModuleSubst
    subst (OpenModule OpenUnitId
    cid ModuleName
    mod_name) = OpenUnitId -> ModuleName -> OpenModule
    OpenModule (OpenModuleSubst -> OpenUnitId -> OpenUnitId
    forall a. ModSubst a => OpenModuleSubst -> a -> a
    modSubst OpenModuleSubst
    subst OpenUnitId
    cid) ModuleName
    mod_name
        modSubst OpenModuleSubst
    subst mod :: OpenModule
    mod@(OpenModuleVar ModuleName
    mod_name)
            | Just OpenModule
    mod' <- ModuleName -> OpenModuleSubst -> Maybe OpenModule
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ModuleName
    mod_name OpenModuleSubst
    subst = OpenModule
    mod'
            | Bool
    otherwise = OpenModule
    mod

    instance ModSubst OpenUnitId where
        modSubst :: OpenModuleSubst -> OpenUnitId -> OpenUnitId
    modSubst OpenModuleSubst
    subst (IndefFullUnitId ComponentId
    cid OpenModuleSubst
    insts) = ComponentId -> OpenModuleSubst -> OpenUnitId
    IndefFullUnitId ComponentId
    cid (OpenModuleSubst -> OpenModuleSubst -> OpenModuleSubst
    forall a. ModSubst a => OpenModuleSubst -> a -> a
    modSubst OpenModuleSubst
    subst OpenModuleSubst
    insts)
        modSubst OpenModuleSubst
    _subst OpenUnitId
    uid = OpenUnitId
    uid

    instance ModSubst (Set ModuleName) where
        modSubst :: OpenModuleSubst -> Set ModuleName -> Set ModuleName
    modSubst OpenModuleSubst
    subst Set ModuleName
    reqs
            = Set ModuleName -> Set ModuleName -> Set ModuleName
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union (Set ModuleName -> Set ModuleName -> Set ModuleName
    forall a. Ord a => Set a -> Set a -> Set a
    Set.difference Set ModuleName
    reqs (OpenModuleSubst -> Set ModuleName
    forall k a. Map k a -> Set k
    Map.keysSet OpenModuleSubst
    subst))
                        (OpenModuleSubst -> Set ModuleName
    openModuleSubstFreeHoles OpenModuleSubst
    subst)

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