{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Distribution.Types.UnqualComponentName
  ( UnqualComponentName
  , unUnqualComponentName
  , unUnqualComponentNameST
  , mkUnqualComponentName
  , packageNameToUnqualComponentName
  , unqualComponentNameToPackageName
  , combineNames
  ) where

import Distribution.Compat.Prelude
import Distribution.Utils.ShortText

import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.PackageName

-- | An unqualified component name, for any kind of component.
--
-- This is distinguished from a 'ComponentName' and 'ComponentId'. The former
-- also states which of a library, executable, etc the name refers too. The
-- later uniquely identifiers a component and its closure.
--
-- @since 2.0.0.2
newtype UnqualComponentName = UnqualComponentName ShortText
  deriving
    ( (forall x. UnqualComponentName -> Rep UnqualComponentName x)
-> (forall x. Rep UnqualComponentName x -> UnqualComponentName)
-> Generic UnqualComponentName
forall x. Rep UnqualComponentName x -> UnqualComponentName
forall x. UnqualComponentName -> Rep UnqualComponentName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnqualComponentName -> Rep UnqualComponentName x
from :: forall x. UnqualComponentName -> Rep UnqualComponentName x
$cto :: forall x. Rep UnqualComponentName x -> UnqualComponentName
to :: forall x. Rep UnqualComponentName x -> UnqualComponentName
Generic
    , ReadPrec [UnqualComponentName]
ReadPrec UnqualComponentName
Int -> ReadS UnqualComponentName
ReadS [UnqualComponentName]
(Int -> ReadS UnqualComponentName)
-> ReadS [UnqualComponentName]
-> ReadPrec UnqualComponentName
-> ReadPrec [UnqualComponentName]
-> Read UnqualComponentName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UnqualComponentName
readsPrec :: Int -> ReadS UnqualComponentName
$creadList :: ReadS [UnqualComponentName]
readList :: ReadS [UnqualComponentName]
$creadPrec :: ReadPrec UnqualComponentName
readPrec :: ReadPrec UnqualComponentName
$creadListPrec :: ReadPrec [UnqualComponentName]
readListPrec :: ReadPrec [UnqualComponentName]
Read
    , Int -> UnqualComponentName -> ShowS
[UnqualComponentName] -> ShowS
UnqualComponentName -> String
(Int -> UnqualComponentName -> ShowS)
-> (UnqualComponentName -> String)
-> ([UnqualComponentName] -> ShowS)
-> Show UnqualComponentName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnqualComponentName -> ShowS
showsPrec :: Int -> UnqualComponentName -> ShowS
$cshow :: UnqualComponentName -> String
show :: UnqualComponentName -> String
$cshowList :: [UnqualComponentName] -> ShowS
showList :: [UnqualComponentName] -> ShowS
Show
    , UnqualComponentName -> UnqualComponentName -> Bool
(UnqualComponentName -> UnqualComponentName -> Bool)
-> (UnqualComponentName -> UnqualComponentName -> Bool)
-> Eq UnqualComponentName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnqualComponentName -> UnqualComponentName -> Bool
== :: UnqualComponentName -> UnqualComponentName -> Bool
$c/= :: UnqualComponentName -> UnqualComponentName -> Bool
/= :: UnqualComponentName -> UnqualComponentName -> Bool
Eq
    , Eq UnqualComponentName
Eq UnqualComponentName =>
(UnqualComponentName -> UnqualComponentName -> Ordering)
-> (UnqualComponentName -> UnqualComponentName -> Bool)
-> (UnqualComponentName -> UnqualComponentName -> Bool)
-> (UnqualComponentName -> UnqualComponentName -> Bool)
-> (UnqualComponentName -> UnqualComponentName -> Bool)
-> (UnqualComponentName
    -> UnqualComponentName -> UnqualComponentName)
-> (UnqualComponentName
    -> UnqualComponentName -> UnqualComponentName)
-> Ord UnqualComponentName
UnqualComponentName -> UnqualComponentName -> Bool
UnqualComponentName -> UnqualComponentName -> Ordering
UnqualComponentName -> UnqualComponentName -> UnqualComponentName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnqualComponentName -> UnqualComponentName -> Ordering
compare :: UnqualComponentName -> UnqualComponentName -> Ordering
$c< :: UnqualComponentName -> UnqualComponentName -> Bool
< :: UnqualComponentName -> UnqualComponentName -> Bool
$c<= :: UnqualComponentName -> UnqualComponentName -> Bool
<= :: UnqualComponentName -> UnqualComponentName -> Bool
$c> :: UnqualComponentName -> UnqualComponentName -> Bool
> :: UnqualComponentName -> UnqualComponentName -> Bool
$c>= :: UnqualComponentName -> UnqualComponentName -> Bool
>= :: UnqualComponentName -> UnqualComponentName -> Bool
$cmax :: UnqualComponentName -> UnqualComponentName -> UnqualComponentName
max :: UnqualComponentName -> UnqualComponentName -> UnqualComponentName
$cmin :: UnqualComponentName -> UnqualComponentName -> UnqualComponentName
min :: UnqualComponentName -> UnqualComponentName -> UnqualComponentName
Ord
    , Typeable
    , Typeable UnqualComponentName
Typeable UnqualComponentName =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> UnqualComponentName
 -> c UnqualComponentName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UnqualComponentName)
-> (UnqualComponentName -> Constr)
-> (UnqualComponentName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UnqualComponentName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c UnqualComponentName))
-> ((forall b. Data b => b -> b)
    -> UnqualComponentName -> UnqualComponentName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UnqualComponentName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UnqualComponentName -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> UnqualComponentName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> UnqualComponentName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> UnqualComponentName -> m UnqualComponentName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> UnqualComponentName -> m UnqualComponentName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> UnqualComponentName -> m UnqualComponentName)
