{-# 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
(PreModuleShape -> PreModuleShape -> Bool)
-> (PreModuleShape -> PreModuleShape -> Bool) -> Eq PreModuleShape
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
(Int -> PreModuleShape -> ShowS)
-> (PreModuleShape -> String)
-> ([PreModuleShape] -> ShowS)
-> Show PreModuleShape
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. PreModuleShape -> Rep PreModuleShape x)
-> (forall x. Rep PreModuleShape x -> PreModuleShape)
-> Generic PreModuleShape
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 (OpenModuleSubst -> Set ModuleName
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
        ([ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList ((ModuleName -> Maybe ModuleName) -> [ModuleName] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ModuleName -> Maybe ModuleName
prov_fn (Set ModuleName -> [ModuleName]
forall a. Set a -> [a]
Set.toList Set ModuleName
provs)))
        ((ModuleName -> ModuleName) -> Set ModuleName -> Set ModuleName
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 = ModuleName -> Maybe ModuleName -> ModuleName
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 (Set ModuleName -> Set ModuleName -> Set ModuleName
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set ModuleName
reqs Set ModuleName
provs)
  where
    provs :: Set ModuleName
provs = [Set ModuleName] -> Set ModuleName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ((PreModuleShape -> Set ModuleName)
-> [PreModuleShape] -> [Set ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map PreModuleShape -> Set ModuleName
preModShapeProvides [PreModuleShape]
shapes)
    reqs :: Set ModuleName
reqs  = [Set ModuleName] -> Set ModuleName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ((PreModuleShape -> Set ModuleName)
-> [PreModuleShape] -> [Set ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map PreModuleShape -> Set ModuleName
preModShapeRequires [PreModuleShape]
shapes)