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

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

import Distribution.Compat.Prelude
import Prelude ()

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

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

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
$c== :: PreModuleShape -> PreModuleShape -> Bool
== :: PreModuleShape -> PreModuleShape -> Bool
$c/= :: PreModuleShape -> PreModuleShape -> Bool
/= :: 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
$cshowsPrec :: Int -> PreModuleShape -> ShowS
showsPrec :: Int -> PreModuleShape -> ShowS
$cshow :: PreModuleShape -> String
show :: PreModuleShape -> String
$cshowList :: [PreModuleShape] -> ShowS
showList :: [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
$cfrom :: forall x. PreModuleShape -> Rep PreModuleShape x
from :: forall x. PreModuleShape -> Rep PreModuleShape x
$cto :: forall x. Rep PreModuleShape x -> PreModuleShape
to :: forall x. Rep PreModuleShape x -> PreModuleShape
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)