{-# LANGUAGE DeriveDataTypeable #-}
--
-- (c) The University of Glasgow
--

module GHC.Types.Avail (
    Avails,
    AvailInfo(..),
    avail,
    availField,
    availTC,
    availsToNameSet,
    availsToNameSetWithSelectors,
    availsToNameEnv,
    availExportsDecl,
    availName, availGreName,
    availNames, availNonFldNames,
    availNamesWithSelectors,
    availFlds,
    availGreNames,
    availSubordinateGreNames,
    stableAvailCmp,
    plusAvail,
    trimAvail,
    filterAvail,
    filterAvails,
    nubAvails,

    GreName(..),
    greNameMangledName,
    greNamePrintableName,
    greNameSrcSpan,
    greNameFieldLabel,
    partitionGreNames,
    stableGreNameCmp,
  ) where

import GHC.Prelude

import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.SrcLoc

import GHC.Types.FieldLabel
import GHC.Utils.Binary
import GHC.Data.List.SetOps
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)

import Control.DeepSeq
import Data.Data ( Data )
import Data.Either ( partitionEithers )
import Data.Functor.Classes ( liftCompare )
import Data.List ( find )
import Data.Maybe
import qualified Data.Semigroup as S

-- -----------------------------------------------------------------------------
-- The AvailInfo type

-- | Records what things are \"available\", i.e. in scope
data AvailInfo

  -- | An ordinary identifier in scope, or a field label without a parent type
  -- (see Note [Representing pattern synonym fields in AvailInfo]).
  = Avail GreName

  -- | A type or class in scope
  --
  -- The __AvailTC Invariant__: If the type or class is itself to be in scope,
  -- it must be /first/ in this list.  Thus, typically:
  --
  -- > AvailTC Eq [Eq, ==, \/=]
  | AvailTC
       Name         -- ^ The name of the type or class
       [GreName]      -- ^ The available pieces of type or class
                    -- (see Note [Representing fields in AvailInfo]).

   deriving ( AvailInfo -> AvailInfo -> Bool
(AvailInfo -> AvailInfo -> Bool)
-> (AvailInfo -> AvailInfo -> Bool) -> Eq AvailInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AvailInfo -> AvailInfo -> Bool
== :: AvailInfo -> AvailInfo -> Bool
$c/= :: AvailInfo -> AvailInfo -> Bool
/= :: AvailInfo -> AvailInfo -> Bool
Eq    -- ^ Used when deciding if the interface has changed
            , Typeable AvailInfo
Typeable AvailInfo =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AvailInfo -> c AvailInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AvailInfo)
-> (AvailInfo -> Constr)
-> (AvailInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AvailInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo))
-> ((forall b. Data b => b -> b) -> AvailInfo -> AvailInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AvailInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AvailInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AvailInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo)
-> Data AvailInfo
AvailInfo -> Constr
AvailInfo -> DataType
(forall b. Data b => b -> b) -> AvailInfo -> AvailInfo
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) -> AvailInfo -> u
forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AvailInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
$ctoConstr :: AvailInfo -> Constr
toConstr :: AvailInfo -> Constr
$cdataTypeOf :: AvailInfo -> DataType
dataTypeOf :: AvailInfo -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AvailInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AvailInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo)
$cgmapT :: (forall b. Data b => b -> b) -> AvailInfo -> AvailInfo
gmapT :: (forall b. Data b => b -> b) -> AvailInfo -> AvailInfo
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AvailInfo -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AvailInfo -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
Data )

-- | A collection of 'AvailInfo' - several things that are \"available\"
type Avails = [AvailInfo]

