{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable FieldLabelString

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

Note [FieldLabel]
~~~~~~~~~~~~~~~~~

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 and NoFieldSelectors extensions.

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

    data T = MkT { foo :: Int }

has

    FieldLabel { flLabel                    = "foo"
               , flHasDuplicateRecordFields = NoDuplicateRecordFields
               , flHasFieldSelector         = FieldSelectors
               , 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"
               , flHasDuplicateRecordFields = DuplicateRecordFields
               , flHasFieldSelector         = FieldSelectors
               , flSelector                 = $sel:foo:MkT }.

Similarly, the selector name will be mangled if NoFieldSelectors is used
(whether or not DuplicateRecordFields is enabled).  See Note [NoFieldSelectors]
in GHC.Rename.Env.

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.

-}

module GHC.Types.FieldLabel
   ( FieldLabelEnv
   , FieldLabel(..)
   , fieldSelectorOccName
   , fieldLabelPrintableName
   , DuplicateRecordFields(..)
   , FieldSelectors(..)
   , flIsOverloaded
   )
where

import GHC.Prelude

import {-# SOURCE #-} GHC.Types.Name.Occurrence
import {-# SOURCE #-} GHC.Types.Name

import GHC.Data.FastString
import GHC.Data.FastString.Env
import GHC.Types.Unique (Uniquable(..))
import GHC.Utils.Outputable
import GHC.Utils.Binary

import Language.Haskell.Syntax.Basic (FieldLabelString(..))

import Control.DeepSeq
import Data.Bool
import Data.Data

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

-- | Fields in an algebraic record type; see Note [FieldLabel].
data FieldLabel = FieldLabel {
      FieldLabel -> FieldLabelString
flLabel :: FieldLabelString,
      -- ^ User-visible label of the field
      FieldLabel -> DuplicateRecordFields
flHasDuplicateRecordFields :: DuplicateRecordFields,
      -- ^ Was @DuplicateRecordFields@ on in the defining module for this datatype?
      FieldLabel -> FieldSelectors
flHasFieldSelector :: FieldSelectors,
      -- ^ Was @FieldSelectors@ enabled in the defining module for this datatype?
      -- See Note [NoFieldSelectors] in GHC.Rename.Env
      FieldLabel -> Name
flSelector :: Name
      -- ^ Record selector function
    }
  deriving (Typeable FieldLabel
Typeable FieldLabel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FieldLabel -> c FieldLabel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FieldLabel)
-> (FieldLabel -> Constr)
-> (FieldLabel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FieldLabel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FieldLabel))
-> ((forall b. Data b => b -> b) -> FieldLabel -> FieldLabel)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldLabel -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldLabel -> r)
-> (forall u. (forall d. Data d => d -> u) -> FieldLabel -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FieldLabel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel)
-> Data FieldLabel
FieldLabel -> Constr
FieldLabel -> DataType
(forall b. Data b => b -> b) -> FieldLabel -> FieldLabel
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) -> FieldLabel -> u
forall u. (forall d. Data d => d -> u) -> FieldLabel -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldLabel -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldLabel -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldLabel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldLabel -> c FieldLabel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldLabel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldLabel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldLabel -> c FieldLabel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldLabel -> c FieldLabel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldLabel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldLabel
$ctoConstr :: FieldLabel -> Constr
toConstr :: FieldLabel -> Constr
$cdataTypeOf :: FieldLabel -> DataType
dataTypeOf :: FieldLabel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldLabel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldLabel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldLabel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldLabel)
$cgmapT :: (forall b. Data b => b -> b) -> FieldLabel -> FieldLabel
gmapT :: (forall b. Data b => b -> b) -> FieldLabel -> FieldLabel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldLabel -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldLabel -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldLabel -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldLabel -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FieldLabel -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FieldLabel -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FieldLabel -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FieldLabel -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldLabel -> m FieldLabel
Data, FieldLabel -> FieldLabel -> Bool
(FieldLabel -> FieldLabel -> Bool)
-> (FieldLabel -> FieldLabel -> Bool) -> Eq FieldLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldLabel -> FieldLabel -> Bool
== :: FieldLabel -> FieldLabel -> Bool
$c/= :: FieldLabel -> FieldLabel -> Bool
/= :: FieldLabel -> FieldLabel -> Bool
Eq)

