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

module GHC.Types.Avail (
    Avails,
    AvailInfo(..),
    availsToNameSet,
    availsToNameEnv,
    availExportsDecl,
    availName,
    availNames,
    availSubordinateNames,
    stableAvailCmp,
    plusAvail,
    trimAvail,
    filterAvail,
    filterAvails,
    nubAvails,
    sortAvails,
    DetOrdAvails(DetOrdAvails, DefinitelyDeterministicAvails)
  ) where

import GHC.Prelude

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

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.Functor.Classes ( liftCompare )
import Data.List ( find, sortBy )
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 Name

  -- | 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
       [Name]    -- ^ The available pieces of type or class

   deriving 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]

-- | Occurrences of Avails in interface files must be deterministically ordered
-- to guarantee interface file determinism.
--
-- We guarantee a deterministic order by either using the order explicitly
-- given by the user (e.g. in an explicit constructor export list) or instead
-- by sorting the avails with 'sortAvails'.
newtype DetOrdAvails = DefinitelyDeterministicAvails Avails
  deriving newtype (ReadBinHandle -> IO DetOrdAvails
WriteBinHandle -> DetOrdAvails -> IO ()
WriteBinHandle -> DetOrdAvails -> IO (Bin DetOrdAvails)
(WriteBinHandle -> DetOrdAvails -> IO ())
-> (WriteBinHandle -> DetOrdAvails -> IO (Bin DetOrdAvails))
-> (ReadBinHandle -> IO DetOrdAvails)
-> Binary DetOrdAvails
forall a.
(WriteBinHandle -> a -> IO ())
-> (WriteBinHandle -> a -> IO (Bin a))
-> (ReadBinHandle -> IO a)
-> Binary a
$cput_ :: WriteBinHandle -> DetOrdAvails -> IO ()
put_ :: WriteBinHandle -> DetOrdAvails -> IO ()
$cput :: WriteBinHandle -> DetOrdAvails -> IO (Bin DetOrdAvails)
put :: WriteBinHandle -> DetOrdAvails -> IO (Bin DetOrdAvails)
$cget :: ReadBinHandle -> IO DetOrdAvails
get :: ReadBinHandle -> IO DetOrdAvails
Binary, DetOrdAvails -> SDoc
(DetOrdAvails -> SDoc) -> Outputable DetOrdAvails
forall a. (a -> SDoc) -> Outputable a
$cppr :: DetOrdAvails -> SDoc
ppr :: DetOrdAvails -> SDoc
Outputable, DetOrdAvails -> ()
(DetOrdAvails -> ()) -> NFData DetOrdAvails
forall a. (a -> ()) -> NFData a
$crnf :: DetOrdAvails -> ()
rnf :: DetOrdAvails -> ()
NFData)