{-
Note [Representing fields in AvailInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also Note [FieldLabel] in GHC.Types.FieldLabel.

When -XDuplicateRecordFields is disabled (the normal case), a
datatype like

  data T = MkT { foo :: Int }

gives rise to the AvailInfo

  AvailTC T [T, MkT, FieldLabel "foo" NoDuplicateRecordFields FieldSelectors foo]

whereas if -XDuplicateRecordFields is enabled it gives

  AvailTC T [T, MkT, FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkT]

where the label foo does not match the selector name $sel:foo:MkT.

The labels in a field list are not necessarily unique:
data families allow the same parent (the family tycon) to have
multiple distinct fields with the same label. For example,

  data family F a
  data instance F Int  = MkFInt { foo :: Int }
  data instance F Bool = MkFBool { foo :: Bool}

gives rise to

  AvailTC F [ F, MkFInt, MkFBool
            , FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkFInt
            , FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkFBool ]

Moreover, note that the flHasDuplicateRecordFields or flFieldSelectors flags
need not be the same for all the elements of the list.  In the example above,
this occurs if the two data instances are defined in different modules, with
different states of the `-XDuplicateRecordFields` or `-XNoFieldSelectors`
extensions.  Thus it is possible to have

  AvailTC F [ F, MkFInt, MkFBool
            , FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkFInt
            , FieldLabel "foo" NoDuplicateRecordFields FieldSelectors foo ]

If the two data instances are defined in different modules, both without
`-XDuplicateRecordFields` or `-XNoFieldSelectors`, it will be impossible to
export them from the same module (even with `-XDuplicateRecordfields` enabled),
because they would be represented identically.  The workaround here is to enable
`-XDuplicateRecordFields` or `-XNoFieldSelectors` on the defining modules.  See
also #13352.


Note [Representing pattern synonym fields in AvailInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Record pattern synonym fields cannot be represented using AvailTC like fields of
normal record types (see Note [Representing fields in AvailInfo]), because they
do not always have a parent type constructor.  So we represent them using the
Avail constructor, with a NormalGreName that carries the underlying FieldLabel.

Thus under -XDuplicateRecordFields -XPatternSynoynms, the declaration

  pattern MkFoo{f} = Bar f

gives rise to the AvailInfo

  Avail (NormalGreName MkFoo)
  Avail (FieldGreName (FieldLabel "f" True $sel:f:MkFoo))

However, if `f` is bundled with a type constructor `T` by using `T(MkFoo,f)` in
an export list, then whenever `f` is imported the parent will be `T`,
represented as

  AvailTC T [ NormalGreName T
            , NormalGreName MkFoo
            , FieldGreName (FieldLabel "f" True $sel:f:MkFoo) ]

See also Note [GreNames] in GHC.Types.Name.Reader.
-}

-- | Compare lexicographically
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp (Avail GreName
c1)     (Avail GreName
c2)     = GreName
c1 GreName -> GreName -> Ordering
`stableGreNameCmp` GreName
c2
stableAvailCmp (Avail {})     (AvailTC {})   = Ordering
LT
stableAvailCmp (AvailTC Name
n [GreName]
ns) (AvailTC Name
m [GreName]
ms) = Name -> Name -> Ordering
stableNameCmp Name
n Name
m Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<> (GreName -> GreName -> Ordering)
-> [GreName] -> [GreName] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare GreName -> GreName -> Ordering
stableGreNameCmp [GreName]
ns [GreName]
ms
stableAvailCmp (AvailTC {})   (Avail {})     = Ordering
GT

stableGreNameCmp :: GreName -> GreName -> Ordering
stableGreNameCmp :: GreName -> GreName -> Ordering
stableGreNameCmp (NormalGreName Name
n1) (NormalGreName Name
n2) = Name
n1 Name -> Name -> Ordering
`stableNameCmp` Name
n2
stableGreNameCmp (NormalGreName {}) (FieldGreName  {}) = Ordering
LT
stableGreNameCmp (FieldGreName  FieldLabel
f1) (FieldGreName  FieldLabel
f2) = FieldLabel -> Name
flSelector FieldLabel
f1 Name -> Name -> Ordering
`stableNameCmp` FieldLabel -> Name
flSelector FieldLabel
f2
stableGreNameCmp (FieldGreName  {}) (NormalGreName {}) = Ordering
GT

avail :: Name -> AvailInfo
avail :: Name -> AvailInfo
avail Name
n = GreName -> AvailInfo
Avail (Name -> GreName
NormalGreName Name
n)

availField :: FieldLabel -> AvailInfo
availField :: FieldLabel -> AvailInfo
availField FieldLabel
fl = GreName -> AvailInfo
Avail (FieldLabel -> GreName
FieldGreName FieldLabel
fl)

availTC :: Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC :: Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
n [Name]
ns [FieldLabel]
fls = Name -> [GreName] -> AvailInfo
AvailTC Name
n ((Name -> GreName) -> [Name] -> [GreName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> GreName
NormalGreName [Name]
ns [GreName] -> [GreName] -> [GreName]
forall a. [a] -> [a] -> [a]
++ (FieldLabel -> GreName) -> [FieldLabel] -> [GreName]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> GreName
FieldGreName [FieldLabel]
fls)


-- -----------------------------------------------------------------------------
-- Operations on AvailInfo

availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet [AvailInfo]
avails = (AvailInfo -> NameSet -> NameSet)
-> NameSet -> [AvailInfo] -> NameSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> NameSet -> NameSet
add NameSet
emptyNameSet [AvailInfo]
avails
      where add :: AvailInfo -> NameSet -> NameSet
add AvailInfo
avail NameSet
set = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
set (AvailInfo -> [Name]
availNames AvailInfo
avail)

availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors [AvailInfo]
avails = (AvailInfo -> NameSet -> NameSet)
-> NameSet -> [AvailInfo] -> NameSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> NameSet -> NameSet
add NameSet
emptyNameSet [AvailInfo]
avails
      where add :: AvailInfo -> NameSet -> NameSet
add AvailInfo
avail NameSet
set = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
set (AvailInfo -> [Name]
availNamesWithSelectors AvailInfo
avail)

availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv [AvailInfo]
avails = (AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo)
-> NameEnv AvailInfo -> [AvailInfo] -> NameEnv AvailInfo
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo
add NameEnv AvailInfo
forall a. NameEnv a
emptyNameEnv [AvailInfo]
avails
     where add :: AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo
add AvailInfo
avail NameEnv AvailInfo
env = NameEnv AvailInfo -> [(Name, AvailInfo)] -> NameEnv AvailInfo
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList NameEnv AvailInfo
env
                                ([Name] -> [AvailInfo] -> [(Name, AvailInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip (AvailInfo -> [Name]
availNames AvailInfo
avail) (AvailInfo -> [AvailInfo]
forall a. a -> [a]
repeat AvailInfo
avail))

-- | Does this 'AvailInfo' export the parent decl?  This depends on the
-- invariant that the parent is first if it appears at all.
availExportsDecl :: AvailInfo -> Bool
availExportsDecl :: AvailInfo -> Bool
availExportsDecl (AvailTC Name
ty_name [GreName]
names)
  | GreName
n : [GreName]
_ <- [GreName]
names = Name -> GreName
NormalGreName Name
ty_name GreName -> GreName -> Bool
forall a. Eq a => a -> a -> Bool
== GreName
n
  | Bool
otherwise      = Bool
False
availExportsDecl AvailInfo
_ = Bool
True

-- | Just the main name made available, i.e. not the available pieces
-- of type or class brought into scope by the 'AvailInfo'
availName :: AvailInfo -> Name
availName :: AvailInfo -> Name
availName (Avail GreName
n)     = GreName -> Name
greNameMangledName GreName
n
availName (AvailTC Name
n [GreName]
_) = Name
n

availGreName :: AvailInfo -> GreName
availGreName :: AvailInfo -> GreName
availGreName (Avail GreName
c) = GreName
c
availGreName (AvailTC Name
n [GreName]
_) = Name -> GreName
NormalGreName Name
n

-- | All names made available by the availability information (excluding overloaded selectors)
availNames :: AvailInfo -> [Name]
availNames :: AvailInfo -> [Name]
availNames (Avail GreName
c) = GreName -> [Name]
childNonOverloadedNames GreName
c
availNames (AvailTC Name
_ [GreName]
cs) = (GreName -> [Name]) -> [GreName] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GreName -> [Name]
childNonOverloadedNames [GreName]
cs

childNonOverloadedNames :: GreName -> [Name]
childNonOverloadedNames :: GreName -> [Name]
childNonOverloadedNames (NormalGreName Name
n) = [Name
n]
childNonOverloadedNames (FieldGreName FieldLabel
fl) = [ FieldLabel -> Name
flSelector FieldLabel
fl | Bool -> Bool
not (FieldLabel -> Bool
flIsOverloaded FieldLabel
fl) ]

-- | All names made available by the availability information (including overloaded selectors)
availNamesWithSelectors :: AvailInfo -> [Name]
availNamesWithSelectors :: AvailInfo -> [Name]
availNamesWithSelectors (Avail GreName
c) = [GreName -> Name
greNameMangledName GreName
c]
availNamesWithSelectors (AvailTC Name
_ [GreName]
cs) = (GreName -> Name) -> [GreName] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GreName -> Name
greNameMangledName [GreName]
cs

-- | Names for non-fields made available by the availability information
availNonFldNames :: AvailInfo -> [Name]
availNonFldNames :: AvailInfo -> [Name]
availNonFldNames (Avail (NormalGreName Name
n)) = [Name
n]
availNonFldNames (Avail (FieldGreName {})) = []
availNonFldNames (AvailTC Name
_ [GreName]
ns) = (GreName -> Maybe Name) -> [GreName] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GreName -> Maybe Name
f [GreName]
ns
  where
    f :: GreName -> Maybe Name
f (NormalGreName Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
    f (FieldGreName {}) = Maybe Name
forall a. Maybe a
Nothing

-- | Fields made available by the availability information
availFlds :: AvailInfo -> [FieldLabel]
availFlds :: AvailInfo -> [FieldLabel]
availFlds (Avail GreName
c) = Maybe FieldLabel -> [FieldLabel]
forall a. Maybe a -> [a]
maybeToList (GreName -> Maybe FieldLabel
greNameFieldLabel GreName
c)
availFlds (AvailTC Name
_ [GreName]
cs) = (GreName -> Maybe FieldLabel) -> [GreName] -> [FieldLabel]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GreName -> Maybe FieldLabel
greNameFieldLabel [GreName]
cs

-- | Names and fields made available by the availability information.
availGreNames :: AvailInfo -> [GreName]
availGreNames :: AvailInfo -> [GreName]
availGreNames (Avail GreName
c)      = [GreName
c]
availGreNames (AvailTC Name
_ [GreName]
cs) = [GreName]
cs

-- | Names and fields made available by the availability information, other than
-- the main decl itself.
availSubordinateGreNames :: AvailInfo -> [GreName]
availSubordinateGreNames :: AvailInfo -> [GreName]
availSubordinateGreNames (Avail {}) = []
availSubordinateGreNames avail :: AvailInfo
avail@(AvailTC Name
_ [GreName]
ns)
  | AvailInfo -> Bool
availExportsDecl AvailInfo
avail = [GreName] -> [GreName]
forall a. HasCallStack => [a] -> [a]
tail [GreName]
ns
  | Bool
otherwise              = [GreName]
ns


-- | Used where we may have an ordinary name or a record field label.
-- See Note [GreNames] in GHC.Types.Name.Reader.
data GreName = NormalGreName Name
             | FieldGreName FieldLabel
    deriving (Typeable GreName
Typeable GreName =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GreName -> c GreName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GreName)
-> (GreName -> Constr)
-> (GreName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GreName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GreName))
-> ((forall b. Data b => b -> b) -> GreName -> GreName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GreName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GreName -> r)
-> (forall u. (forall d. Data d => d -> u) -> GreName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> GreName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GreName -> m GreName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GreName -> m GreName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GreName -> m GreName)
-> Data GreName
GreName -> Constr
GreName -> DataType
(forall b. Data b => b -> b) -> GreName -> GreName
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) -> GreName -> u
forall u. (forall d. Data d => d -> u) -> GreName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GreName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GreName -> c GreName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GreName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GreName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GreName -> c GreName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GreName -> c GreName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GreName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GreName
$ctoConstr :: GreName -> Constr
toConstr :: GreName -> Constr
$cdataTypeOf :: GreName -> DataType
dataTypeOf :: GreName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GreName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GreName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GreName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GreName)
$cgmapT :: (forall b. Data b => b -> b) -> GreName -> GreName
gmapT :: (forall b. Data b => b -> b) -> GreName -> GreName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GreName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> GreName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GreName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GreName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
Data, GreName -> GreName -> Bool
(GreName -> GreName -> Bool)
-> (GreName -> GreName -> Bool) -> Eq GreName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GreName -> GreName -> Bool
== :: GreName -> GreName -> Bool
$c/= :: GreName -> GreName -> Bool
/= :: GreName -> GreName -> Bool
Eq)

instance Outputable GreName where
  ppr :: GreName -> SDoc
ppr (NormalGreName Name
n) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
  ppr (FieldGreName FieldLabel
fl) = FieldLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl

instance NFData GreName where
  rnf :: GreName -> ()
rnf (NormalGreName Name
n) = Name -> ()
forall a. NFData a => a -> ()
rnf Name
n
  rnf (FieldGreName FieldLabel
f) = FieldLabel -> ()
forall a. NFData a => a -> ()
rnf FieldLabel
f

instance HasOccName GreName where
  occName :: GreName -> OccName
occName (NormalGreName Name
n) = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
n
  occName (FieldGreName FieldLabel
fl) = FieldLabel -> OccName
forall name. HasOccName name => name -> OccName
occName FieldLabel
fl

instance Ord GreName where
  compare :: GreName -> GreName -> Ordering
compare = GreName -> GreName -> Ordering
stableGreNameCmp

-- | A 'Name' for internal use, but not for output to the user.  For fields, the
-- 'OccName' will be the selector.  See Note [GreNames] in GHC.Types.Name.Reader.
greNameMangledName :: GreName -> Name
greNameMangledName :: GreName -> Name
greNameMangledName (NormalGreName Name
n) = Name
n
greNameMangledName (FieldGreName FieldLabel
fl) = FieldLabel -> Name
flSelector FieldLabel
fl

-- | A 'Name' suitable for output to the user.  For fields, the 'OccName' will
-- be the field label.  See Note [GreNames] in GHC.Types.Name.Reader.
greNamePrintableName :: GreName -> Name
greNamePrintableName :: GreName -> Name
greNamePrintableName (NormalGreName Name
n) = Name
n
greNamePrintableName (FieldGreName FieldLabel
fl) = FieldLabel -> Name
fieldLabelPrintableName FieldLabel
fl

greNameSrcSpan :: GreName -> SrcSpan
greNameSrcSpan :: GreName -> SrcSpan
greNameSrcSpan (NormalGreName Name
n) = Name -> SrcSpan
nameSrcSpan Name
n
greNameSrcSpan (FieldGreName FieldLabel
fl) = Name -> SrcSpan
nameSrcSpan (FieldLabel -> Name
flSelector FieldLabel
fl)

greNameFieldLabel :: GreName -> Maybe FieldLabel
greNameFieldLabel :: GreName -> Maybe FieldLabel
greNameFieldLabel (NormalGreName {}) = Maybe FieldLabel
forall a. Maybe a
Nothing
greNameFieldLabel (FieldGreName FieldLabel
fl)  = FieldLabel -> Maybe FieldLabel
forall a. a -> Maybe a
Just FieldLabel
fl

partitionGreNames :: [GreName] -> ([Name], [FieldLabel])
partitionGreNames :: [GreName] -> ([Name], [FieldLabel])
partitionGreNames = [Either Name FieldLabel] -> ([Name], [FieldLabel])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Name FieldLabel] -> ([Name], [FieldLabel]))
-> ([GreName] -> [Either Name FieldLabel])
-> [GreName]
-> ([Name], [FieldLabel])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GreName -> Either Name FieldLabel)
-> [GreName] -> [Either Name FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map GreName -> Either Name FieldLabel
to_either
  where
    to_either :: GreName -> Either Name FieldLabel
to_either (NormalGreName Name
n) = Name -> Either Name FieldLabel
forall a b. a -> Either a b
Left Name
n
    to_either (FieldGreName FieldLabel
fl) = FieldLabel -> Either Name FieldLabel
forall a b. b -> Either a b
Right FieldLabel
fl


-- -----------------------------------------------------------------------------
-- Utility

plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
plusAvail AvailInfo
a1 AvailInfo
a2
  | Bool
debugIsOn Bool -> Bool -> Bool
&& AvailInfo -> Name
availName AvailInfo
a1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= AvailInfo -> Name
availName AvailInfo
a2
  = String -> SDoc -> AvailInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"GHC.Rename.Env.plusAvail names differ" ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a1,AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a2])
