{-# 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
setupMessage' :: Pretty a => Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> 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 = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
Verbosity -> Doc -> IO ()
noticeDoc Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
case Maybe [(ModuleName, a)]
mb_insts of
Just [(ModuleName, a)]
insts | Bool -> Bool
not (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 [ forall a. Pretty a => a -> Doc
pretty ModuleName
k Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> 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
<+> forall a. Pretty a => a -> Doc
pretty PackageIdentifier
pkgid Doc -> Doc -> Doc
<<>> String -> Doc
text String
".."