{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable, Binary
{-# LANGUAGE TypeFamilies #-}

-- | Fixity
module GHC.Hs.Basic
   ( module Language.Haskell.Syntax.Basic
   , NamespaceSpecifier(..)
   , overlappingNamespaceSpecifiers
   , coveredByNamespaceSpecifier
   ) where

import GHC.Prelude

import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Types.Name
import GHC.Parser.Annotation
import GHC.Utils.Misc ((<||>))

import Data.Data (Data)

import Language.Haskell.Syntax.Basic

instance Outputable LexicalFixity where
  ppr :: LexicalFixity -> SDoc
ppr LexicalFixity
Prefix = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Prefix"
  ppr LexicalFixity
Infix  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Infix"

instance Outputable FixityDirection where
    ppr :: FixityDirection -> SDoc
ppr FixityDirection
InfixL = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"infixl"
    ppr FixityDirection
InfixR = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"infixr"
    ppr FixityDirection
InfixN = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"infix"

instance Outputable Fixity where
    ppr :: Fixity -> SDoc
ppr (Fixity Int
prec FixityDirection
dir) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [FixityDirection -> SDoc
forall a. Outputable a => a -> SDoc
ppr FixityDirection
dir, SDoc
forall doc. IsLine doc => doc
space, Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
prec]


instance Binary Fixity where
    put_ :: WriteBinHandle -> Fixity -> IO ()
put_ WriteBinHandle
bh (Fixity Int
aa FixityDirection
ab) = do
            WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
aa
            WriteBinHandle -> FixityDirection -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FixityDirection
ab
    get :: ReadBinHandle -> IO Fixity
get ReadBinHandle
bh = do
          aa <- ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
          ab <- get bh
          return (Fixity aa ab)

------------------------

instance Binary FixityDirection where
    put_ :: WriteBinHandle -> FixityDirection -> IO ()
put_ WriteBinHandle
bh FixityDirection
InfixL =
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh FixityDirection
InfixR =
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    put_ WriteBinHandle
bh FixityDirection
InfixN =
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
    get :: ReadBinHandle -> IO FixityDirection
get ReadBinHandle
bh = do
            h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case h of
              Word8
0 -> FixityDirection -> IO FixityDirection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FixityDirection
InfixL
              Word8
1 -> FixityDirection -> IO FixityDirection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FixityDirection
InfixR
              Word8
_ -> FixityDirection -> IO FixityDirection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FixityDirection
InfixN


-- | Optional namespace specifier for:
--
-- * import/export items
-- * fixity signatures
-- * @WARNING@ and @DEPRECATED@ pragmas
--
-- Examples:
--
-- @
-- module M (data ..) where
--        -- ↑ DataNamespaceSpecifier
--
-- import Data.Proxy as T (type ..)
--                      -- ↑ TypeNamespaceSpecifier
--
-- {-# WARNING in "x-partial" data Head "don't use this pattern synonym" #-}
--                          -- ↑ DataNamespaceSpecifier
--
-- {-# DEPRECATED type D "This type was deprecated" #-}
--              -- ↑ TypeNamespaceSpecifier
--
-- infixr 6 data $
--        -- ↑ DataNamespaceSpecifier
-- @
data NamespaceSpecifier
  = NoNamespaceSpecifier
  | TypeNamespaceSpecifier (EpToken "type")
  | DataNamespaceSpecifier (EpToken "data")
  deriving (NamespaceSpecifier -> NamespaceSpecifier -> Bool
(NamespaceSpecifier -> NamespaceSpecifier -> Bool)
-> (NamespaceSpecifier -> NamespaceSpecifier -> Bool)
-> Eq NamespaceSpecifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
== :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
$c/= :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
/= :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
Eq, Typeable NamespaceSpecifier
Typeable NamespaceSpecifier =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> NamespaceSpecifier
 -> c NamespaceSpecifier)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NamespaceSpecifier)
-> (NamespaceSpecifier -> Constr)
-> (NamespaceSpecifier -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NamespaceSpecifier))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c NamespaceSpecifier))
-> ((forall b. Data b => b -> b)
    -> NamespaceSpecifier -> NamespaceSpecifier)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NamespaceSpecifier -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NamespaceSpecifier -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> NamespaceSpecifier -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NamespaceSpecifier -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> NamespaceSpecifier -> m NamespaceSpecifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> NamespaceSpecifier -> m NamespaceSpecifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> NamespaceSpecifier -> m NamespaceSpecifier)
