1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE Rank2Types       #-}
3module Distribution.Backpack.DescribeUnitId where
4
5import Distribution.Compat.Prelude
6import Prelude ()
7
8import Distribution.Compat.Stack
9import Distribution.ModuleName
10import Distribution.Pretty
11import Distribution.Simple.Utils
12import Distribution.Types.ComponentName
13import Distribution.Types.PackageId
14import Distribution.Verbosity
15
16import Text.PrettyPrint
17
18-- Unit identifiers have a well defined, machine-readable format,
19-- but this format isn't very user-friendly for users.  This
20-- module defines some functions for solving common rendering
21-- problems one has for displaying these.
22--
23-- There are three basic problems we tackle:
24--
25--  - Users don't want to see pkg-0.5-inplace-libname,
26--    they want to see "library 'libname' from 'pkg-0.5'"
27--
28--  - Users don't want to see the raw component identifier, which
29--    usually contains a wordy hash that doesn't matter.
30--
31--  - Users don't want to see a hash of the instantiation: they
32--    want to see the actual instantiation, and they want it in
33--    interpretable form.
34--
35
36-- | Print a Setup message stating (1) what operation we are doing,
37-- for (2) which component (with enough details to uniquely identify
38-- the build in question.)
39--
40setupMessage' :: Pretty a => Verbosity
41             -> String            -- ^ Operation being done (capitalized), on:
42             -> PackageIdentifier -- ^ Package
43             -> ComponentName     -- ^ Component name
44             -> Maybe [(ModuleName, a)] -- ^ Instantiation, if available.
45                                        -- Polymorphic to take
46                                        -- 'OpenModule' or 'Module'
47             -> IO ()
48setupMessage' verbosity msg pkgid cname mb_insts = withFrozenCallStack $ do
49    noticeDoc verbosity $
50      case mb_insts of
51        Just insts | not (null insts) ->
52          hang (msg_doc <+> text "instantiated with") 2
53               (vcat [ pretty k <+> text "=" <+> pretty v
54                     | (k,v) <- insts ]) $$
55          for_doc
56        _ ->
57          msg_doc <+> for_doc
58
59  where
60    msg_doc = text msg <+> text (showComponentName cname)
61    for_doc = text "for" <+> pretty pkgid <<>> text ".."
62