plusAvail a1 :: AvailInfo
a1@(Avail {})         (Avail {})        = AvailInfo
a1
plusAvail (AvailTC Name
_ [])     a2 :: AvailInfo
a2@(AvailTC {})   = AvailInfo
a2
plusAvail a1 :: AvailInfo
a1@(AvailTC {})       (AvailTC Name
_ []) = AvailInfo
a1
plusAvail (AvailTC Name
n1 (GreName
s1:[GreName]
ss1)) (AvailTC Name
n2 (GreName
s2:[GreName]
ss2))
  = case (Name -> GreName
NormalGreName Name
n1GreName -> GreName -> Bool
forall a. Eq a => a -> a -> Bool
==GreName
s1, Name -> GreName
NormalGreName Name
n2GreName -> GreName -> Bool
forall a. Eq a => a -> a -> Bool
==GreName
s2) of  -- Maintain invariant the parent is first
       (Bool
True,Bool
True)   -> Name -> [GreName] -> AvailInfo
AvailTC Name
n1 (GreName
s1 GreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
: ([GreName]
ss1 [GreName] -> [GreName] -> [GreName]
forall a.
(() :: Constraint, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` [GreName]
ss2))
       (Bool
True,Bool
False)  -> Name -> [GreName] -> AvailInfo
AvailTC Name
n1 (GreName
s1 GreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
: ([GreName]
ss1 [GreName] -> [GreName] -> [GreName]
forall a.
(() :: Constraint, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` (GreName
s2GreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
:[GreName]
ss2)))
       (Bool
False,Bool
True)  -> Name -> [GreName] -> AvailInfo
AvailTC Name
n1 (GreName
s2 GreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
: ((GreName
s1GreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
:[GreName]
ss1) [GreName] -> [GreName] -> [GreName]
forall a.
(() :: Constraint, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` [GreName]
ss2))
       (Bool
False,Bool
False) -> Name -> [GreName] -> AvailInfo
AvailTC Name
n1 ((GreName
s1GreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
:[GreName]
ss1) [GreName] -> [GreName] -> [GreName]
forall a.
(() :: Constraint, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` (GreName
s2GreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
:[GreName]
ss2))
plusAvail AvailInfo
a1 AvailInfo
a2 = String -> SDoc -> AvailInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"GHC.Rename.Env.plusAvail" ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a1,AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a2])

-- | trims an 'AvailInfo' to keep only a single name
trimAvail :: AvailInfo -> Name -> AvailInfo
trimAvail :: AvailInfo -> Name -> AvailInfo
trimAvail avail :: AvailInfo
avail@(Avail {})         Name
_ = AvailInfo
avail
trimAvail avail :: AvailInfo
avail@(AvailTC Name
n [GreName]
ns) Name
m = case (GreName -> Bool) -> [GreName] -> Maybe GreName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
m) (Name -> Bool) -> (GreName -> Name) -> GreName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GreName -> Name
greNameMangledName) [GreName]
ns of
    Just GreName
