{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Rank2Types #-}

module Distribution.Backpack.DescribeUnitId where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Compat.Stack
import Distribution.ModuleName
import Distribution.Pretty
import Distribution.Simple.Utils
import Distribution.Types.ComponentName
import Distribution.Types.PackageId
import Distribution.Verbosity

import Text.PrettyPrint

-- Unit identifiers have a well defined, machine-readable format,
-- but this format isn't very user-friendly for users.  This
-- module defines some functions for solving common rendering
-- problems one has for displaying these.
--
-- There are three basic problems we tackle:
--
--  - Users don't want to see pkg-0.5-inplace-libname,
--    they want to see "library 'libname' from 'pkg-0.5'"
--
--  - Users don't want to see the raw component identifier, which
--    usually contains a wordy hash that doesn't matter.
--
--  - Users don't want to see a hash of the instantiation: they
--    want to see the actual instantiation, and they want it in
--    interpretable form.
--

-- | Print a Setup message stating (1) what operation we are doing,
-- for (2) which component (with enough details to uniquely identify
-- the build in question.)
setupMessage'
  :: Pretty a
  => Verbosity
  -> String
  -- ^ Operation being done (capitalized), on:
  -> PackageIdentifier
  -- ^ Package
  -> ComponentName
  -- ^ Component name
  -> Maybe [(ModuleName, a)]
  -- ^ Instantiation, if available.
  -- Polymorphic to take
  -- 'OpenModule' or 'Module'
  -> IO ()
setupMessage' :: forall a.
Pretty a =>
Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage' Verbosity
verbosity String
msg PackageIdentifier
pkgid ComponentName
cname Maybe [(ModuleName, a)]
mb_insts = (HasCallStack => IO ()) -> IO ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => IO ()) -> IO ())
-> (HasCallStack => IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Verbosity -> Doc -> IO ()
noticeDoc Verbosity
verbosity (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
    case Maybe [(ModuleName, a)]
mb_insts of
      Just [(ModuleName, a)]
insts
        | Bool -> Bool
not ([(ModuleName, a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, a)]
insts) ->
            Doc -> Int -> Doc -> Doc
hang
              (Doc
msg_doc Doc -> Doc -> Doc
<+> String -> Doc
text String
"instantiated with")
              Int
2
              ( [Doc] -> Doc
vcat
                  [ ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName
k Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
v
                  | (ModuleName
k, a
v) <- [(ModuleName, a)]
insts
                  ]
              )
              Doc -> Doc -> Doc
$$ Doc
for_doc
      Maybe [(ModuleName, a)]
_ ->
        Doc
msg_doc Doc -> Doc -> Doc
<+> Doc
for_doc
  where
    msg_doc :: Doc
msg_doc = String -> Doc
text String
msg Doc -> Doc -> Doc
<+> String -> Doc
text (ComponentName -> String
showComponentName ComponentName
cname)
    for_doc :: Doc
for_doc = String -> Doc
text String
"for" Doc -> Doc -> Doc
<+> PackageIdentifier -> Doc
forall a. Pretty a => a -> Doc
pretty PackageIdentifier
pkgid Doc -> Doc -> Doc
<<>> String -> Doc
text String
"..."