instance HasOccName FieldLabel where
  occName :: FieldLabel -> OccName
occName = FastString -> OccName
mkVarOccFS (FastString -> OccName)
-> (FieldLabel -> FastString) -> FieldLabel -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabelString -> FastString
field_label (FieldLabelString -> FastString)
-> (FieldLabel -> FieldLabelString) -> FieldLabel -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldLabelString
flLabel

instance Outputable FieldLabel where
    ppr :: FieldLabel -> SDoc
ppr FieldLabel
fl = FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FieldLabel -> FieldLabelString
flLabel FieldLabel
fl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FieldLabel -> Name
flSelector FieldLabel
fl))
                                                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> DuplicateRecordFields -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FieldLabel -> DuplicateRecordFields
flHasDuplicateRecordFields FieldLabel
fl)
                                                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FieldSelectors -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FieldLabel -> FieldSelectors
flHasFieldSelector FieldLabel
fl))

instance Outputable FieldLabelString where
  ppr :: FieldLabelString -> SDoc
ppr (FieldLabelString FastString
l) = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
l

instance Uniquable FieldLabelString where
  getUnique :: FieldLabelString -> Unique
getUnique (FieldLabelString FastString
fs) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
fs

instance NFData FieldLabel where
  rnf :: FieldLabel -> ()
rnf (FieldLabel FieldLabelString
a DuplicateRecordFields
b FieldSelectors
c Name
d) = FieldLabelString -> ()
forall a. NFData a => a -> ()
rnf FieldLabelString
a () -> () -> ()
forall a b. a -> b -> b
`seq` DuplicateRecordFields -> ()
forall a. NFData a => a -> ()
rnf DuplicateRecordFields
b () -> () -> ()
forall a b. a -> b -> b
`seq` FieldSelectors -> ()
forall a. NFData a => a -> ()
rnf FieldSelectors
c () -> () -> ()
forall a b. a -> b -> b
`seq` Name -> ()
forall a. NFData a => a -> ()
rnf Name
d

-- | Flag to indicate whether the DuplicateRecordFields extension is enabled.
data DuplicateRecordFields
    = DuplicateRecordFields   -- ^ Fields may be duplicated in a single module
    | NoDuplicateRecordFields -- ^ Fields must be unique within a module (the default)
  deriving (Int -> DuplicateRecordFields -> ShowS
[DuplicateRecordFields] -> ShowS
DuplicateRecordFields -> String
(Int -> DuplicateRecordFields -> ShowS)
-> (DuplicateRecordFields -> String)
-> ([DuplicateRecordFields] -> ShowS)
-> Show DuplicateRecordFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DuplicateRecordFields -> ShowS
showsPrec :: Int -> DuplicateRecordFields -> ShowS
$cshow :: DuplicateRecordFields -> String
show :: DuplicateRecordFields -> String
$cshowList :: [DuplicateRecordFields] -> ShowS
showList :: [DuplicateRecordFields] -> ShowS
Show, DuplicateRecordFields -> DuplicateRecordFields -> Bool
(DuplicateRecordFields -> DuplicateRecordFields -> Bool)
-> (DuplicateRecordFields -> DuplicateRecordFields -> Bool)
-> Eq DuplicateRecordFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DuplicateRecordFields -> DuplicateRecordFields -> Bool
== :: DuplicateRecordFields -> DuplicateRecordFields -> Bool
$c/= :: DuplicateRecordFields -> DuplicateRecordFields -> Bool
/= :: DuplicateRecordFields -> DuplicateRecordFields -> Bool
Eq, Typeable, Typeable DuplicateRecordFields
Typeable DuplicateRecordFields =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> DuplicateRecordFields
 -> c DuplicateRecordFields)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DuplicateRecordFields)