c  -> Name -> [GreName] -> AvailInfo
AvailTC Name
n [GreName
c]
    Maybe GreName
Nothing -> String -> SDoc -> AvailInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"trimAvail" ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
avail, Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
m])

-- | filters 'AvailInfo's by the given predicate
filterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
filterAvails :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
filterAvails Name -> Bool
keep [AvailInfo]
avails = (AvailInfo -> [AvailInfo] -> [AvailInfo])
-> [AvailInfo] -> [AvailInfo] -> [AvailInfo]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail Name -> Bool
keep) [] [AvailInfo]
avails

-- | filters an 'AvailInfo' by the given predicate
filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail Name -> Bool
keep AvailInfo
ie [AvailInfo]
rest =
  case AvailInfo
ie of
    Avail GreName
c | Name -> Bool
keep (GreName -> Name
greNameMangledName GreName
c) -> AvailInfo
ie AvailInfo -> [AvailInfo] -> [AvailInfo]
forall a. a -> [a] -> [a]
: [AvailInfo]
rest
            | Bool
otherwise -> [AvailInfo]
rest
    AvailTC Name
tc [GreName]
cs ->
        let cs' :: [GreName]
cs' = (GreName -> Bool) -> [GreName] -> [GreName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Bool
keep (Name -> Bool) -> (GreName -> Name) -> GreName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GreName -> Name
greNameMangledName) [GreName]
cs
        in if [GreName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GreName]
