{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Distribution.Backpack.PreModuleShape (
    PreModuleShape(..),
    toPreModuleShape,
    renamePreModuleShape,
    mixLinkPreModuleShape,
) where

import Prelude ()
import Distribution.Compat.Prelude

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

import Distribution.Backpack.ModuleShape
import Distribution.Types.IncludeRenaming
import Distribution.Types.ModuleRenaming
import Distribution.ModuleName

data PreModuleShape = PreModuleShape {
        PreModuleShape -> Set ModuleName
preModShapeProvides :: Set ModuleName,
        PreModuleShape -> Set ModuleName
preModShapeRequires :: Set ModuleName
    }
    deriving (PreModuleShape -> PreModuleShape -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreModuleShape -> PreModuleShape -> Bool
$c/= :: PreModuleShape -> PreModuleShape -> Bool
== :: PreModuleShape -> PreModuleShape -> Bool
$c== :: PreModuleShape -> PreModuleShape -> Bool
Eq, Int -> PreModuleShape -> ShowS
[PreModuleShape] -> ShowS
PreModuleShape -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreModuleShape] -> ShowS
$cshowList :: [PreModuleShape] -> ShowS
show :: PreModuleShape -> String
$cshow :: PreModuleShape -> String
showsPrec :: Int -> PreModuleShape -> ShowS
$cshowsPrec :: Int -> PreModuleShape -> ShowS
Show, forall x. Rep PreModuleShape x -> PreModuleShape
forall x. PreModuleShape -> Rep PreModuleShape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PreModuleShape x -> PreModuleShape
$cfrom :: forall x. PreModuleShape -> Rep PreModuleShape x
Generic)

toPreModuleShape :: ModuleShape -> PreModuleShape
toPreModuleShape :: ModuleShape -> PreModuleShape
toPreModuleShape (ModuleShape OpenModuleSubst
provs Set ModuleName
reqs) = Set ModuleName -> Set ModuleName -> PreModuleShape
PreModuleShape (forall k a. Map k a -> Set k
Map.keysSet OpenModuleSubst
provs) Set ModuleName
reqs

renamePreModuleShape :: PreModuleShape -> IncludeRenaming -> PreModuleShape
renamePreModuleShape :: PreModuleShape -> IncludeRenaming -> PreModuleShape
renamePreModuleShape (PreModuleShape Set ModuleName
provs Set ModuleName
reqs) (IncludeRenaming ModuleRenaming
prov_rn ModuleRenaming
req_rn) =
    Set ModuleName -> Set ModuleName -> PreModuleShape
PreModuleShape
        (forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ModuleName -> Maybe ModuleName
prov_fn (forall a. Set a -> [a]
Set.toList Set ModuleName
provs)))
        (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ModuleName -> ModuleName
req_fn Set ModuleName
reqs)
  where
    prov_fn :: ModuleName -> Maybe ModuleName
prov_fn = ModuleRenaming -> ModuleName -> Maybe ModuleName
interpModuleRenaming ModuleRenaming
prov_rn
    req_fn :: ModuleName -> ModuleName
req_fn ModuleName
k = forall a. a -> Maybe a -> a
fromMaybe ModuleName
k (ModuleRenaming -> ModuleName -> Maybe ModuleName
interpModuleRenaming ModuleRenaming
req_rn ModuleName
k)

mixLinkPreModuleShape :: [PreModuleShape] -> PreModuleShape
mixLinkPreModuleShape :: [PreModuleShape] -> PreModuleShape
mixLinkPreModuleShape [PreModuleShape]
shapes = Set ModuleName -> Set ModuleName -> PreModuleShape
PreModuleShape Set ModuleName
provs (forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set ModuleName
reqs Set ModuleName
provs)
  where
    provs :: Set ModuleName
provs = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (forall a b. (a -> b) -> [a] -> [b]
map PreModuleShape -> Set ModuleName
preModShapeProvides [PreModuleShape]
shapes)
    reqs :: Set ModuleName
reqs  = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (forall a b. (a -> b) -> [a] -> [b]
map PreModuleShape -> Set ModuleName
preModShapeRequires [PreModuleShape]
shapes)