-> (DuplicateRecordFields -> Constr)
-> (DuplicateRecordFields -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DuplicateRecordFields))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DuplicateRecordFields))
-> ((forall b. Data b => b -> b)
    -> DuplicateRecordFields -> DuplicateRecordFields)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DuplicateRecordFields
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DuplicateRecordFields
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DuplicateRecordFields -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DuplicateRecordFields -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DuplicateRecordFields -> m DuplicateRecordFields)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DuplicateRecordFields -> m DuplicateRecordFields)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DuplicateRecordFields -> m DuplicateRecordFields)
-> Data DuplicateRecordFields
DuplicateRecordFields -> Constr
DuplicateRecordFields -> DataType
(forall b. Data b => b -> b)
-> DuplicateRecordFields -> DuplicateRecordFields
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) -> DuplicateRecordFields -> u
forall u.
(forall d. Data d => d -> u) -> DuplicateRecordFields -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DuplicateRecordFields -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DuplicateRecordFields -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DuplicateRecordFields -> m DuplicateRecordFields
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DuplicateRecordFields -> m DuplicateRecordFields
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DuplicateRecordFields
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DuplicateRecordFields
-> c DuplicateRecordFields
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DuplicateRecordFields)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DuplicateRecordFields)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DuplicateRecordFields
-> c DuplicateRecordFields
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DuplicateRecordFields
-> c DuplicateRecordFields
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DuplicateRecordFields
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DuplicateRecordFields
$ctoConstr :: DuplicateRecordFields -> Constr
toConstr :: DuplicateRecordFields -> Constr
$cdataTypeOf :: DuplicateRecordFields -> DataType
dataTypeOf :: DuplicateRecordFields -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DuplicateRecordFields)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DuplicateRecordFields)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DuplicateRecordFields)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DuplicateRecordFields)
$cgmapT :: (forall b. Data b => b -> b)
-> DuplicateRecordFields -> DuplicateRecordFields
gmapT :: (forall b. Data b => b -> b)
-> DuplicateRecordFields -> DuplicateRecordFields
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DuplicateRecordFields -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DuplicateRecordFields -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DuplicateRecordFields -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DuplicateRecordFields -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DuplicateRecordFields -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DuplicateRecordFields -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DuplicateRecordFields -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DuplicateRecordFields -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DuplicateRecordFields -> m DuplicateRecordFields
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DuplicateRecordFields -> m DuplicateRecordFields
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DuplicateRecordFields -> m DuplicateRecordFields
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DuplicateRecordFields -> m DuplicateRecordFields
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DuplicateRecordFields -> m DuplicateRecordFields
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DuplicateRecordFields -> m DuplicateRecordFields
Data)

instance Binary DuplicateRecordFields where
    put_ :: BinHandle -> DuplicateRecordFields -> IO ()
put_ BinHandle
bh DuplicateRecordFields
f = BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (DuplicateRecordFields
f DuplicateRecordFields -> DuplicateRecordFields -> Bool
forall a. Eq a => a -> a -> Bool
== DuplicateRecordFields
DuplicateRecordFields)
    get :: BinHandle -> IO DuplicateRecordFields
get BinHandle
bh = DuplicateRecordFields
-> DuplicateRecordFields -> Bool -> DuplicateRecordFields
forall a. a -> a -> Bool -> a
bool DuplicateRecordFields
NoDuplicateRecordFields DuplicateRecordFields
DuplicateRecordFields (Bool -> DuplicateRecordFields)
-> IO Bool -> IO DuplicateRecordFields
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Outputable DuplicateRecordFields where
    ppr :: DuplicateRecordFields -> SDoc
ppr DuplicateRecordFields
DuplicateRecordFields   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"+dup"
    ppr DuplicateRecordFields
NoDuplicateRecordFields = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-dup"

instance NFData DuplicateRecordFields where
  rnf :: DuplicateRecordFields -> ()
