Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   4
   5 module Distribution.Types.UnqualComponentName
   6   ( UnqualComponentName
   7   , unUnqualComponentName
   8   , unUnqualComponentNameST
   9   , mkUnqualComponentName
  10   , packageNameToUnqualComponentName
  11   , unqualComponentNameToPackageName
  12   , combineNames
  13   ) where
  14
  15 import Distribution.Compat.Prelude
  16 import Distribution.Utils.ShortText
  17
  18 import Distribution.Parsec
  19 import Distribution.Pretty
  20 import Distribution.Types.PackageName
  21
  22 -- | An unqualified component name, for any kind of component.
  23 --
  24 -- This is distinguished from a 'ComponentName' and 'ComponentId'. The former
  25 -- also states which of a library, executable, etc the name refers too. The
  26 -- later uniquely identifiers a component and its closure.
  27 --
  28 -- @since 2.0.0.2
  29 newtype UnqualComponentName = UnqualComponentName ShortText
  30   deriving
  31     ( Generic
  32     , Read
  33     , Show
  34     , Eq
  35     , Ord
  36     , Typeable
  37     , Data
  38     , Semigroup
  39     , Monoid -- TODO: bad enabler of bad monoids
  40     )
  41
  42 -- | Convert 'UnqualComponentName' to 'String'
  43 --
  44 -- @since 2.0.0.2
  45 unUnqualComponentName :: UnqualComponentName -> String
  46 unUnqualComponentName (UnqualComponentName s) = fromShortText s
  47
  48 -- | @since 3.4.0.0
  49 unUnqualComponentNameST :: UnqualComponentName -> ShortText
  50 unUnqualComponentNameST (UnqualComponentName s) = s
  51
  52 -- | Construct a 'UnqualComponentName' from a 'String'
  53 --
  54 -- 'mkUnqualComponentName' is the inverse to 'unUnqualComponentName'
  55 --
  56 -- Note: No validations are performed to ensure that the resulting
  57 -- 'UnqualComponentName' is valid
  58 --
  59 -- @since 2.0.0.2
  60 mkUnqualComponentName :: String -> UnqualComponentName
  61 mkUnqualComponentName = UnqualComponentName . toShortText
  62
  63 -- | 'mkUnqualComponentName'
  64 --
  65 -- @since 2.0.0.2
  66 instance IsString UnqualComponentName where
  67   fromString = mkUnqualComponentName
  68
  69 instance Binary UnqualComponentName
  70 instance Structured UnqualComponentName
  71
  72 instance Pretty UnqualComponentName where
  73   pretty = showToken . unUnqualComponentName
  74
  75 instance Parsec UnqualComponentName where
  76   parsec = mkUnqualComponentName <$> parsecUnqualComponentName
  77
  78 instance NFData UnqualComponentName where
  79   rnf (UnqualComponentName pkg) = rnf pkg
  80
  81 -- TODO avoid String round trip with these PackageName <->
  82 -- UnqualComponentName converters.
  83
  84 -- | Converts a package name to an unqualified component name
  85 --
  86 -- Useful in legacy situations where a package name may refer to an internal
  87 -- component, if one is defined with that name.
  88 --
  89 -- 2018-12-21: These "legacy" situations are not legacy.
  90 -- We can @build-depends@ on the internal library. However
  91 -- Now dependency contains @Set LibraryName@, and we should use that.
  92 --
  93 -- @since 2.0.0.2
  94 packageNameToUnqualComponentName :: PackageName -> UnqualComponentName
  95 packageNameToUnqualComponentName = UnqualComponentName . unPackageNameST
  96
  97 -- | Converts an unqualified component name to a package name
  98 --
  99 -- `packageNameToUnqualComponentName` is the inverse of
 100 -- `unqualComponentNameToPackageName`.
 101 --
 102 -- Useful in legacy situations where a package name may refer to an internal
 103 -- component, if one is defined with that name.
 104 --
 105 -- @since 2.0.0.2
 106 unqualComponentNameToPackageName :: UnqualComponentName -> PackageName
 107 unqualComponentNameToPackageName = mkPackageNameST . unUnqualComponentNameST
 108
 109 -- | Combine names in targets if one name is empty or both names are equal
 110 -- (partial function).
 111 -- Useful in 'Semigroup' and similar instances.
 112 combineNames
 113   :: (Monoid b, Eq b, Show b)
 114   => a
 115   -> a
 116   -> (a -> b)
 117   -> String
 118   -> b
 119 combineNames a b tacc tt
 120   -- One empty or the same.
 121   | nb == mempty
 122       || na == nb =
 123       na
 124   | na == mempty =
 125       nb
 126   -- Both non-empty, different.
 127   | otherwise =
 128       error $
 129         "Ambiguous values for "
 130           ++ tt
 131           ++ " field: '"
 132           ++ show na
 133           ++ "' and '"
 134           ++ show nb
 135           ++ "'"
 136   where
 137     (na, nb) = (tacc a, tacc b)
 138 {-# INLINEABLE combineNames #-}