Cabal/src/Distribution/Backpack/DescribeUnitId.hs

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