cs' then [AvailInfo]
rest else Name -> [GreName] -> AvailInfo
AvailTC Name
tc [GreName]
cs' AvailInfo -> [AvailInfo] -> [AvailInfo]
forall a. a -> [a] -> [a]
: [AvailInfo]
rest


-- | Combines 'AvailInfo's from the same family
-- 'avails' may have several items with the same availName
-- E.g  import Ix( Ix(..), index )
-- will give Ix(Ix,index,range) and Ix(index)
-- We want to combine these; addAvail does that
nubAvails :: [AvailInfo] -> [AvailInfo]
nubAvails :: [AvailInfo] -> [AvailInfo]
nubAvails [AvailInfo]
avails = DNameEnv AvailInfo -> [AvailInfo]
forall a. DNameEnv a -> [a]
eltsDNameEnv ((DNameEnv AvailInfo -> AvailInfo -> DNameEnv AvailInfo)
-> DNameEnv AvailInfo -> [AvailInfo] -> DNameEnv AvailInfo
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DNameEnv AvailInfo -> AvailInfo -> DNameEnv AvailInfo
add DNameEnv AvailInfo
forall a. DNameEnv a
emptyDNameEnv [AvailInfo]
avails)
  where
    add :: DNameEnv AvailInfo -> AvailInfo -> DNameEnv AvailInfo