-> Data UnqualComponentName
UnqualComponentName -> Constr
UnqualComponentName -> DataType
(forall b. Data b => b -> b)
-> UnqualComponentName -> UnqualComponentName
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UnqualComponentName -> u
forall u.
(forall d. Data d => d -> u) -> UnqualComponentName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnqualComponentName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnqualComponentName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UnqualComponentName -> m UnqualComponentName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UnqualComponentName -> m UnqualComponentName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnqualComponentName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UnqualComponentName
-> c UnqualComponentName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnqualComponentName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnqualComponentName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UnqualComponentName
-> c UnqualComponentName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UnqualComponentName
-> c UnqualComponentName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnqualComponentName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnqualComponentName
$ctoConstr :: UnqualComponentName -> Constr
toConstr :: UnqualComponentName -> Constr
$cdataTypeOf :: UnqualComponentName -> DataType
dataTypeOf :: UnqualComponentName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnqualComponentName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnqualComponentName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnqualComponentName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnqualComponentName)
$cgmapT :: (forall b. Data b => b -> b)
-> UnqualComponentName -> UnqualComponentName
gmapT :: (forall b. Data b => b -> b)
-> UnqualComponentName -> UnqualComponentName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnqualComponentName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnqualComponentName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnqualComponentName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnqualComponentName -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UnqualComponentName -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UnqualComponentName -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UnqualComponentName -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UnqualComponentName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UnqualComponentName -> m UnqualComponentName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UnqualComponentName -> m UnqualComponentName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UnqualComponentName -> m UnqualComponentName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UnqualComponentName -> m UnqualComponentName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UnqualComponentName -> m UnqualComponentName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UnqualComponentName -> m UnqualComponentName
Data
    , NonEmpty UnqualComponentName -> UnqualComponentName
UnqualComponentName -> UnqualComponentName -> UnqualComponentName
(UnqualComponentName -> UnqualComponentName -> UnqualComponentName)
-> (NonEmpty UnqualComponentName -> UnqualComponentName)
-> (forall b.
    Integral b =>
    b -> UnqualComponentName -> UnqualComponentName)
-> Semigroup UnqualComponentName
forall b.
Integral b =>
b -> UnqualComponentName -> UnqualComponentName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: UnqualComponentName -> UnqualComponentName -> UnqualComponentName
<> :: UnqualComponentName -> UnqualComponentName -> UnqualComponentName
$csconcat :: NonEmpty UnqualComponentName -> UnqualComponentName
sconcat :: NonEmpty UnqualComponentName -> UnqualComponentName
$cstimes :: forall b.
Integral b =>
b -> UnqualComponentName -> UnqualComponentName
stimes :: forall b.
Integral b =>
b -> UnqualComponentName -> UnqualComponentName
Semigroup
    , Semigroup UnqualComponentName
UnqualComponentName
Semigroup UnqualComponentName =>
UnqualComponentName
-> (UnqualComponentName
    -> UnqualComponentName -> UnqualComponentName)
-> ([UnqualComponentName] -> UnqualComponentName)
-> Monoid UnqualComponentName
[UnqualComponentName] -> UnqualComponentName
UnqualComponentName -> UnqualComponentName -> UnqualComponentName
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: UnqualComponentName
mempty :: UnqualComponentName
$cmappend :: UnqualComponentName -> UnqualComponentName -> UnqualComponentName
mappend :: UnqualComponentName -> UnqualComponentName -> UnqualComponentName
$cmconcat :: [UnqualComponentName] -> UnqualComponentName
mconcat :: [UnqualComponentName] -> UnqualComponentName
Monoid -- TODO: bad enabler of bad monoids
    )