-> Data NamespaceSpecifier
NamespaceSpecifier -> Constr
NamespaceSpecifier -> DataType
(forall b. Data b => b -> b)
-> NamespaceSpecifier -> NamespaceSpecifier
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) -> NamespaceSpecifier -> u
forall u. (forall d. Data d => d -> u) -> NamespaceSpecifier -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NamespaceSpecifier -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NamespaceSpecifier -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NamespaceSpecifier -> m NamespaceSpecifier
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NamespaceSpecifier -> m NamespaceSpecifier
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NamespaceSpecifier
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> NamespaceSpecifier
-> c NamespaceSpecifier
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NamespaceSpecifier)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NamespaceSpecifier)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> NamespaceSpecifier
-> c NamespaceSpecifier
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> NamespaceSpecifier
-> c NamespaceSpecifier
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NamespaceSpecifier
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NamespaceSpecifier
$ctoConstr :: NamespaceSpecifier -> Constr
toConstr :: NamespaceSpecifier -> Constr
$cdataTypeOf :: NamespaceSpecifier -> DataType
dataTypeOf :: NamespaceSpecifier -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NamespaceSpecifier)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NamespaceSpecifier)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NamespaceSpecifier)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NamespaceSpecifier)
$cgmapT :: (forall b. Data b => b -> b)
-> NamespaceSpecifier -> NamespaceSpecifier
gmapT :: (forall b. Data b => b -> b)
-> NamespaceSpecifier -> NamespaceSpecifier
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NamespaceSpecifier -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NamespaceSpecifier -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NamespaceSpecifier -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NamespaceSpecifier -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NamespaceSpecifier -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NamespaceSpecifier -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> NamespaceSpecifier -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> NamespaceSpecifier -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NamespaceSpecifier -> m NamespaceSpecifier
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NamespaceSpecifier -> m NamespaceSpecifier
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NamespaceSpecifier -> m NamespaceSpecifier
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NamespaceSpecifier -> m NamespaceSpecifier
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NamespaceSpecifier -> m NamespaceSpecifier
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NamespaceSpecifier -> m NamespaceSpecifier
Data)

-- | Check if namespace specifiers overlap, i.e. if they are equal or
-- if at least one of them doesn't specify a namespace
overlappingNamespaceSpecifiers :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
overlappingNamespaceSpecifiers :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
overlappingNamespaceSpecifiers NamespaceSpecifier
NoNamespaceSpecifier NamespaceSpecifier
_ = Bool
True
overlappingNamespaceSpecifiers NamespaceSpecifier
_ NamespaceSpecifier
NoNamespaceSpecifier = Bool
True
overlappingNamespaceSpecifiers TypeNamespaceSpecifier{} TypeNamespaceSpecifier{} = Bool
True
overlappingNamespaceSpecifiers DataNamespaceSpecifier{} DataNamespaceSpecifier{} = Bool
True
overlappingNamespaceSpecifiers NamespaceSpecifier
_ NamespaceSpecifier
_ = Bool
False

-- | Check if namespace is covered by a namespace specifier:
--     * NoNamespaceSpecifier covers both namespaces
--     * TypeNamespaceSpecifier covers the type namespace only
--     * DataNamespaceSpecifier covers the data namespace only
coveredByNamespaceSpecifier :: NamespaceSpecifier -> NameSpace -> Bool
coveredByNamespaceSpecifier :: NamespaceSpecifier -> NameSpace -> Bool
coveredByNamespaceSpecifier NamespaceSpecifier
NoNamespaceSpecifier = Bool -> NameSpace -> Bool
forall a b. a -> b -> a
const Bool
True
coveredByNamespaceSpecifier TypeNamespaceSpecifier{} = NameSpace -> Bool
isTcClsNameSpace (NameSpace -> Bool) -> (NameSpace -> Bool) -> NameSpace -> Bool
forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
<||> NameSpace -> Bool
isTvNameSpace
coveredByNamespaceSpecifier DataNamespaceSpecifier{} = NameSpace -> Bool
isValNameSpace

instance Outputable NamespaceSpecifier where
  ppr :: NamespaceSpecifier -> SDoc
ppr NamespaceSpecifier
NoNamespaceSpecifier = SDoc
forall doc. IsOutput doc => doc
empty
  ppr TypeNamespaceSpecifier{} = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type"
  ppr DataNamespaceSpecifier{} = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"data"