add DNameEnv AvailInfo
env AvailInfo
avail = (AvailInfo -> AvailInfo -> AvailInfo)
-> DNameEnv AvailInfo -> Name -> AvailInfo -> DNameEnv AvailInfo
forall a. (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a
extendDNameEnv_C AvailInfo -> AvailInfo -> AvailInfo
plusAvail DNameEnv AvailInfo
env (AvailInfo -> Name
availName AvailInfo
avail) AvailInfo
avail

-- -----------------------------------------------------------------------------
-- Printing

instance Outputable AvailInfo where
   ppr :: AvailInfo -> SDoc
ppr = AvailInfo -> SDoc
pprAvail

pprAvail :: AvailInfo -> SDoc
pprAvail :: AvailInfo -> SDoc
pprAvail (Avail GreName
n)
  = GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
n
pprAvail (AvailTC Name
n [GreName]
ns)
  = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ((GreName -> SDoc) -> [GreName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GreName]
ns)

instance Binary AvailInfo where
    put_ :: BinHandle -> AvailInfo -> IO ()
put_ BinHandle
bh (Avail GreName
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            BinHandle -> GreName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh GreName
aa
    put_ BinHandle
bh (AvailTC Name
ab [GreName]
ac) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
ab
            BinHandle -> [GreName] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [GreName]
ac
    get :: BinHandle -> IO AvailInfo
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do GreName
aa <- BinHandle -> IO GreName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      AvailInfo -> IO AvailInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GreName -> AvailInfo
Avail GreName
aa)
              Word8
_ -> do Name
ab <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      [GreName]
ac <- BinHandle -> IO [GreName]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      AvailInfo -> IO AvailInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [GreName] -> AvailInfo
AvailTC Name
ab [GreName]
ac)

instance NFData AvailInfo where
  rnf :: AvailInfo -> ()
rnf (Avail GreName
n) = GreName -> ()
forall a. NFData a => a -> ()
rnf GreName
n
  rnf (AvailTC Name
a [GreName]
b) = Name -> ()
forall a. NFData a => a -> ()
rnf Name
a () -> () -> ()
forall a b. a -> b -> b
`seq` [GreName] -> ()
forall a. NFData a => a -> ()
rnf [GreName]
b

instance Binary GreName where
    put_ :: BinHandle -> GreName -> IO ()
put_ BinHandle
bh (NormalGreName Name
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
aa
    put_ BinHandle
bh (FieldGreName FieldLabel
ab) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            BinHandle -> FieldLabel -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FieldLabel
ab
    get :: BinHandle -> IO GreName
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do Name
aa <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      GreName -> IO GreName
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> GreName
NormalGreName Name
aa)
              Word8
_ -> do FieldLabel
ab <- BinHandle -> IO FieldLabel
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      GreName -> IO GreName
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel -> GreName
FieldGreName FieldLabel
ab)