{-# LANGUAGE DeriveGeneric #-}

-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.ModuleShape
  ( -- * Module shapes
    ModuleShape (..)
  , emptyModuleShape
  , shapeInstalledPackage
  ) where

import Distribution.Compat.Prelude hiding (mod)
import Prelude ()

import Distribution.InstalledPackageInfo as IPI
import Distribution.ModuleName

import Distribution.Backpack
import Distribution.Backpack.ModSubst

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

-----------------------------------------------------------------------
-- Module shapes

-- | A 'ModuleShape' describes the provisions and requirements of
-- a library.  We can extract a 'ModuleShape' from an
-- 'InstalledPackageInfo'.
data ModuleShape = ModuleShape
  { modShapeProvides :: OpenModuleSubst
  , modShapeRequires :: Set ModuleName
  }
  deriving (Eq, Show, Generic)

instance Binary ModuleShape
instance Structured ModuleShape

instance ModSubst ModuleShape where
  modSubst subst (ModuleShape provs reqs) =
    ModuleShape (modSubst subst provs) (modSubst subst reqs)

-- | The default module shape, with no provisions and no requirements.
emptyModuleShape :: ModuleShape
emptyModuleShape = ModuleShape Map.empty Set.empty

-- Food for thought: suppose we apply the Merkel tree optimization.
-- Imagine this situation:
--
--      component p
--          signature H
--          module P
--      component h
--          module H
--      component a
--          signature P
--          module A
--      component q(P)
--          include p
--          include h
--      component r
--          include q (P)
--          include p (P) requires (H)
--          include h (H)
--          include a (A) requires (P)
--
-- Component r should not have any conflicts, since after mix-in linking
-- the two P imports will end up being the same, so we can properly
-- instantiate it.  But to know that q's P is p:P instantiated with h:H,
-- we have to be able to expand its unit id.  Maybe we can expand it
-- lazily but in some cases it will need to be expanded.
--
-- FWIW, the way that GHC handles this is by improving unit IDs as
-- soon as it sees an improved one in the package database.  This
-- is a bit disgusting.
shapeInstalledPackage :: IPI.InstalledPackageInfo -> ModuleShape
shapeInstalledPackage ipi = ModuleShape (Map.fromList provs) reqs
  where
    uid = installedOpenUnitId ipi
    provs = map shapeExposedModule (IPI.exposedModules ipi)
    reqs = requiredSignatures ipi
    shapeExposedModule (IPI.ExposedModule mod_name Nothing) =
      (mod_name, OpenModule uid mod_name)
    shapeExposedModule (IPI.ExposedModule mod_name (Just mod)) =
      (mod_name, mod)