-- | It's always safe to match on 'DetOrdAvails'
pattern DetOrdAvails :: Avails -> DetOrdAvails
pattern $mDetOrdAvails :: forall {r}. DetOrdAvails -> (Avails -> r) -> ((# #) -> r) -> r
DetOrdAvails x <- DefinitelyDeterministicAvails x
{-# COMPLETE DetOrdAvails #-}

{- Note [Representing pattern synonym fields in AvailInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Record pattern synonym fields cannot be represented using AvailTC like fields of
normal record types, because they do not always have a parent type constructor.
So we represent them using the Avail constructor.

Thus under -XDuplicateRecordFields -XPatternSynoynms, the declaration

  pattern MkFoo{f} = Bar f

gives rise to the AvailInfo

  Avail MkFoo, Avail f

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 [ T, MkFoo, f ]
-}

-- | Compare lexicographically
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp (Avail Name
c1)     (Avail Name
c2)     = Name
c1 Name -> Name -> Ordering
`stableNameCmp` Name
c2
stableAvailCmp (Avail {})     (AvailTC {})   = Ordering
LT
stableAvailCmp (AvailTC Name
n [Name]
ns) (AvailTC Name
m [Name]
ms) = Name -> Name -> Ordering
stableNameCmp Name
n Name
m Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<> (Name -> Name -> Ordering) -> [Name] -> [Name] -> 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 Name -> Name -> Ordering
stableNameCmp [Name]
ns [Name]
ms
stableAvailCmp (AvailTC {})   (Avail {})     = Ordering
GT

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

availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet :: Avails -> NameSet
availsToNameSet Avails
avails = (AvailInfo -> NameSet -> NameSet) -> NameSet -> Avails -> 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 Avails
avails
      where add :: AvailInfo -> NameSet -> NameSet
add AvailInfo
avail NameSet
set = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
set (AvailInfo -> [Name]
availNames AvailInfo
avail)

availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv :: Avails -> NameEnv AvailInfo
availsToNameEnv Avails
avails = (AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo)
-> NameEnv AvailInfo -> Avails -> 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 Avails
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] -> Avails -> [(Name, AvailInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip (AvailInfo -> [Name]
availNames AvailInfo
avail) (AvailInfo -> Avails
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 [Name]
names)
  | Name
n : [Name]
_ <- [Name]
names = Name
ty_name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
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   Name
n)   = Name
n
availName (AvailTC Name
n [Name]
_) = Name
n

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

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

-- | Sort 'Avails'/'AvailInfo's
sortAvails :: Avails -> DetOrdAvails
sortAvails :: Avails -> DetOrdAvails
sortAvails = Avails -> DetOrdAvails
DefinitelyDeterministicAvails (Avails -> DetOrdAvails)
-> (Avails -> Avails) -> Avails -> DetOrdAvails
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AvailInfo -> AvailInfo -> Ordering) -> Avails -> Avails
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy AvailInfo -> AvailInfo -> Ordering
stableAvailCmp (Avails -> Avails) -> (Avails -> Avails) -> Avails -> Avails
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AvailInfo -> AvailInfo) -> Avails -> Avails
forall a b. (a -> b) -> [a] -> [b]
map AvailInfo -> AvailInfo
sort_subs
  where
    sort_subs :: AvailInfo -> AvailInfo
    sort_subs :: AvailInfo -> AvailInfo
sort_subs (Avail Name
n) = Name -> AvailInfo
Avail Name
n
    sort_subs (AvailTC Name
n []) = Name -> [Name] -> AvailInfo
AvailTC Name
n []
    sort_subs (AvailTC Name
n (Name
m:[Name]
ms))
       | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
m
       = Name -> [Name] -> AvailInfo
AvailTC Name
n (Name
mName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:(Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
stableNameCmp [Name]
ms)
       | Bool
otherwise
       = Name -> [Name] -> AvailInfo
AvailTC Name
n ((Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
stableNameCmp (Name
mName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ms))
       -- Maintain the AvailTC Invariant

-- -----------------------------------------------------------------------------
-- 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 (Name
s1:[Name]
ss1)) (AvailTC Name
n2 (Name
s2:[Name]
ss2))
  = case (Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
s1, Name
n2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
s2) of  -- Maintain invariant the parent is first
       (Bool
True,Bool
True)   -> Name -> [Name] -> AvailInfo
AvailTC Name
n1 (Name
s1 Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: ([Name]
ss1 [Name] -> [Name] -> [Name]
forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` [Name]
ss2))
       (Bool
True,Bool
False)  -> Name -> [Name] -> AvailInfo
AvailTC Name
n1 (Name
s1 Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: ([Name]
ss1 [Name] -> [Name] -> [Name]
forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` (Name
s2Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ss2)))
       (Bool
False,Bool
True)  -> Name -> [Name] -> AvailInfo
AvailTC Name
n1 (Name
s2 Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: ((Name
s1Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ss1) [Name] -> [Name] -> [Name]
forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` [Name]
ss2))
       (Bool
False,Bool
False) -> Name -> [Name] -> AvailInfo
AvailTC Name
n1 ((Name
s1Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ss1) [Name] -> [Name] -> [Name]
forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` (Name
s2Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
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 [Name]
ns) Name
m = case (Name -> Bool) -> [Name] -> Maybe Name
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]
ns of
    Just Name
c  -> Name -> [Name] -> AvailInfo
AvailTC Name
n [Name
c]
    Maybe Name
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) -> Avails -> Avails
filterAvails Name -> Bool
keep Avails
avails = (AvailInfo -> Avails -> Avails) -> Avails -> Avails -> Avails
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 -> Avails -> Avails
filterAvail Name -> Bool
keep) [] Avails
avails

-- | filters an 'AvailInfo' by the given predicate
filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail :: (Name -> Bool) -> AvailInfo -> Avails -> Avails
filterAvail Name -> Bool
keep AvailInfo
ie Avails
rest =
  case AvailInfo
ie of
    Avail Name
c | Name -> Bool
keep Name
c -> AvailInfo
ie AvailInfo -> Avails -> Avails
forall a. a -> [a] -> [a]
: Avails
rest
            | Bool
otherwise -> Avails
rest
    AvailTC Name
tc [Name]
cs ->
        let cs' :: [Name]
cs' = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
keep [Name]
cs
        in if [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
cs' then Avails
rest else Name -> [Name] -> AvailInfo
AvailTC Name
tc [Name]
cs' AvailInfo -> Avails -> Avails
forall a. a -> [a] -> [a]
: Avails
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; plusAvail does that
nubAvails :: [AvailInfo] -> [AvailInfo]
nubAvails :: Avails -> Avails
nubAvails Avails
avails = DNameEnv AvailInfo -> Avails
forall a. DNameEnv a -> [a]
eltsDNameEnv ((DNameEnv AvailInfo -> AvailInfo -> DNameEnv AvailInfo)
-> DNameEnv AvailInfo -> Avails -> 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 Avails
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 Name
n)
  = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
pprAvail (AvailTC Name
n [Name]
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 ((Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
ns)

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

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