rnf DuplicateRecordFields
x = DuplicateRecordFields
x DuplicateRecordFields -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Flag to indicate whether the FieldSelectors extension is enabled.
data FieldSelectors
    = FieldSelectors   -- ^ Selector functions are available (the default)
    | NoFieldSelectors -- ^ Selector functions are not available
  deriving (Int -> FieldSelectors -> ShowS
[FieldSelectors] -> ShowS
FieldSelectors -> String
(Int -> FieldSelectors -> ShowS)
-> (FieldSelectors -> String)
-> ([FieldSelectors] -> ShowS)
-> Show FieldSelectors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldSelectors -> ShowS
showsPrec :: Int -> FieldSelectors -> ShowS
$cshow :: FieldSelectors -> String
show :: FieldSelectors -> String
$cshowList :: [FieldSelectors] -> ShowS
showList :: [FieldSelectors] -> ShowS
Show, FieldSelectors -> FieldSelectors -> Bool
(FieldSelectors -> FieldSelectors -> Bool)
-> (FieldSelectors -> FieldSelectors -> Bool) -> Eq FieldSelectors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldSelectors -> FieldSelectors -> Bool
== :: FieldSelectors -> FieldSelectors -> Bool
$c/= :: FieldSelectors -> FieldSelectors -> Bool
/= :: FieldSelectors -> FieldSelectors -> Bool
Eq, Typeable, Typeable FieldSelectors
Typeable FieldSelectors =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FieldSelectors -> c FieldSelectors)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FieldSelectors)
-> (FieldSelectors -> Constr)
-> (FieldSelectors -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FieldSelectors))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FieldSelectors))
-> ((forall b. Data b => b -> b)
    -> FieldSelectors -> FieldSelectors)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldSelectors -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldSelectors -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FieldSelectors -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FieldSelectors -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FieldSelectors -> m FieldSelectors)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FieldSelectors -> m FieldSelectors)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FieldSelectors -> m FieldSelectors)
-> Data FieldSelectors
FieldSelectors -> Constr
FieldSelectors -> DataType
(forall b. Data b => b -> b) -> FieldSelectors -> FieldSelectors
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) -> FieldSelectors -> u
forall u. (forall d. Data d => d -> u) -> FieldSelectors -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldSelectors -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldSelectors -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldSelectors -> m FieldSelectors
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldSelectors -> m FieldSelectors
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldSelectors
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldSelectors -> c FieldSelectors
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldSelectors)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldSelectors)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldSelectors -> c FieldSelectors
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldSelectors -> c FieldSelectors
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldSelectors
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldSelectors
$ctoConstr :: FieldSelectors -> Constr
toConstr :: FieldSelectors -> Constr
$cdataTypeOf :: FieldSelectors -> DataType
dataTypeOf :: FieldSelectors -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldSelectors)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldSelectors)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldSelectors)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldSelectors)
$cgmapT :: (forall b. Data b => b -> b) -> FieldSelectors -> FieldSelectors
gmapT :: (forall b. Data b => b -> b) -> FieldSelectors -> FieldSelectors
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldSelectors -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldSelectors -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldSelectors -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldSelectors -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FieldSelectors -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FieldSelectors -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FieldSelectors -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FieldSelectors -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldSelectors -> m FieldSelectors
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldSelectors -> m FieldSelectors
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldSelectors -> m FieldSelectors
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldSelectors -> m FieldSelectors
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldSelectors -> m FieldSelectors
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldSelectors -> m FieldSelectors
Data)

instance Binary FieldSelectors where
    put_ :: BinHandle -> FieldSelectors -> IO ()
put_ BinHandle
bh FieldSelectors
f = BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (FieldSelectors
f FieldSelectors -> FieldSelectors -> Bool
forall a. Eq a => a -> a -> Bool
== FieldSelectors
FieldSelectors)
    get :: BinHandle -> IO FieldSelectors
get BinHandle
bh = FieldSelectors -> FieldSelectors -> Bool -> FieldSelectors
forall a. a -> a -> Bool -> a
bool FieldSelectors
NoFieldSelectors FieldSelectors
FieldSelectors (Bool -> FieldSelectors) -> IO Bool -> IO FieldSelectors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Outputable FieldSelectors where
    ppr :: FieldSelectors -> SDoc
ppr FieldSelectors
FieldSelectors   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"+sel"
    ppr FieldSelectors
NoFieldSelectors = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-sel"

instance NFData FieldSelectors where
  rnf :: FieldSelectors -> ()
rnf FieldSelectors
x = FieldSelectors
x FieldSelectors -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | We need the @Binary Name@ constraint here even though there is an instance
-- defined in "GHC.Types.Name", because the we have a SOURCE import, so the
-- instance is not in scope.  And the instance cannot be added to Name.hs-boot
-- because "GHC.Utils.Binary" itself depends on "GHC.Types.Name".
instance Binary Name => Binary FieldLabel where
    put_ :: BinHandle -> FieldLabel -> IO ()
