    {-
    %
    % (c) Adam Gundry 2013-2015
    %

    This module defines the representation of FieldLabels as stored in
    TyCons.  As well as a selector name, these have some extra structure
    to support the DuplicateRecordFields extension.

    In the normal case (with NoDuplicateRecordFields), a datatype like

        data T = MkT { foo :: Int }

    has

        FieldLabel { flLabel        = "foo"
                   , flIsOverloaded = False
                   , flSelector     = foo }.

    In particular, the Name of the selector has the same string
    representation as the label.  If DuplicateRecordFields
    is enabled, however, the same declaration instead gives

        FieldLabel { flLabel        = "foo"
                   , flIsOverloaded = True
                   , flSelector     = $sel:foo:MkT }.

    Now the name of the selector ($sel:foo:MkT) does not match the label of
    the field (foo).  We must be careful not to show the selector name to
    the user!  The point of mangling the selector name is to allow a
    module to define the same field label in different datatypes:

        data T = MkT { foo :: Int }
        data U = MkU { foo :: Bool }

    Now there will be two FieldLabel values for 'foo', one in T and one in
    U.  They share the same label (FieldLabelString), but the selector
    functions differ.

    See also Note [Representing fields in AvailInfo] in GHC.Types.Avail.

    Note [Why selector names include data constructors]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    As explained above, a selector name includes the name of the first
    data constructor in the type, so that the same label can appear
    multiple times in the same module.  (This is irrespective of whether
    the first constructor has that field, for simplicity.)

    We use a data constructor name, rather than the type constructor name,
    because data family instances do not have a representation type
    constructor name generated until relatively late in the typechecking
    process.

    Of course, datatypes with no constructors cannot have any fields.

    -}

    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE DeriveFoldable #-}
    {-# LANGUAGE DeriveTraversable #-}
    {-# LANGUAGE StandaloneDeriving #-}

    module GHC.Types.FieldLabel
       ( FieldLabelString
       , FieldLabelEnv
       , FieldLbl(..)
       , FieldLabel
       , mkFieldLabelOccs
       )
    where

    import GHC.Prelude

    import GHC.Types.Name.Occurrence
    import GHC.Types.Name

    import GHC.Data.FastString
    import GHC.Data.FastString.Env
    import GHC.Utils.Outputable
    import GHC.Utils.Binary

    import Data.Data

    -- | Field labels are just represented as strings;
    -- they are not necessarily unique (even within a module)
    type FieldLabelString = FastString

    -- | A map from labels to all the auxiliary information
    type FieldLabelEnv = DFastStringEnv FieldLabel

    type FieldLabel = FieldLbl Name

    -- | Fields in an algebraic record type
    data FieldLbl a = FieldLabel {
          forall a. FieldLbl a -> FieldLabelString
    flLabel        :: FieldLabelString, -- ^ User-visible label of the field
          forall a. FieldLbl a -> Bool
    flIsOverloaded :: Bool,             -- ^ Was DuplicateRecordFields on
                                              --   in the defining module for this datatype?
          forall a. FieldLbl a -> a
    flSelector     :: a                 -- ^ Record selector function
        }
      deriving (FieldLbl a -> FieldLbl a -> Bool
    (FieldLbl a -> FieldLbl a -> Bool)
    -> (FieldLbl a -> FieldLbl a -> Bool) -> Eq (FieldLbl a)
    forall a. Eq a => FieldLbl a -> FieldLbl a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: FieldLbl a -> FieldLbl a -> Bool
    $c/= :: forall a. Eq a => FieldLbl a -> FieldLbl a -> Bool
    == :: FieldLbl a -> FieldLbl a -> Bool
    $c== :: forall a. Eq a => FieldLbl a -> FieldLbl a -> Bool
    Eq, (forall a b. (a -> b) -> FieldLbl a -> FieldLbl b)
    -> (forall a b. a -> FieldLbl b -> FieldLbl a) -> Functor FieldLbl
    forall a b. a -> FieldLbl b -> FieldLbl a
    forall a b. (a -> b) -> FieldLbl a -> FieldLbl b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: forall a b. a -> FieldLbl b -> FieldLbl a
    $c<$ :: forall a b. a -> FieldLbl b -> FieldLbl a
    fmap :: forall a b. (a -> b) -> FieldLbl a -> FieldLbl b
    $cfmap :: forall a b. (a -> b) -> FieldLbl a -> FieldLbl b
    Functor, (forall m. Monoid m => FieldLbl m -> m)
    -> (forall m a. Monoid m => (a -> m) -> FieldLbl a -> m)
    -> (forall m a. Monoid m => (a -> m) -> FieldLbl a -> m)
    -> (forall a b. (a -> b -> b) -> b -> FieldLbl a -> b)
    -> (forall a b. (a -> b -> b) -> b -> FieldLbl a -> b)
    -> (forall b a. (b -> a -> b) -> b -> FieldLbl a -> b)
    -> (forall b a. (b -> a -> b) -> b -> FieldLbl a -> b)
    -> (forall a. (a -> a -> a) -> FieldLbl a -> a)
    -> (forall a. (a -> a -> a) -> FieldLbl a -> a)
    -> (forall a. FieldLbl a -> [a])
    -> (forall a. FieldLbl a -> Bool)
    -> (forall a. FieldLbl a -> Int)
    -> (forall a. Eq a => a -> FieldLbl a -> Bool)
    -> (forall a. Ord a => FieldLbl a -> a)
    -> (forall a. Ord a => FieldLbl a -> a)
    -> (forall a. Num a => FieldLbl a -> a)
    -> (forall a. Num a => FieldLbl a -> a)
    -> Foldable FieldLbl
    forall a. Eq a => a -> FieldLbl a -> Bool
    forall a. Num a => FieldLbl a -> a
    forall a. Ord a => FieldLbl a -> a
    forall m. Monoid m => FieldLbl m -> m
    forall a. FieldLbl a -> Bool
    forall a. FieldLbl a -> Int
    forall a. FieldLbl a -> [a]
    forall a. (a -> a -> a) -> FieldLbl a -> a
    forall m a. Monoid m => (a -> m) -> FieldLbl a -> m
    forall b a. (b -> a -> b) -> b -> FieldLbl a -> b
    forall a b. (a -> b -> b) -> b -> FieldLbl a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    product :: forall a. Num a => FieldLbl a -> a
    $cproduct :: forall a. Num a => FieldLbl a -> a
    sum :: forall a. Num a => FieldLbl a -> a
    $csum :: forall a. Num a => FieldLbl a -> a
    minimum :: forall a. Ord a => FieldLbl a -> a
    $cminimum :: forall a. Ord a => FieldLbl a -> a
    maximum :: forall a. Ord a => FieldLbl a -> a
    $cmaximum :: forall a. Ord a => FieldLbl a -> a
    elem :: forall a. Eq a => a -> FieldLbl a -> Bool
    $celem :: forall a. Eq a => a -> FieldLbl a -> Bool
    length :: forall a. FieldLbl a -> Int
    $clength :: forall a. FieldLbl a -> Int
    null :: forall a. FieldLbl a -> Bool
    $cnull :: forall a. FieldLbl a -> Bool
    toList :: forall a. FieldLbl a -> [a]
    $ctoList :: forall a. FieldLbl a -> [a]
    foldl1 :: forall a. (a -> a -> a) -> FieldLbl a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> FieldLbl a -> a
    foldr1 :: forall a. (a -> a -> a) -> FieldLbl a -> a
    $cfoldr1 :: forall a. (a -> a -> a) -> FieldLbl a -> a
    foldl' :: forall b a. (b -> a -> b) -> b -> FieldLbl a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> FieldLbl a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> FieldLbl a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> FieldLbl a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> FieldLbl a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> FieldLbl a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> FieldLbl a -> b
    $cfoldr :: forall a b. (a -> b -> b) -> b -> FieldLbl a -> b
    foldMap' :: forall m a. Monoid m => (a -> m) -> FieldLbl a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> FieldLbl a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> FieldLbl a -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> FieldLbl a -> m
    fold :: forall m. Monoid m => FieldLbl m -> m
    $cfold :: forall m. Monoid m => FieldLbl m -> m
    Foldable, Functor FieldLbl
    Foldable FieldLbl
    Functor FieldLbl
    -> Foldable FieldLbl
    -> (forall (f :: * -> *) a b.
        Applicative f =>
        (a -> f b) -> FieldLbl a -> f (FieldLbl b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        FieldLbl (f a) -> f (FieldLbl a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> FieldLbl a -> m (FieldLbl b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        FieldLbl (m a) -> m (FieldLbl a))
    -> Traversable FieldLbl
    forall (t :: * -> *).
    Functor t
    -> Foldable t
    -> (forall (f :: * -> *) a b.
        Applicative f =>
        (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a. Monad m => FieldLbl (m a) -> m (FieldLbl a)
    forall (f :: * -> *) a.
    Applicative f =>
    FieldLbl (f a) -> f (FieldLbl a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FieldLbl a -> m (FieldLbl b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> FieldLbl a -> f (FieldLbl b)
    sequence :: forall (m :: * -> *) a. Monad m => FieldLbl (m a) -> m (FieldLbl a)
    $csequence :: forall (m :: * -> *) a. Monad m => FieldLbl (m a) -> m (FieldLbl a)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FieldLbl a -> m (FieldLbl b)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FieldLbl a -> m (FieldLbl b)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    FieldLbl (f a) -> f (FieldLbl a)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    FieldLbl (f a) -> f (FieldLbl a)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> FieldLbl a -> f (FieldLbl b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> FieldLbl a -> f (FieldLbl b)
    Traversable)
    deriving instance Data a => Data (FieldLbl a)

    instance Outputable a => Outputable (FieldLbl a) where
        ppr :: FieldLbl a -> SDoc
    ppr FieldLbl a
    fl = FieldLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (FieldLbl a -> FieldLabelString
    forall a. FieldLbl a -> FieldLabelString
    flLabel FieldLbl a
    fl) SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    braces (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (FieldLbl a -> a
    forall a. FieldLbl a -> a
    flSelector FieldLbl a
    fl))

    instance Binary a => Binary (FieldLbl a) where
        put_ :: BinHandle -> FieldLbl a -> IO ()
    put_ BinHandle
    bh (FieldLabel FieldLabelString
    aa Bool
    ab a
    ac) = do
            BinHandle -> FieldLabelString -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh FieldLabelString
    aa
            BinHandle -> Bool -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Bool
    ab
            BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    ac
        get :: BinHandle -> IO (FieldLbl a)
    get BinHandle
    bh = do
            FieldLabelString
    ab <- BinHandle -> IO FieldLabelString
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
            Bool
    ac <- BinHandle -> IO Bool
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
            a
    ad <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
            FieldLbl a -> IO (FieldLbl a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FieldLabelString -> Bool -> a -> FieldLbl a
    forall a. FieldLabelString -> Bool -> a -> FieldLbl a
    FieldLabel FieldLabelString
    ab Bool
    ac a
    ad)

    -- | Record selector OccNames are built from the underlying field name
    -- and the name of the first data constructor of the type, to support
    -- duplicate record field names.
    -- See Note [Why selector names include data constructors].
    mkFieldLabelOccs :: FieldLabelString -> OccName -> Bool -> FieldLbl OccName
    mkFieldLabelOccs :: FieldLabelString -> OccName -> Bool -> FieldLbl OccName
    mkFieldLabelOccs FieldLabelString
    lbl OccName
    dc Bool
    is_overloaded
      = FieldLabel :: forall a. FieldLabelString -> Bool -> a -> FieldLbl a
    FieldLabel { flLabel :: FieldLabelString
    flLabel = FieldLabelString
    lbl, flIsOverloaded :: Bool
    flIsOverloaded = Bool
    is_overloaded
                   , flSelector :: OccName
    flSelector = OccName
    sel_occ }
      where
        str :: [Char]
    str     = [Char]
    ":" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ FieldLabelString -> [Char]
    unpackFS FieldLabelString
    lbl [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ":" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ OccName -> [Char]
    occNameString OccName
    dc
        sel_occ :: OccName
    sel_occ | Bool
    is_overloaded = [Char] -> OccName
    mkRecFldSelOcc [Char]
    str
                | Bool
    otherwise     = FieldLabelString -> OccName
    mkVarOccFS FieldLabelString
    lbl