-- | Convert 'UnqualComponentName' to 'String'
--
-- @since 2.0.0.2
unUnqualComponentName :: UnqualComponentName -> String
unUnqualComponentName :: UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName ShortText
s) = ShortText -> String
fromShortText ShortText
s

-- | @since 3.4.0.0
unUnqualComponentNameST :: UnqualComponentName -> ShortText
unUnqualComponentNameST :: UnqualComponentName -> ShortText
unUnqualComponentNameST (UnqualComponentName ShortText
s) = ShortText
s

-- | Construct a 'UnqualComponentName' from a 'String'
--
-- 'mkUnqualComponentName' is the inverse to 'unUnqualComponentName'
--
-- Note: No validations are performed to ensure that the resulting
-- 'UnqualComponentName' is valid
--
-- @since 2.0.0.2
mkUnqualComponentName :: String -> UnqualComponentName
mkUnqualComponentName :: String -> UnqualComponentName
mkUnqualComponentName = ShortText -> UnqualComponentName
UnqualComponentName (ShortText -> UnqualComponentName)
-> (String -> ShortText) -> String -> UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
toShortText

-- | 'mkUnqualComponentName'
--
-- @since 2.0.0.2
instance IsString UnqualComponentName where
  fromString :: String -> UnqualComponentName
fromString = String -> UnqualComponentName
mkUnqualComponentName

instance Binary UnqualComponentName
instance Structured UnqualComponentName

instance Pretty UnqualComponentName where
  pretty :: UnqualComponentName -> Doc
pretty = String -> Doc
showToken (String -> Doc)
-> (UnqualComponentName -> String) -> UnqualComponentName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
unUnqualComponentName

instance Parsec UnqualComponentName where
  parsec :: forall (m :: * -> *). CabalParsing m => m UnqualComponentName
parsec = String -> UnqualComponentName
mkUnqualComponentName (String -> UnqualComponentName)
-> m String -> m UnqualComponentName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
parsecUnqualComponentName

instance NFData UnqualComponentName where
  rnf :: UnqualComponentName -> ()
rnf (UnqualComponentName ShortText
pkg) = ShortText -> ()
forall a. NFData a => a -> ()
rnf ShortText
pkg

-- TODO avoid String round trip with these PackageName <->
-- UnqualComponentName converters.

-- | Converts a package name to an unqualified component name
--
-- Useful in legacy situations where a package name may refer to an internal
-- component, if one is defined with that name.
--
-- 2018-12-21: These "legacy" situations are not legacy.
-- We can @build-depends@ on the internal library. However
-- Now dependency contains @Set LibraryName@, and we should use that.
--
-- @since 2.0.0.2
packageNameToUnqualComponentName :: PackageName -> UnqualComponentName
packageNameToUnqualComponentName :: PackageName -> UnqualComponentName
packageNameToUnqualComponentName = ShortText -> UnqualComponentName
UnqualComponentName (ShortText -> UnqualComponentName)
-> (PackageName -> ShortText) -> PackageName -> UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> ShortText
unPackageNameST

-- | Converts an unqualified component name to a package name
--
-- `packageNameToUnqualComponentName` is the inverse of
-- `unqualComponentNameToPackageName`.
--
-- Useful in legacy situations where a package name may refer to an internal
-- component, if one is defined with that name.
--
-- @since 2.0.0.2
unqualComponentNameToPackageName :: UnqualComponentName -> PackageName
unqualComponentNameToPackageName :: UnqualComponentName -> PackageName
unqualComponentNameToPackageName = ShortText -> PackageName
mkPackageNameST (ShortText -> PackageName)
-> (UnqualComponentName -> ShortText)
-> UnqualComponentName
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> ShortText
unUnqualComponentNameST

-- | Combine names in targets if one name is empty or both names are equal
-- (partial function).
-- Useful in 'Semigroup' and similar instances.
combineNames
  :: (Monoid b, Eq b, Show b)
  => a
  -> a
  -> (a -> b)
  -> String
  -> b
combineNames :: forall b a.
(Monoid b, Eq b, Show b) =>
a -> a -> (a -> b) -> String -> b
combineNames a
a a
b a -> b
tacc String
tt
  -- One empty or the same.
  | b
nb b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
forall a. Monoid a => a
mempty
      Bool -> Bool -> Bool
|| b
na b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
nb =
      b
na
  | b
na b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
forall a. Monoid a => a
mempty =
      b
nb
  -- Both non-empty, different.
  | Bool
otherwise =
      String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$
        String
"Ambiguous values for "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tt
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" field: '"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
na
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' and '"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
nb
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
  where
    (b
na, b
nb) = (a -> b
tacc a
a, a -> b
tacc a
b)
{-# INLINEABLE combineNames #-}