put_ BinHandle
bh (FieldLabel FieldLabelString
aa DuplicateRecordFields
ab FieldSelectors
ac Name
ad) = do
        BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (FieldLabelString -> FastString
field_label FieldLabelString
aa)
        BinHandle -> DuplicateRecordFields -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh DuplicateRecordFields
ab
        BinHandle -> FieldSelectors -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FieldSelectors
ac
        BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
ad
    get :: BinHandle -> IO FieldLabel
get BinHandle
bh = do
        FastString
aa <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        DuplicateRecordFields
ab <- BinHandle -> IO DuplicateRecordFields
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        FieldSelectors
ac <- BinHandle -> IO FieldSelectors
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Name
ad <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        FieldLabel -> IO FieldLabel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabelString
-> DuplicateRecordFields -> FieldSelectors -> Name -> FieldLabel
FieldLabel (FastString -> FieldLabelString
FieldLabelString FastString
aa) DuplicateRecordFields
ab FieldSelectors
ac Name
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].
fieldSelectorOccName :: FieldLabelString -> OccName -> DuplicateRecordFields -> FieldSelectors -> OccName
fieldSelectorOccName :: FieldLabelString
-> OccName -> DuplicateRecordFields -> FieldSelectors -> OccName
fieldSelectorOccName FieldLabelString
lbl OccName
dc DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel
  | DuplicateRecordFields -> FieldSelectors -> Bool
shouldMangleSelectorNames DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel = FastString -> OccName
mkRecFldSelOcc FastString
str
  | Bool
otherwise     = FastString -> OccName
mkVarOccFS FastString
fl
  where
    fl :: FastString
fl      = FieldLabelString -> FastString
field_label FieldLabelString
lbl
    str :: FastString
str     = [FastString] -> FastString
concatFS [String -> FastString
fsLit String
":", FastString
fl, String -> FastString
fsLit String
":", OccName -> FastString
occNameFS OccName
dc]

-- | Undo the name mangling described in Note [FieldLabel] to produce a Name
-- that has the user-visible OccName (but the selector's unique).  This should
-- be used only when generating output, when we want to show the label, but may
-- need to qualify it with a module prefix.
fieldLabelPrintableName :: FieldLabel -> Name
fieldLabelPrintableName :: FieldLabel -> Name
fieldLabelPrintableName FieldLabel
fl
  | FieldLabel -> Bool
flIsOverloaded FieldLabel
fl = Name -> OccName -> Name
tidyNameOcc (FieldLabel -> Name
flSelector FieldLabel
fl) (FastString -> OccName
mkVarOccFS (FieldLabelString -> FastString
field_label (FieldLabelString -> FastString) -> FieldLabelString -> FastString
forall a b. (a -> b) -> a -> b
$ FieldLabel -> FieldLabelString
flLabel FieldLabel
fl))
  | Bool
otherwise         = FieldLabel -> Name
flSelector FieldLabel
fl

-- | Selector name mangling should be used if either DuplicateRecordFields or
-- NoFieldSelectors is enabled, so that the OccName of the field can be used for
-- something else.  See Note [FieldLabel], and Note [NoFieldSelectors] in
-- GHC.Rename.Env.
shouldMangleSelectorNames :: DuplicateRecordFields -> FieldSelectors -> Bool
shouldMangleSelectorNames :: DuplicateRecordFields -> FieldSelectors -> Bool
shouldMangleSelectorNames DuplicateRecordFields
dup_fields_ok FieldSelectors
has_sel
    = DuplicateRecordFields
dup_fields_ok DuplicateRecordFields -> DuplicateRecordFields -> Bool
forall a. Eq a => a -> a -> Bool
== DuplicateRecordFields
DuplicateRecordFields Bool -> Bool -> Bool
|| FieldSelectors
has_sel FieldSelectors -> FieldSelectors -> Bool
forall a. Eq a => a -> a -> Bool
== FieldSelectors
NoFieldSelectors

flIsOverloaded :: FieldLabel -> Bool
flIsOverloaded :: FieldLabel -> Bool
flIsOverloaded FieldLabel
fl =
    DuplicateRecordFields -> FieldSelectors -> Bool
shouldMangleSelectorNames (FieldLabel -> DuplicateRecordFields
flHasDuplicateRecordFields FieldLabel
fl) (FieldLabel -> FieldSelectors
flHasFieldSelector FieldLabel
fl)