{-# OPTIONS_HADDOCK not-home #-} -- we want users to import Language.Haskell.TH.Syntax instead
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnboxedTuples #-}

-- | This module is used internally in GHC's integration with Template Haskell
-- and defines the abstract syntax of Template Haskell.
--
-- This is not a part of the public API, and as such, there are no API
-- guarantees for this module from version to version.
--
-- Import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!
module GHC.Internal.TH.Syntax
    ( module GHC.Internal.TH.Syntax
      -- * Language extensions
    , module GHC.Internal.LanguageExtensions
    , ForeignSrcLang(..)
    ) where

#ifdef BOOTSTRAP_TH
import Prelude
import System.IO.Unsafe ( unsafePerformIO )
import Data.Char        ( isAlpha, isAlphaNum, isUpper )
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Word
import Foreign.ForeignPtr
import Foreign.C.String
import Foreign.C.Types
import GHC.Ptr          ( Ptr, plusPtr )
import GHC.Generics     ( Generic )
#else
import GHC.Internal.Base hiding (NonEmpty(..),Type, Module, sequence)
import GHC.Internal.Data.NonEmpty (NonEmpty(..))
import GHC.Internal.Data.Traversable
import GHC.Internal.Word
import GHC.Internal.Generics (Generic)
import GHC.Internal.Show
import GHC.Internal.Integer
import GHC.Internal.Real
import GHC.Internal.Data.Foldable
import GHC.Internal.Foreign.Ptr
import GHC.Internal.ForeignPtr
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Foreign.C.String
import GHC.Internal.Num
import GHC.Internal.IO.Unsafe
import GHC.Internal.List (dropWhile, break, replicate, reverse, last)
import GHC.Internal.Unicode
#endif
import GHC.Internal.ForeignSrcLang
import GHC.Internal.LanguageExtensions

oneName, manyName :: Name
-- | Synonym for @''GHC.Internal.Types.One'@, from @ghc-internal@.
oneName :: Name
oneName  = NameSpace -> String -> String -> String -> Name
mkNameG NameSpace
DataName String
"ghc-internal" String
"GHC.Internal.Types" String
"One"
-- | Synonym for @''GHC.Internal.Types.Many'@, from @ghc-internal@.
manyName :: Name
manyName = NameSpace -> String -> String -> String -> Name
mkNameG NameSpace
DataName String
"ghc-internal" String
"GHC.Internal.Types" String
"Many"


-----------------------------------------------------
--              Names and uniques
-----------------------------------------------------

-- | The name of a module.
newtype ModName = ModName String        -- Module name
 deriving (Int -> ModName -> ShowS
[ModName] -> ShowS
ModName -> String
(Int -> ModName -> ShowS)
-> (ModName -> String) -> ([ModName] -> ShowS) -> Show ModName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModName -> ShowS
showsPrec :: Int -> ModName -> ShowS
$cshow :: ModName -> String
show :: ModName -> String
$cshowList :: [ModName] -> ShowS
showList :: [ModName] -> ShowS
Show,ModName -> ModName -> Bool
(ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool) -> Eq ModName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModName -> ModName -> Bool
== :: ModName -> ModName -> Bool
$c/= :: ModName -> ModName -> Bool
/= :: ModName -> ModName -> Bool
Eq,Eq ModName
Eq ModName =>
(ModName -> ModName -> Ordering)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> ModName)
-> (ModName -> ModName -> ModName)
-> Ord ModName
ModName -> ModName -> Bool
ModName -> ModName -> Ordering
ModName -> ModName -> ModName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModName -> ModName -> Ordering
compare :: ModName -> ModName -> Ordering
$c< :: ModName -> ModName -> Bool
< :: ModName -> ModName -> Bool
$c<= :: ModName -> ModName -> Bool
<= :: ModName -> ModName -> Bool
$c> :: ModName -> ModName -> Bool
> :: ModName -> ModName -> Bool
$c>= :: ModName -> ModName -> Bool
>= :: ModName -> ModName -> Bool
$cmax :: ModName -> ModName -> ModName
max :: ModName -> ModName -> ModName
$cmin :: ModName -> ModName -> ModName
min :: ModName -> ModName -> ModName
Ord,(forall x. ModName -> Rep ModName x)
-> (forall x. Rep ModName x -> ModName) -> Generic ModName
forall x. Rep ModName x -> ModName
forall x. ModName -> Rep ModName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModName -> Rep ModName x
from :: forall x. ModName -> Rep ModName x
$cto :: forall x. Rep ModName x -> ModName
to :: forall x. Rep ModName x -> ModName
Generic)

-- | The name of a package.
newtype PkgName = PkgName String        -- package name
 deriving (Int -> PkgName -> ShowS
[PkgName] -> ShowS
PkgName -> String
(Int -> PkgName -> ShowS)
-> (PkgName -> String) -> ([PkgName] -> ShowS) -> Show PkgName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkgName -> ShowS
showsPrec :: Int -> PkgName -> ShowS
$cshow :: PkgName -> String
show :: PkgName -> String
$cshowList :: [PkgName] -> ShowS
showList :: [PkgName] -> ShowS
Show,PkgName -> PkgName -> Bool
(PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool) -> Eq PkgName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PkgName -> PkgName -> Bool
== :: PkgName -> PkgName -> Bool
$c/= :: PkgName -> PkgName -> Bool
/= :: PkgName -> PkgName -> Bool
Eq,Eq PkgName
Eq PkgName =>
(PkgName -> PkgName -> Ordering)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> PkgName)
-> (PkgName -> PkgName -> PkgName)
-> Ord PkgName
PkgName -> PkgName -> Bool
PkgName -> PkgName -> Ordering
PkgName -> PkgName -> PkgName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PkgName -> PkgName -> Ordering
compare :: PkgName -> PkgName -> Ordering
$c< :: PkgName -> PkgName -> Bool
< :: PkgName -> PkgName -> Bool
$c<= :: PkgName -> PkgName -> Bool
<= :: PkgName -> PkgName -> Bool
$c> :: PkgName -> PkgName -> Bool
> :: PkgName -> PkgName -> Bool
$c>= :: PkgName -> PkgName -> Bool
>= :: PkgName -> PkgName -> Bool
$cmax :: PkgName -> PkgName -> PkgName
max :: PkgName -> PkgName -> PkgName
$cmin :: PkgName -> PkgName -> PkgName
min :: PkgName -> PkgName -> PkgName
Ord,(forall x. PkgName -> Rep PkgName x)
-> (forall x. Rep PkgName x -> PkgName) -> Generic PkgName
forall x. Rep PkgName x -> PkgName
forall x. PkgName -> Rep PkgName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PkgName -> Rep PkgName x
from :: forall x. PkgName -> Rep PkgName x
$cto :: forall x. Rep PkgName x -> PkgName
to :: forall x. Rep PkgName x -> PkgName
Generic)

-- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'.
data Module = Module PkgName ModName -- package qualified module name
 deriving (Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
(Int -> Module -> ShowS)
-> (Module -> String) -> ([Module] -> ShowS) -> Show Module
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Module -> ShowS
showsPrec :: Int -> Module -> ShowS
$cshow :: Module -> String
show :: Module -> String
$cshowList :: [Module] -> ShowS
showList :: [Module] -> ShowS
Show,Module -> Module -> Bool
(Module -> Module -> Bool)
-> (Module -> Module -> Bool) -> Eq Module
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
/= :: Module -> Module -> Bool
Eq,Eq Module
Eq Module =>
(Module -> Module -> Ordering)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Module)
-> (Module -> Module -> Module)
-> Ord Module
Module -> Module -> Bool
Module -> Module -> Ordering
Module -> Module -> Module
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Module -> Module -> Ordering
compare :: Module -> Module -> Ordering
$c< :: Module -> Module -> Bool
< :: Module -> Module -> Bool
$c<= :: Module -> Module -> Bool
<= :: Module -> Module -> Bool
$c> :: Module -> Module -> Bool
> :: Module -> Module -> Bool
$c>= :: Module -> Module -> Bool
>= :: Module -> Module -> Bool
$cmax :: Module -> Module -> Module
max :: Module -> Module -> Module
$cmin :: Module -> Module -> Module
min :: Module -> Module -> Module
Ord,(forall x. Module -> Rep Module x)
-> (forall x. Rep Module x -> Module) -> Generic Module
forall x. Rep Module x -> Module
forall x. Module -> Rep Module x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Module -> Rep Module x
from :: forall x. Module -> Rep Module x
$cto :: forall x. Rep Module x -> Module
to :: forall x. Rep Module x -> Module
Generic)

-- | An "Occurence Name".
newtype OccName = OccName String
 deriving (Int -> OccName -> ShowS
[OccName] -> ShowS
OccName -> String
(Int -> OccName -> ShowS)
-> (OccName -> String) -> ([OccName] -> ShowS) -> Show OccName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OccName -> ShowS
showsPrec :: Int -> OccName -> ShowS
$cshow :: OccName -> String
show :: OccName -> String
$cshowList :: [OccName] -> ShowS
showList :: [OccName] -> ShowS
Show,OccName -> OccName -> Bool
(OccName -> OccName -> Bool)
-> (OccName -> OccName -> Bool) -> Eq OccName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OccName -> OccName -> Bool
== :: OccName -> OccName -> Bool
$c/= :: OccName -> OccName -> Bool
/= :: OccName -> OccName -> Bool
Eq,Eq OccName
Eq OccName =>
(OccName -> OccName -> Ordering)
-> (OccName -> OccName -> Bool)
-> (OccName -> OccName -> Bool)
-> (OccName -> OccName -> Bool)
-> (OccName -> OccName -> Bool)
-> (OccName -> OccName -> OccName)
-> (OccName -> OccName -> OccName)
-> Ord OccName
OccName -> OccName -> Bool
OccName -> OccName -> Ordering
OccName -> OccName -> OccName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OccName -> OccName -> Ordering
compare :: OccName -> OccName -> Ordering
$c< :: OccName -> OccName -> Bool
< :: OccName -> OccName -> Bool
$c<= :: OccName -> OccName -> Bool
<= :: OccName -> OccName -> Bool
$c> :: OccName -> OccName -> Bool
> :: OccName -> OccName -> Bool
$c>= :: OccName -> OccName -> Bool
>= :: OccName -> OccName -> Bool
$cmax :: OccName -> OccName -> OccName
max :: OccName -> OccName -> OccName
$cmin :: OccName -> OccName -> OccName
min :: OccName -> OccName -> OccName
Ord,(forall x. OccName -> Rep OccName x)
-> (forall x. Rep OccName x -> OccName) -> Generic OccName
forall x. Rep OccName x -> OccName
forall x. OccName -> Rep OccName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OccName -> Rep OccName x
from :: forall x. OccName -> Rep OccName x
$cto :: forall x. Rep OccName x -> OccName
to :: forall x. Rep OccName x -> OccName
Generic)

-- | Smart constructor for 'ModName'
mkModName :: String -> ModName
mkModName :: String -> ModName
mkModName String
s = String -> ModName
ModName String
s

-- | Accessor for 'ModName'
modString :: ModName -> String
modString :: ModName -> String
modString (ModName String
m) = String
m

-- | Smart constructor for 'PkgName'
mkPkgName :: String -> PkgName
mkPkgName :: String -> PkgName
mkPkgName String
s = String -> PkgName
PkgName String
s

-- | Accessor for 'PkgName'
pkgString :: PkgName -> String
pkgString :: PkgName -> String
pkgString (PkgName String
m) = String
m


-----------------------------------------------------
--              OccName
-----------------------------------------------------

-- | Smart constructor for 'OccName'
mkOccName :: String -> OccName
mkOccName :: String -> OccName
mkOccName String
s = String -> OccName
OccName String
s

-- | Accessor for 'OccName'
occString :: OccName -> String
occString :: OccName -> String
occString (OccName String
occ) = String
occ


-----------------------------------------------------
--               Names
-----------------------------------------------------
--
-- For "global" names ('NameG') we need a totally unique name,
-- so we must include the name-space of the thing
--
-- For unique-numbered things ('NameU'), we've got a unique reference
-- anyway, so no need for name space
--
-- For dynamically bound thing ('NameS') we probably want them to
-- in a context-dependent way, so again we don't want the name
-- space.  For example:
--
-- > let v = mkName "T" in [| data $v = $v |]
--
-- Here we use the same Name for both type constructor and data constructor
--
--
-- NameL and NameG are bound *outside* the TH syntax tree
-- either globally (NameG) or locally (NameL). Ex:
--
-- > f x = $(h [| (map, x) |])
--
-- The 'map' will be a NameG, and 'x' wil be a NameL
--
-- These Names should never appear in a binding position in a TH syntax tree

{- $namecapture #namecapture#
Much of 'Name' API is concerned with the problem of /name capture/, which
can be seen in the following example.

> f expr = [| let x = 0 in $expr |]
> ...
> g x = $( f [| x |] )
> h y = $( f [| y |] )

A naive desugaring of this would yield:

> g x = let x = 0 in x
> h y = let x = 0 in y

All of a sudden, @g@ and @h@ have different meanings! In this case,
we say that the @x@ in the RHS of @g@ has been /captured/
by the binding of @x@ in @f@.

What we actually want is for the @x@ in @f@ to be distinct from the
@x@ in @g@, so we get the following desugaring:

> g x = let x' = 0 in x
> h y = let x' = 0 in y

which avoids name capture as desired.

In the general case, we say that a @Name@ can be captured if
the thing it refers to can be changed by adding new declarations.
-}

{- |
An abstract type representing names in the syntax tree.

'Name's can be constructed in several ways, which come with different
name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for
an explanation of name capture):

  * the built-in syntax @'f@ and @''T@ can be used to construct names,
    The expression @'f@ gives a @Name@ which refers to the value @f@
    currently in scope, and @''T@ gives a @Name@ which refers to the
    type @T@ currently in scope. These names can never be captured.

  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and
     @''T@ respectively, but the @Name@s are looked up at the point
     where the current splice is being run. These names can never be
     captured.

  * 'newName' monadically generates a new name, which can never
     be captured.

  * 'mkName' generates a capturable name.

Names constructed using @newName@ and @mkName@ may be used in bindings
(such as @let x = ...@ or @\x -> ...@), but names constructed using
@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.
-}
data Name = Name OccName NameFlavour deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, (forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Name -> Rep Name x
from :: forall x. Name -> Rep Name x
$cto :: forall x. Rep Name x -> Name
to :: forall x. Rep Name x -> Name
Generic)

instance Ord Name where
    -- check if unique is different before looking at strings
  (Name OccName
o1 NameFlavour
f1) compare :: Name -> Name -> Ordering
`compare` (Name OccName
o2 NameFlavour
f2) = (NameFlavour
f1 NameFlavour -> NameFlavour -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` NameFlavour
f2)   Ordering -> Ordering -> Ordering
`thenCmp`
                                        (OccName
o1 OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` OccName
o2)

data NameFlavour
  = NameS           -- ^ An unqualified name; dynamically bound
  | NameQ ModName   -- ^ A qualified name; dynamically bound
  | NameU !Uniq     -- ^ A unique local name
  | NameL !Uniq     -- ^ Local name bound outside of the TH AST
  | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:
                -- An original name (occurrences only, not binders)
                -- Need the namespace too to be sure which
                -- thing we are naming
  deriving ( NameFlavour -> NameFlavour -> Bool
(NameFlavour -> NameFlavour -> Bool)
-> (NameFlavour -> NameFlavour -> Bool) -> Eq NameFlavour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameFlavour -> NameFlavour -> Bool
== :: NameFlavour -> NameFlavour -> Bool
$c/= :: NameFlavour -> NameFlavour -> Bool
/= :: NameFlavour -> NameFlavour -> Bool
Eq, Eq NameFlavour
Eq NameFlavour =>
(NameFlavour -> NameFlavour -> Ordering)
-> (NameFlavour -> NameFlavour -> Bool)
-> (NameFlavour -> NameFlavour -> Bool)
-> (NameFlavour -> NameFlavour -> Bool)
-> (NameFlavour -> NameFlavour -> Bool)
-> (NameFlavour -> NameFlavour -> NameFlavour)
-> (NameFlavour -> NameFlavour -> NameFlavour)
-> Ord NameFlavour
NameFlavour -> NameFlavour -> Bool
NameFlavour -> NameFlavour -> Ordering
NameFlavour -> NameFlavour -> NameFlavour
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NameFlavour -> NameFlavour -> Ordering
compare :: NameFlavour -> NameFlavour -> Ordering
$c< :: NameFlavour -> NameFlavour -> Bool
< :: NameFlavour -> NameFlavour -> Bool
$c<= :: NameFlavour -> NameFlavour -> Bool
<= :: NameFlavour -> NameFlavour -> Bool
$c> :: NameFlavour -> NameFlavour -> Bool
> :: NameFlavour -> NameFlavour -> Bool
$c>= :: NameFlavour -> NameFlavour -> Bool
>= :: NameFlavour -> NameFlavour -> Bool
$cmax :: NameFlavour -> NameFlavour -> NameFlavour
max :: NameFlavour -> NameFlavour -> NameFlavour
$cmin :: NameFlavour -> NameFlavour -> NameFlavour
min :: NameFlavour -> NameFlavour -> NameFlavour
Ord, Int -> NameFlavour -> ShowS
[NameFlavour] -> ShowS
NameFlavour -> String
(Int -> NameFlavour -> ShowS)
-> (NameFlavour -> String)
-> ([NameFlavour] -> ShowS)
-> Show NameFlavour
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameFlavour -> ShowS
showsPrec :: Int -> NameFlavour -> ShowS
$cshow :: NameFlavour -> String
show :: NameFlavour -> String
$cshowList :: [NameFlavour] -> ShowS
showList :: [NameFlavour] -> ShowS
Show, (forall x. NameFlavour -> Rep NameFlavour x)
-> (forall x. Rep NameFlavour x -> NameFlavour)
-> Generic NameFlavour
forall x. Rep NameFlavour x -> NameFlavour
forall x. NameFlavour -> Rep NameFlavour x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameFlavour -> Rep NameFlavour x
from :: forall x. NameFlavour -> Rep NameFlavour x
$cto :: forall x. Rep NameFlavour x -> NameFlavour
to :: forall x. Rep NameFlavour x -> NameFlavour
Generic )

data NameSpace = VarName        -- ^ Variables
               | DataName       -- ^ Data constructors
               | TcClsName      -- ^ Type constructors and classes; Haskell has them
                                -- in the same name space for now.
               | FldName
                 { NameSpace -> String
fldParent :: !String
                   -- ^ The textual name of the parent of the field.
                   --
                   --   - For a field of a datatype, this is the name of the first constructor
                   --     of the datatype (regardless of whether this constructor has this field).
                   --   - For a field of a pattern synonym, this is the name of the pattern synonym.
                 }
               deriving( NameSpace -> NameSpace -> Bool
(NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool) -> Eq NameSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameSpace -> NameSpace -> Bool
== :: NameSpace -> NameSpace -> Bool
$c/= :: NameSpace -> NameSpace -> Bool
/= :: NameSpace -> NameSpace -> Bool
Eq, Eq NameSpace
Eq NameSpace =>
(NameSpace -> NameSpace -> Ordering)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> NameSpace)
-> (NameSpace -> NameSpace -> NameSpace)
-> Ord NameSpace
NameSpace -> NameSpace -> Bool
NameSpace -> NameSpace -> Ordering
NameSpace -> NameSpace -> NameSpace
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NameSpace -> NameSpace -> Ordering
compare :: NameSpace -> NameSpace -> Ordering
$c< :: NameSpace -> NameSpace -> Bool
< :: NameSpace -> NameSpace -> Bool
$c<= :: NameSpace -> NameSpace -> Bool
<= :: NameSpace -> NameSpace -> Bool
$c> :: NameSpace -> NameSpace -> Bool
> :: NameSpace -> NameSpace -> Bool
$c>= :: NameSpace -> NameSpace -> Bool
>= :: NameSpace -> NameSpace -> Bool
$cmax :: NameSpace -> NameSpace -> NameSpace
max :: NameSpace -> NameSpace -> NameSpace
$cmin :: NameSpace -> NameSpace -> NameSpace
min :: NameSpace -> NameSpace -> NameSpace
Ord, Int -> NameSpace -> ShowS
[NameSpace] -> ShowS
NameSpace -> String
(Int -> NameSpace -> ShowS)
-> (NameSpace -> String)
-> ([NameSpace] -> ShowS)
-> Show NameSpace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameSpace -> ShowS
showsPrec :: Int -> NameSpace -> ShowS
$cshow :: NameSpace -> String
show :: NameSpace -> String
$cshowList :: [NameSpace] -> ShowS
showList :: [NameSpace] -> ShowS
Show, (forall x. NameSpace -> Rep NameSpace x)
-> (forall x. Rep NameSpace x -> NameSpace) -> Generic NameSpace
forall x. Rep NameSpace x -> NameSpace
forall x. NameSpace -> Rep NameSpace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameSpace -> Rep NameSpace x
from :: forall x. NameSpace -> Rep NameSpace x
$cto :: forall x. Rep NameSpace x -> NameSpace
to :: forall x. Rep NameSpace x -> NameSpace
Generic )

-- | @Uniq@ is used by GHC to distinguish names from each other.
type Uniq = Integer

-- | The name without its module prefix.
--
-- ==== __Examples__
--
-- >>> nameBase ''Data.Either.Either
-- "Either"
-- >>> nameBase (mkName "foo")
-- "foo"
-- >>> nameBase (mkName "Module.foo")
-- "foo"
nameBase :: Name -> String
nameBase :: Name -> String
nameBase (Name OccName
occ NameFlavour
_) = OccName -> String
occString OccName
occ

-- | Module prefix of a name, if it exists.
--
-- ==== __Examples__
--
-- >>> nameModule ''Data.Either.Either
-- Just "Data.Either"
-- >>> nameModule (mkName "foo")
-- Nothing
-- >>> nameModule (mkName "Module.foo")
-- Just "Module"
nameModule :: Name -> Maybe String
nameModule :: Name -> Maybe String
nameModule (Name OccName
_ (NameQ ModName
m))     = String -> Maybe String
forall a. a -> Maybe a
Just (ModName -> String
modString ModName
m)
nameModule (Name OccName
_ (NameG NameSpace
_ PkgName
_ ModName
m)) = String -> Maybe String
forall a. a -> Maybe a
Just (ModName -> String
modString ModName
m)
nameModule Name
_                      = Maybe String
forall a. Maybe a
Nothing

-- | A name's package, if it exists.
--
-- ==== __Examples__
--
-- >>> namePackage ''Data.Either.Either
-- Just "base"
-- >>> namePackage (mkName "foo")
-- Nothing
-- >>> namePackage (mkName "Module.foo")
-- Nothing
namePackage :: Name -> Maybe String
namePackage :: Name -> Maybe String
namePackage (Name OccName
_ (NameG NameSpace
_ PkgName
p ModName
_)) = String -> Maybe String
forall a. a -> Maybe a
Just (PkgName -> String
pkgString PkgName
p)
namePackage Name
_                      = Maybe String
forall a. Maybe a
Nothing

-- | Returns whether a name represents an occurrence of a top-level variable
-- ('VarName'), data constructor ('DataName'), type constructor, or type class
-- ('TcClsName'). If we can't be sure, it returns 'Nothing'.
--
-- ==== __Examples__
--
-- >>> nameSpace 'Prelude.id
-- Just VarName
-- >>> nameSpace (mkName "id")
-- Nothing -- only works for top-level variable names
-- >>> nameSpace 'Data.Maybe.Just
-- Just DataName
-- >>> nameSpace ''Data.Maybe.Maybe
-- Just TcClsName
-- >>> nameSpace ''Data.Ord.Ord
-- Just TcClsName
nameSpace :: Name -> Maybe NameSpace
nameSpace :: Name -> Maybe NameSpace
nameSpace (Name OccName
_ (NameG NameSpace
ns PkgName
_ ModName
_)) = NameSpace -> Maybe NameSpace
forall a. a -> Maybe a
Just NameSpace
ns
nameSpace Name
_                       = Maybe NameSpace
forall a. Maybe a
Nothing

{- |
Generate a capturable name. Occurrences of such names will be
resolved according to the Haskell scoping rules at the occurrence
site.

For example:

> f = [| pi + $(varE (mkName "pi")) |]
> ...
> g = let pi = 3 in $f

In this case, @g@ is desugared to

> g = Prelude.pi + 3

Note that @mkName@ may be used with qualified names:

> mkName "Prelude.pi"

See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could
be rewritten using 'Language.Haskell.TH.Lib.dyn' as

> f = [| pi + $(dyn "pi") |]
-}
mkName :: String -> Name
-- The string can have a '.', thus "Foo.baz",
-- giving a dynamically-bound qualified name,
-- in which case we want to generate a NameQ
--
-- Parse the string to see if it has a "." in it
-- so we know whether to generate a qualified or unqualified name
-- It's a bit tricky because we need to parse
--
-- > Foo.Baz.x   as    Qual Foo.Baz x
--
-- So we parse it from back to front
mkName :: String -> Name
mkName String
str
  = String -> String -> Name
split [] (ShowS
forall a. [a] -> [a]
reverse String
str)
  where
    split :: String -> String -> Name
split String
occ []        = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
occ) NameFlavour
NameS
    split String
occ (Char
'.':String
rev) | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
occ)
                        , String -> Bool
is_rev_mod_name String
rev
                        = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
occ) (ModName -> NameFlavour
NameQ (String -> ModName
mkModName (ShowS
forall a. [a] -> [a]
reverse String
rev)))
        -- The 'not (null occ)' guard ensures that
        --      mkName "&." = Name "&." NameS
        -- The 'is_rev_mod' guards ensure that
        --      mkName ".&" = Name ".&" NameS
        --      mkName "^.." = Name "^.." NameS      -- #8633
        --      mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
        -- This rather bizarre case actually happened; (.&.) is in Data.Bits
    split String
occ (Char
c:String
rev)   = String -> String -> Name
split (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
occ) String
rev

    -- Recognises a reversed module name xA.yB.C,
    -- with at least one component,
    -- and each component looks like a module name
    --   (i.e. non-empty, starts with capital, all alpha)
    is_rev_mod_name :: String -> Bool
is_rev_mod_name String
rev_mod_str
      | (String
compt, String
rest) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
rev_mod_str
      , Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
compt), Char -> Bool
isUpper (String -> Char
forall a. HasCallStack => [a] -> a
last String
compt), (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
is_mod_char String
compt
      = case String
rest of
          []             -> Bool
True
          (Char
_dot : String
rest') -> String -> Bool
is_rev_mod_name String
rest'
      | Bool
otherwise
      = Bool
False

    is_mod_char :: Char -> Bool
is_mod_char Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''

-- | Only used internally
mkNameU :: String -> Uniq -> Name
mkNameU :: String -> Integer -> Name
mkNameU String
s Integer
u = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
s) (Integer -> NameFlavour
NameU Integer
u)

-- | Only used internally
mkNameL :: String -> Uniq -> Name
mkNameL :: String -> Integer -> Name
mkNameL String
s Integer
u = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
s) (Integer -> NameFlavour
NameL Integer
u)

-- | Only used internally
mkNameQ :: String -> String -> Name
mkNameQ :: String -> String -> Name
mkNameQ String
mn String
occ = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
occ) (ModName -> NameFlavour
NameQ (String -> ModName
mkModName String
mn))

-- | Used for 'x etc, but not available to the programmer
mkNameG :: NameSpace -> String -> String -> String -> Name
mkNameG :: NameSpace -> String -> String -> String -> Name
mkNameG NameSpace
ns String
pkg String
modu String
occ
  = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
occ) (NameSpace -> PkgName -> ModName -> NameFlavour
NameG NameSpace
ns (String -> PkgName
mkPkgName String
pkg) (String -> ModName
mkModName String
modu))

mkNameS :: String -> Name
mkNameS :: String -> Name
mkNameS String
n = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
n) NameFlavour
NameS

mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
mkNameG_v :: String -> String -> String -> Name
mkNameG_v  = NameSpace -> String -> String -> String -> Name
mkNameG NameSpace
VarName
mkNameG_tc :: String -> String -> String -> Name
mkNameG_tc = NameSpace -> String -> String -> String -> Name
mkNameG NameSpace
TcClsName
mkNameG_d :: String -> String -> String -> Name
mkNameG_d  = NameSpace -> String -> String -> String -> Name
mkNameG NameSpace
DataName

mkNameG_fld :: String -- ^ package
            -> String -- ^ module
            -> String -- ^ parent (first constructor of parent type)
            -> String -- ^ field name
            -> Name
mkNameG_fld :: String -> String -> String -> String -> Name
mkNameG_fld String
pkg String
modu String
con String
occ = NameSpace -> String -> String -> String -> Name
mkNameG (String -> NameSpace
FldName String
con) String
pkg String
modu String
occ

data NameIs = Alone    -- ^ @name@
            | Applied  -- ^ @(name)@
            | Infix    -- ^ @\`name\`@

showName :: Name -> String
showName :: Name -> String
showName = NameIs -> Name -> String
showName' NameIs
Alone

showName' :: NameIs -> Name -> String
showName' :: NameIs -> Name -> String
showName' NameIs
ni Name
nm
 = case NameIs
ni of
       NameIs
Alone        -> String
nms
       NameIs
Applied
        | Bool
pnam      -> String
nms
        | Bool
otherwise -> String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nms String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
       NameIs
Infix
        | Bool
pnam      -> String
"`" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nms String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"`"
        | Bool
otherwise -> String
nms
    where
        -- For now, we make the NameQ and NameG print the same, even though
        -- NameQ is a qualified name (so what it means depends on what the
        -- current scope is), and NameG is an original name (so its meaning
        -- should be independent of what's in scope.
        -- We may well want to distinguish them in the end.
        -- Ditto NameU and NameL
        nms :: String
nms = case Name
nm of
          Name OccName
occ NameFlavour
NameS          -> OccName -> String
occString OccName
occ
          Name OccName
occ (NameQ ModName
m)      -> ModName -> String
modString ModName
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ OccName -> String
occString OccName
occ
          Name OccName
occ (NameG NameSpace
_ PkgName
_ ModName
m) -> ModName -> String
modString ModName
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ OccName -> String
occString OccName
occ
          Name OccName
occ (NameU Integer
u)      -> OccName -> String
occString OccName
occ String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
u
          Name OccName
occ (NameL Integer
u)      -> OccName -> String
occString OccName
occ String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
u

        pnam :: Bool
pnam = String -> Bool
classify String
nms

        -- True if we are function style, e.g. f, [], (,)
        -- False if we are operator style, e.g. +, :+
        classify :: String -> Bool
classify String
"" = Bool
False -- shouldn't happen; . operator is handled below
        classify (Char
x:String
xs) | Char -> Bool
isAlpha Char
x Bool -> Bool -> Bool
|| (Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"_[]()") =
                            case (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'.') String
xs of
                                  (Char
_:String
xs') -> String -> Bool
classify String
xs'
                                  []      -> Bool
True
                        | Bool
otherwise = Bool
False

instance Show Name where
  show :: Name -> String
show = Name -> String
showName

-- Tuple data and type constructors
-- | Tuple data constructor
tupleDataName :: Int -> Name
-- | Tuple type constructor
tupleTypeName :: Int -> Name

tupleDataName :: Int -> Name
tupleDataName Int
n = Int -> NameSpace -> Bool -> Name
mk_tup_name Int
n NameSpace
DataName  Bool
True
tupleTypeName :: Int -> Name
tupleTypeName Int
n = Int -> NameSpace -> Bool -> Name
mk_tup_name Int
n NameSpace
TcClsName Bool
True

-- Unboxed tuple data and type constructors
-- | Unboxed tuple data constructor
unboxedTupleDataName :: Int -> Name
-- | Unboxed tuple type constructor
unboxedTupleTypeName :: Int -> Name

unboxedTupleDataName :: Int -> Name
unboxedTupleDataName Int
n = Int -> NameSpace -> Bool -> Name
mk_tup_name Int
n NameSpace
DataName  Bool
False
unboxedTupleTypeName :: Int -> Name
unboxedTupleTypeName Int
n = Int -> NameSpace -> Bool -> Name
mk_tup_name Int
n NameSpace
TcClsName Bool
False

mk_tup_name :: Int -> NameSpace -> Bool -> Name
mk_tup_name :: Int -> NameSpace -> Bool -> Name
mk_tup_name Int
n NameSpace
space Bool
boxed
  = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
tup_occ) (NameSpace -> PkgName -> ModName -> NameFlavour
NameG NameSpace
space (String -> PkgName
mkPkgName String
"ghc-internal") ModName
tup_mod)
  where
    withParens :: ShowS
withParens String
thing
      | Bool
boxed     = String
"("  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
thing String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
      | Bool
otherwise = String
"(#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
thing String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"#)"
    tup_occ :: String
tup_occ | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0, NameSpace
space NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
TcClsName = if Bool
boxed then String
"Unit" else String
"Unit#"
            | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = if Bool
boxed then String
solo else String
unboxed_solo
            | NameSpace
space NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
TcClsName = String
"Tuple" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool
boxed then String
"" else String
"#"
            | Bool
otherwise = ShowS
withParens (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n_commas Char
',')
    n_commas :: Int
n_commas = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    tup_mod :: ModName
tup_mod  = String -> ModName
mkModName (if Bool
boxed then String
"GHC.Internal.Tuple" else String
"GHC.Internal.Types")
    solo :: String
solo
      | NameSpace
space NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
DataName = String
"MkSolo"
      | Bool
otherwise = String
"Solo"

    unboxed_solo :: String
unboxed_solo = String
solo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"#"

-- Unboxed sum data and type constructors
-- | Unboxed sum data constructor
unboxedSumDataName :: SumAlt -> SumArity -> Name
-- | Unboxed sum type constructor
unboxedSumTypeName :: SumArity -> Name

unboxedSumDataName :: Int -> Int -> Name
unboxedSumDataName Int
alt Int
arity
  | Int
alt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
arity
  = String -> Name
forall a. HasCallStack => String -> a
error (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Index out of bounds." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
debug_info

  | Int
alt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
  = String -> Name
forall a. HasCallStack => String -> a
error (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Alt must be > 0." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
debug_info

  | Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
  = String -> Name
forall a. HasCallStack => String -> a
error (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Arity must be >= 2." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
debug_info

  | Bool
otherwise
  = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
sum_occ)
         (NameSpace -> PkgName -> ModName -> NameFlavour
NameG NameSpace
DataName (String -> PkgName
mkPkgName String
"ghc-internal") (String -> ModName
mkModName String
"GHC.Internal.Types"))

  where
    prefix :: String
prefix     = String
"unboxedSumDataName: "
    debug_info :: String
debug_info = String
" (alt: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
alt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", arity: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
arity String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

    -- Synced with the definition of mkSumDataConOcc in GHC.Builtin.Types
    sum_occ :: String
sum_occ = Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'#' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
bars Int
nbars_before String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'_' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
bars Int
nbars_after String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"#)"
    bars :: Int -> String
bars Int
i = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
'|'
    nbars_before :: Int
nbars_before = Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    nbars_after :: Int
nbars_after  = Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
alt

unboxedSumTypeName :: Int -> Name
unboxedSumTypeName Int
arity
  | Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
  = String -> Name
forall a. HasCallStack => String -> a
error (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"unboxedSumTypeName: Arity must be >= 2."
         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (arity: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
arity String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

  | Bool
otherwise
  = OccName -> NameFlavour -> Name
Name (String -> OccName
mkOccName String
sum_occ)
         (NameSpace -> PkgName -> ModName -> NameFlavour
NameG NameSpace
TcClsName (String -> PkgName
mkPkgName String
"ghc-internal") (String -> ModName
mkModName String
"GHC.Internal.Types"))

  where
    -- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types
    sum_occ :: String
sum_occ = String
"Sum" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
arity String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"#"

-----------------------------------------------------
--              Locations
-----------------------------------------------------

-- | A location within a source file.
data Loc
  = Loc { Loc -> String
loc_filename :: String
        , Loc -> String
loc_package  :: String
        , Loc -> String
loc_module   :: String
        , Loc -> CharPos
loc_start    :: CharPos
        , Loc -> CharPos
loc_end      :: CharPos }
   deriving( Int -> Loc -> ShowS
[Loc] -> ShowS
Loc -> String
(Int -> Loc -> ShowS)
-> (Loc -> String) -> ([Loc] -> ShowS) -> Show Loc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Loc -> ShowS
showsPrec :: Int -> Loc -> ShowS
$cshow :: Loc -> String
show :: Loc -> String
$cshowList :: [Loc] -> ShowS
showList :: [Loc] -> ShowS
Show, Loc -> Loc -> Bool
(Loc -> Loc -> Bool) -> (Loc -> Loc -> Bool) -> Eq Loc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
/= :: Loc -> Loc -> Bool
Eq, Eq Loc
Eq Loc =>
(Loc -> Loc -> Ordering)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Loc)
-> (Loc -> Loc -> Loc)
-> Ord Loc
Loc -> Loc -> Bool
Loc -> Loc -> Ordering
Loc -> Loc -> Loc
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Loc -> Loc -> Ordering
compare :: Loc -> Loc -> Ordering
$c< :: Loc -> Loc -> Bool
< :: Loc -> Loc -> Bool
$c<= :: Loc -> Loc -> Bool
<= :: Loc -> Loc -> Bool
$c> :: Loc -> Loc -> Bool
> :: Loc -> Loc -> Bool
$c>= :: Loc -> Loc -> Bool
>= :: Loc -> Loc -> Bool
$cmax :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
min :: Loc -> Loc -> Loc
Ord, (forall x. Loc -> Rep Loc x)
-> (forall x. Rep Loc x -> Loc) -> Generic Loc
forall x. Rep Loc x -> Loc
forall x. Loc -> Rep Loc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Loc -> Rep Loc x
from :: forall x. Loc -> Rep Loc x
$cto :: forall x. Rep Loc x -> Loc
to :: forall x. Rep Loc x -> Loc
Generic )

type CharPos = (Int, Int)       -- ^ Line and character position


-----------------------------------------------------
--
--      The Info returned by reification
--
-----------------------------------------------------

-- | Obtained from 'reify' in the 'Q' Monad.
data Info
  =
  -- | A class, with a list of its visible instances
  ClassI
      Dec
      [InstanceDec]

  -- | A class method
  | ClassOpI
       Name
       Type
       ParentName

  -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned
  -- using 'PrimTyConI' or 'FamilyI' as appropriate. At present, this reified
  -- declaration will never have derived instances attached to it (if you wish
  -- to check for an instance, see 'reifyInstances').
  | TyConI
        Dec

  -- | A type or data family, with a list of its visible instances. A closed
  -- type family is returned with 0 instances.
  | FamilyI
        Dec
        [InstanceDec]

  -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'.
  -- Examples: @(->)@, @Int#@.
  | PrimTyConI
       Name
       Arity
       Unlifted

  -- | A data constructor
  | DataConI
       Name
       Type
       ParentName

  -- | A pattern synonym
  | PatSynI
       Name
       PatSynType

  {- |
  A \"value\" variable (as opposed to a type variable, see 'TyVarI').

  The @Maybe Dec@ field contains @Just@ the declaration which
  defined the variable - including the RHS of the declaration -
  or else @Nothing@, in the case where the RHS is unavailable to
  the compiler.

  At present, this value is /always/ @Nothing@:
  returning the RHS has not yet been implemented and is tracked by
  [GHC #14474](https://gitlab.haskell.org/ghc/ghc/-/issues/14474).
  -}
  | VarI
       Name
       Type
       (Maybe Dec)

  {- |
  A type variable.

  The @Type@ field contains the type which underlies the variable.
  At present, this is always @'VarT' theName@, but future changes
  may permit refinement of this.
  -}
  | TyVarI      -- Scoped type variable
        Name
        Type    -- What it is bound to
  deriving( Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Info -> ShowS
showsPrec :: Int -> Info -> ShowS
$cshow :: Info -> String
show :: Info -> String
$cshowList :: [Info] -> ShowS
showList :: [Info] -> ShowS
Show, Info -> Info -> Bool
(Info -> Info -> Bool) -> (Info -> Info -> Bool) -> Eq Info
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Info -> Info -> Bool
== :: Info -> Info -> Bool
$c/= :: Info -> Info -> Bool
/= :: Info -> Info -> Bool
Eq, Eq Info
Eq Info =>
(Info -> Info -> Ordering)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Info)
-> (Info -> Info -> Info)
-> Ord Info
Info -> Info -> Bool
Info -> Info -> Ordering
Info -> Info -> Info
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Info -> Info -> Ordering
compare :: Info -> Info -> Ordering
$c< :: Info -> Info -> Bool
< :: Info -> Info -> Bool
$c<= :: Info -> Info -> Bool
<= :: Info -> Info -> Bool
$c> :: Info -> Info -> Bool
> :: Info -> Info -> Bool
$c>= :: Info -> Info -> Bool
>= :: Info -> Info -> Bool
$cmax :: Info -> Info -> Info
max :: Info -> Info -> Info
$cmin :: Info -> Info -> Info
min :: Info -> Info -> Info
Ord, (forall x. Info -> Rep Info x)
-> (forall x. Rep Info x -> Info) -> Generic Info
forall x. Rep Info x -> Info
forall x. Info -> Rep Info x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Info -> Rep Info x
from :: forall x. Info -> Rep Info x
$cto :: forall x. Rep Info x -> Info
to :: forall x. Rep Info x -> Info
Generic )

-- | Obtained from 'reifyModule' in the 'Q' Monad.
data ModuleInfo =
  -- | Contains the import list of the module.
  ModuleInfo [Module]
  deriving( Int -> ModuleInfo -> ShowS
[ModuleInfo] -> ShowS
ModuleInfo -> String
(Int -> ModuleInfo -> ShowS)
-> (ModuleInfo -> String)
-> ([ModuleInfo] -> ShowS)
-> Show ModuleInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleInfo -> ShowS
showsPrec :: Int -> ModuleInfo -> ShowS
$cshow :: ModuleInfo -> String
show :: ModuleInfo -> String
$cshowList :: [ModuleInfo] -> ShowS
showList :: [ModuleInfo] -> ShowS
Show, ModuleInfo -> ModuleInfo -> Bool
(ModuleInfo -> ModuleInfo -> Bool)
-> (ModuleInfo -> ModuleInfo -> Bool) -> Eq ModuleInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleInfo -> ModuleInfo -> Bool
== :: ModuleInfo -> ModuleInfo -> Bool
$c/= :: ModuleInfo -> ModuleInfo -> Bool
/= :: ModuleInfo -> ModuleInfo -> Bool
Eq, Eq ModuleInfo
Eq ModuleInfo =>
(ModuleInfo -> ModuleInfo -> Ordering)
-> (ModuleInfo -> ModuleInfo -> Bool)
-> (ModuleInfo -> ModuleInfo -> Bool)
-> (ModuleInfo -> ModuleInfo -> Bool)
-> (ModuleInfo -> ModuleInfo -> Bool)
-> (ModuleInfo -> ModuleInfo -> ModuleInfo)
-> (ModuleInfo -> ModuleInfo -> ModuleInfo)
-> Ord ModuleInfo
ModuleInfo -> ModuleInfo -> Bool
ModuleInfo -> ModuleInfo -> Ordering
ModuleInfo -> ModuleInfo -> ModuleInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModuleInfo -> ModuleInfo -> Ordering
compare :: ModuleInfo -> ModuleInfo -> Ordering
$c< :: ModuleInfo -> ModuleInfo -> Bool
< :: ModuleInfo -> ModuleInfo -> Bool
$c<= :: ModuleInfo -> ModuleInfo -> Bool
<= :: ModuleInfo -> ModuleInfo -> Bool
$c> :: ModuleInfo -> ModuleInfo -> Bool
> :: ModuleInfo -> ModuleInfo -> Bool
$c>= :: ModuleInfo -> ModuleInfo -> Bool
>= :: ModuleInfo -> ModuleInfo -> Bool
$cmax :: ModuleInfo -> ModuleInfo -> ModuleInfo
max :: ModuleInfo -> ModuleInfo -> ModuleInfo
$cmin :: ModuleInfo -> ModuleInfo -> ModuleInfo
min :: ModuleInfo -> ModuleInfo -> ModuleInfo
Ord, (forall x. ModuleInfo -> Rep ModuleInfo x)
-> (forall x. Rep ModuleInfo x -> ModuleInfo) -> Generic ModuleInfo
forall x. Rep ModuleInfo x -> ModuleInfo
forall x. ModuleInfo -> Rep ModuleInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModuleInfo -> Rep ModuleInfo x
from :: forall x. ModuleInfo -> Rep ModuleInfo x
$cto :: forall x. Rep ModuleInfo x -> ModuleInfo
to :: forall x. Rep ModuleInfo x -> ModuleInfo
Generic )

{- |
In 'ClassOpI' and 'DataConI', name of the parent class or type
-}
type ParentName = Name

-- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a
-- particular data constructor. 'SumAlt's are one-indexed and should never
-- exceed the value of its corresponding 'SumArity'. For example:
--
-- * @(\#_|\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2)
--
-- * @(\#|_\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2)
type SumAlt = Int

-- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of
-- 'SumAlt's. For example, @(\#|\#)@ has a 'SumArity' of 2.
type SumArity = Int

-- | In 'PrimTyConI', arity of the type constructor
type Arity = Int

-- | In 'PrimTyConI', is the type constructor unlifted?
type Unlifted = Bool

-- | 'InstanceDec' describes a single instance of a class or type function.
-- It is just a 'Dec', but guaranteed to be one of the following:
--
--   * 'InstanceD' (with empty @['Dec']@)
--
--   * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)
--
--   * 'TySynInstD'
type InstanceDec = Dec

-- | Fixity, as specified in a @infix[lr] n@ declaration.
data Fixity          = Fixity Int FixityDirection
    deriving( Fixity -> Fixity -> Bool
(Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool) -> Eq Fixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
/= :: Fixity -> Fixity -> Bool
Eq, Eq Fixity
Eq Fixity =>
(Fixity -> Fixity -> Ordering)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Fixity)
-> (Fixity -> Fixity -> Fixity)
-> Ord Fixity
Fixity -> Fixity -> Bool
Fixity -> Fixity -> Ordering
Fixity -> Fixity -> Fixity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Fixity -> Fixity -> Ordering
compare :: Fixity -> Fixity -> Ordering
$c< :: Fixity -> Fixity -> Bool
< :: Fixity -> Fixity -> Bool
$c<= :: Fixity -> Fixity -> Bool
<= :: Fixity -> Fixity -> Bool
$c> :: Fixity -> Fixity -> Bool
> :: Fixity -> Fixity -> Bool
$c>= :: Fixity -> Fixity -> Bool
>= :: Fixity -> Fixity -> Bool
$cmax :: Fixity -> Fixity -> Fixity
max :: Fixity -> Fixity -> Fixity
$cmin :: Fixity -> Fixity -> Fixity
min :: Fixity -> Fixity -> Fixity
Ord, Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> String
(Int -> Fixity -> ShowS)
-> (Fixity -> String) -> ([Fixity] -> ShowS) -> Show Fixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fixity -> ShowS
showsPrec :: Int -> Fixity -> ShowS
$cshow :: Fixity -> String
show :: Fixity -> String
$cshowList :: [Fixity] -> ShowS
showList :: [Fixity] -> ShowS
Show, (forall x. Fixity -> Rep Fixity x)
-> (forall x. Rep Fixity x -> Fixity) -> Generic Fixity
forall x. Rep Fixity x -> Fixity
forall x. Fixity -> Rep Fixity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Fixity -> Rep Fixity x
from :: forall x. Fixity -> Rep Fixity x
$cto :: forall x. Rep Fixity x -> Fixity
to :: forall x. Rep Fixity x -> Fixity
Generic )

-- | The associativity of an operator, as in an @infix@ declaration.
data FixityDirection = InfixL | InfixR | InfixN
    deriving( FixityDirection -> FixityDirection -> Bool
(FixityDirection -> FixityDirection -> Bool)
-> (FixityDirection -> FixityDirection -> Bool)
-> Eq FixityDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FixityDirection -> FixityDirection -> Bool
== :: FixityDirection -> FixityDirection -> Bool
$c/= :: FixityDirection -> FixityDirection -> Bool
/= :: FixityDirection -> FixityDirection -> Bool
Eq, Eq FixityDirection
Eq FixityDirection =>
(FixityDirection -> FixityDirection -> Ordering)
-> (FixityDirection -> FixityDirection -> Bool)
-> (FixityDirection -> FixityDirection -> Bool)
-> (FixityDirection -> FixityDirection -> Bool)
-> (FixityDirection -> FixityDirection -> Bool)
-> (FixityDirection -> FixityDirection -> FixityDirection)
-> (FixityDirection -> FixityDirection -> FixityDirection)
-> Ord FixityDirection
FixityDirection -> FixityDirection -> Bool
FixityDirection -> FixityDirection -> Ordering
FixityDirection -> FixityDirection -> FixityDirection
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FixityDirection -> FixityDirection -> Ordering
compare :: FixityDirection -> FixityDirection -> Ordering
$c< :: FixityDirection -> FixityDirection -> Bool
< :: FixityDirection -> FixityDirection -> Bool
$c<= :: FixityDirection -> FixityDirection -> Bool
<= :: FixityDirection -> FixityDirection -> Bool
$c> :: FixityDirection -> FixityDirection -> Bool
> :: FixityDirection -> FixityDirection -> Bool
$c>= :: FixityDirection -> FixityDirection -> Bool
>= :: FixityDirection -> FixityDirection -> Bool
$cmax :: FixityDirection -> FixityDirection -> FixityDirection
max :: FixityDirection -> FixityDirection -> FixityDirection
$cmin :: FixityDirection -> FixityDirection -> FixityDirection
min :: FixityDirection -> FixityDirection -> FixityDirection
Ord, Int -> FixityDirection -> ShowS
[FixityDirection] -> ShowS
FixityDirection -> String
(Int -> FixityDirection -> ShowS)
-> (FixityDirection -> String)
-> ([FixityDirection] -> ShowS)
-> Show FixityDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixityDirection -> ShowS
showsPrec :: Int -> FixityDirection -> ShowS
$cshow :: FixityDirection -> String
show :: FixityDirection -> String
$cshowList :: [FixityDirection] -> ShowS
showList :: [FixityDirection] -> ShowS
Show, (forall x. FixityDirection -> Rep FixityDirection x)
-> (forall x. Rep FixityDirection x -> FixityDirection)
-> Generic FixityDirection
forall x. Rep FixityDirection x -> FixityDirection
forall x. FixityDirection -> Rep FixityDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FixityDirection -> Rep FixityDirection x
from :: forall x. FixityDirection -> Rep FixityDirection x
$cto :: forall x. Rep FixityDirection x -> FixityDirection
to :: forall x. Rep FixityDirection x -> FixityDirection
Generic )

-- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)
maxPrecedence :: Int
maxPrecedence :: Int
maxPrecedence = (Int
9::Int)

-- | Default fixity: @infixl 9@
defaultFixity :: Fixity
defaultFixity :: Fixity
defaultFixity = Int -> FixityDirection -> Fixity
Fixity Int
maxPrecedence FixityDirection
InfixL

-----------------------------------------------------
--
--      The main syntax data types
--
-----------------------------------------------------

-- | A Haskell literal. Note that the numeric types are all in terms of either
-- 'Integer' or 'Rational', regardless of the type they represent. The extra
-- precision reflects the textual representation in source code.
data Lit = CharL Char           -- ^ @\'c\'@
         | StringL String       -- ^ @"string"@
         | IntegerL Integer     -- ^ @123@. Used for overloaded and non-overloaded
                                -- literals. We don't have a good way to
                                -- represent non-overloaded literals at
                                -- the moment. Maybe that doesn't matter?
         | RationalL Rational   -- ^ @1.23@. See above comment on 'IntegerL'.
         | IntPrimL Integer     -- ^ @123#@
         | WordPrimL Integer    -- ^ @123##@
         | FloatPrimL Rational  -- ^ @1.23#@
         | DoublePrimL Rational -- ^ @1.23##@
         | StringPrimL [Word8]  -- ^ @"string"#@. A primitive C-style string, type 'Addr#'
         | BytesPrimL Bytes     -- ^ Some raw bytes, type 'Addr#':
         | CharPrimL Char       -- ^ @\'c\'#@
    deriving( Int -> Lit -> ShowS
[Lit] -> ShowS
Lit -> String
(Int -> Lit -> ShowS)
-> (Lit -> String) -> ([Lit] -> ShowS) -> Show Lit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lit -> ShowS
showsPrec :: Int -> Lit -> ShowS
$cshow :: Lit -> String
show :: Lit -> String
$cshowList :: [Lit] -> ShowS
showList :: [Lit] -> ShowS
Show, Lit -> Lit -> Bool
(Lit -> Lit -> Bool) -> (Lit -> Lit -> Bool) -> Eq Lit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lit -> Lit -> Bool
== :: Lit -> Lit -> Bool
$c/= :: Lit -> Lit -> Bool
/= :: Lit -> Lit -> Bool
Eq, Eq Lit
Eq Lit =>
(Lit -> Lit -> Ordering)
-> (Lit -> Lit -> Bool)
-> (Lit -> Lit -> Bool)
-> (Lit -> Lit -> Bool)
-> (Lit -> Lit -> Bool)
-> (Lit -> Lit -> Lit)
-> (Lit -> Lit -> Lit)
-> Ord Lit
Lit -> Lit -> Bool
Lit -> Lit -> Ordering
Lit -> Lit -> Lit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Lit -> Lit -> Ordering
compare :: Lit -> Lit -> Ordering
$c< :: Lit -> Lit -> Bool
< :: Lit -> Lit -> Bool
$c<= :: Lit -> Lit -> Bool
<= :: Lit -> Lit -> Bool
$c> :: Lit -> Lit -> Bool
> :: Lit -> Lit -> Bool
$c>= :: Lit -> Lit -> Bool
>= :: Lit -> Lit -> Bool
$cmax :: Lit -> Lit -> Lit
max :: Lit -> Lit -> Lit
$cmin :: Lit -> Lit -> Lit
min :: Lit -> Lit -> Lit
Ord, (forall x. Lit -> Rep Lit x)
-> (forall x. Rep Lit x -> Lit) -> Generic Lit
forall x. Rep Lit x -> Lit
forall x. Lit -> Rep Lit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Lit -> Rep Lit x
from :: forall x. Lit -> Rep Lit x
$cto :: forall x. Rep Lit x -> Lit
to :: forall x. Rep Lit x -> Lit
Generic )

    -- We could add Int, Float, Double etc, as we do in HsLit,
    -- but that could complicate the
    -- supposedly-simple TH.Syntax literal type

-- | Raw bytes embedded into the binary.
--
-- Avoid using Bytes constructor directly as it is likely to change in the
-- future. Use helpers such as `mkBytes` in Language.Haskell.TH.Lib instead.
data Bytes = Bytes
   { Bytes -> ForeignPtr Word8
bytesPtr    :: ForeignPtr Word8 -- ^ Pointer to the data
   , Bytes -> Word
bytesOffset :: Word             -- ^ Offset from the pointer
   , Bytes -> Word
bytesSize   :: Word             -- ^ Number of bytes

   -- Maybe someday:
   -- , bytesAlignement  :: Word -- ^ Alignement constraint
   -- , bytesReadOnly    :: Bool -- ^ Shall we embed into a read-only
   --                            --   section or not
   -- , bytesInitialized :: Bool -- ^ False: only use `bytesSize` to allocate
   --                            --   an uninitialized region
   }
   deriving ((forall x. Bytes -> Rep Bytes x)
-> (forall x. Rep Bytes x -> Bytes) -> Generic Bytes
forall x. Rep Bytes x -> Bytes
forall x. Bytes -> Rep Bytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bytes -> Rep Bytes x
from :: forall x. Bytes -> Rep Bytes x
$cto :: forall x. Rep Bytes x -> Bytes
to :: forall x. Rep Bytes x -> Bytes
Generic)

-- We can't derive Show instance for Bytes because we don't want to show the
-- pointer value but the actual bytes (similarly to what ByteString does). See
-- #16457.
instance Show Bytes where
   show :: Bytes -> String
show Bytes
b = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO String) -> IO String
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Bytes -> ForeignPtr Word8
bytesPtr Bytes
b) ((Ptr Word8 -> IO String) -> IO String)
-> (Ptr Word8 -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
               CStringLen -> IO String
peekCStringLen ( Ptr Word8
ptr Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Word
bytesOffset Bytes
b)
                              , Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Word
bytesSize Bytes
b)
                              )

-- We can't derive Eq and Ord instances for Bytes because we don't want to
-- compare pointer values but the actual bytes (similarly to what ByteString
-- does).  See #16457
instance Eq Bytes where
   == :: Bytes -> Bytes -> Bool
(==) = Bytes -> Bytes -> Bool
eqBytes

instance Ord Bytes where
   compare :: Bytes -> Bytes -> Ordering
compare = Bytes -> Bytes -> Ordering
compareBytes

eqBytes :: Bytes -> Bytes -> Bool
eqBytes :: Bytes -> Bytes -> Bool
eqBytes a :: Bytes
a@(Bytes ForeignPtr Word8
fp Word
off Word
len) b :: Bytes
b@(Bytes ForeignPtr Word8
fp' Word
off' Word
len')
  | Word
len Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
len'              = Bool
False    -- short cut on length
  | ForeignPtr Word8
fp ForeignPtr Word8 -> ForeignPtr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
fp' Bool -> Bool -> Bool
&& Word
off Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
off' = Bool
True     -- short cut for the same bytes
  | Bool
otherwise                = Bytes -> Bytes -> Ordering
compareBytes Bytes
a Bytes
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

compareBytes :: Bytes -> Bytes -> Ordering
compareBytes :: Bytes -> Bytes -> Ordering
compareBytes (Bytes ForeignPtr Word8
_   Word
_    Word
0)    (Bytes ForeignPtr Word8
_   Word
_    Word
0)    = Ordering
EQ  -- short cut for empty Bytes
compareBytes (Bytes ForeignPtr Word8
fp1 Word
off1 Word
len1) (Bytes ForeignPtr Word8
fp2 Word
off2 Word
len2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr Word8 -> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp1 ((Ptr Word8 -> IO Ordering) -> IO Ordering)
-> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp2 ((Ptr Word8 -> IO Ordering) -> IO Ordering)
-> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p2 -> do
        i <- Ptr (ZonkAny 1) -> Ptr (ZonkAny 0) -> CSize -> IO CInt
forall a b. Ptr a -> Ptr b -> CSize -> IO CInt
memcmp (Ptr Word8
p1 Ptr Word8 -> Int -> Ptr (ZonkAny 1)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
off1)
                    (Ptr Word8
p2 Ptr Word8 -> Int -> Ptr (ZonkAny 0)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
off2)
                    (Word -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word -> Word
forall a. Ord a => a -> a -> a
min Word
len1 Word
len2))
        return $! (i `compare` 0) <> (len1 `compare` len2)

foreign import ccall unsafe "memcmp"
  memcmp :: Ptr a -> Ptr b -> CSize -> IO CInt


-- | Pattern in Haskell given in @{}@
data Pat
  = LitP Lit                        -- ^ @{ 5 or \'c\' }@
  | VarP Name                       -- ^ @{ x }@
  | TupP [Pat]                      -- ^ @{ (p1,p2) }@
  | UnboxedTupP [Pat]               -- ^ @{ (\# p1,p2 \#) }@
  | UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\#|p|\#) }@
  | ConP Name [Type] [Pat]          -- ^ @data T1 = C1 t1 t2; {C1 \@ty1 p1 p2} = e@
  | InfixP Pat Name Pat             -- ^ @foo ({x :+ y}) = e@
  | UInfixP Pat Name Pat            -- ^ @foo ({x :+ y}) = e@
                                    --
                                    -- See "Language.Haskell.TH.Syntax#infix"
  | ParensP Pat                     -- ^ @{(p)}@
                                    --
                                    -- See "Language.Haskell.TH.Syntax#infix"
  | TildeP Pat                      -- ^ @{ ~p }@
  | BangP Pat                       -- ^ @{ !p }@
  | AsP Name Pat                    -- ^ @{ x \@ p }@
  | WildP                           -- ^ @{ _ }@
  | RecP Name [FieldPat]            -- ^ @f (Pt { pointx = x }) = g x@
  | ListP [ Pat ]                   -- ^ @{ [1,2,3] }@
  | SigP Pat Type                   -- ^ @{ p :: t }@
  | ViewP Exp Pat                   -- ^ @{ e -> p }@
  | TypeP Type                      -- ^ @{ type p }@
  | InvisP Type                     -- ^ @{ @p }@
  | OrP (NonEmpty Pat)              -- ^ @{ p1; p2 }@
  deriving( Int -> Pat -> ShowS
[Pat] -> ShowS
Pat -> String
(Int -> Pat -> ShowS)
-> (Pat -> String) -> ([Pat] -> ShowS) -> Show Pat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pat -> ShowS
showsPrec :: Int -> Pat -> ShowS
$cshow :: Pat -> String
show :: Pat -> String
$cshowList :: [Pat] -> ShowS
showList :: [Pat] -> ShowS
Show, Pat -> Pat -> Bool
(Pat -> Pat -> Bool) -> (Pat -> Pat -> Bool) -> Eq Pat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pat -> Pat -> Bool
== :: Pat -> Pat -> Bool
$c/= :: Pat -> Pat -> Bool
/= :: Pat -> Pat -> Bool
Eq, Eq Pat
Eq Pat =>
(Pat -> Pat -> Ordering)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Pat)
-> (Pat -> Pat -> Pat)
-> Ord Pat
Pat -> Pat -> Bool
Pat -> Pat -> Ordering
Pat -> Pat -> Pat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pat -> Pat -> Ordering
compare :: Pat -> Pat -> Ordering
$c< :: Pat -> Pat -> Bool
< :: Pat -> Pat -> Bool
$c<= :: Pat -> Pat -> Bool
<= :: Pat -> Pat -> Bool
$c> :: Pat -> Pat -> Bool
> :: Pat -> Pat -> Bool
$c>= :: Pat -> Pat -> Bool
>= :: Pat -> Pat -> Bool
$cmax :: Pat -> Pat -> Pat
max :: Pat -> Pat -> Pat
$cmin :: Pat -> Pat -> Pat
min :: Pat -> Pat -> Pat
Ord, (forall x. Pat -> Rep Pat x)
-> (forall x. Rep Pat x -> Pat) -> Generic Pat
forall x. Rep Pat x -> Pat
forall x. Pat -> Rep Pat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Pat -> Rep Pat x
from :: forall x. Pat -> Rep Pat x
$cto :: forall x. Rep Pat x -> Pat
to :: forall x. Rep Pat x -> Pat
Generic )

-- | A (field name, pattern) pair. See 'RecP'.
type FieldPat = (Name,Pat)

-- | A @case@-alternative
data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@
    deriving( Int -> Match -> ShowS
[Match] -> ShowS
Match -> String
(Int -> Match -> ShowS)
-> (Match -> String) -> ([Match] -> ShowS) -> Show Match
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Match -> ShowS
showsPrec :: Int -> Match -> ShowS
$cshow :: Match -> String
show :: Match -> String
$cshowList :: [Match] -> ShowS
showList :: [Match] -> ShowS
Show, Match -> Match -> Bool
(Match -> Match -> Bool) -> (Match -> Match -> Bool) -> Eq Match
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Match -> Match -> Bool
== :: Match -> Match -> Bool
$c/= :: Match -> Match -> Bool
/= :: Match -> Match -> Bool
Eq, Eq Match
Eq Match =>
(Match -> Match -> Ordering)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Match)
-> (Match -> Match -> Match)
-> Ord Match
Match -> Match -> Bool
Match -> Match -> Ordering
Match -> Match -> Match
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Match -> Match -> Ordering
compare :: Match -> Match -> Ordering
$c< :: Match -> Match -> Bool
< :: Match -> Match -> Bool
$c<= :: Match -> Match -> Bool
<= :: Match -> Match -> Bool
$c> :: Match -> Match -> Bool
> :: Match -> Match -> Bool
$c>= :: Match -> Match -> Bool
>= :: Match -> Match -> Bool
$cmax :: Match -> Match -> Match
max :: Match -> Match -> Match
$cmin :: Match -> Match -> Match
min :: Match -> Match -> Match
Ord, (forall x. Match -> Rep Match x)
-> (forall x. Rep Match x -> Match) -> Generic Match
forall x. Rep Match x -> Match
forall x. Match -> Rep Match x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Match -> Rep Match x
from :: forall x. Match -> Rep Match x
$cto :: forall x. Rep Match x -> Match
to :: forall x. Rep Match x -> Match
Generic )

-- | A clause consists of patterns, guards, a body expression, and a list of
-- declarations under a @where@. Clauses are seen in equations for function
-- definitions, @case@-experssions, explicitly-bidirectional pattern synonyms,
-- etc.
data Clause = Clause [Pat] Body [Dec]
                                  -- ^ @f { p1 p2 = body where decs }@
    deriving( Int -> Clause -> ShowS
[Clause] -> ShowS
Clause -> String
(Int -> Clause -> ShowS)
-> (Clause -> String) -> ([Clause] -> ShowS) -> Show Clause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Clause -> ShowS
showsPrec :: Int -> Clause -> ShowS
$cshow :: Clause -> String
show :: Clause -> String
$cshowList :: [Clause] -> ShowS
showList :: [Clause] -> ShowS
Show, Clause -> Clause -> Bool
(Clause -> Clause -> Bool)
-> (Clause -> Clause -> Bool) -> Eq Clause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Clause -> Clause -> Bool
== :: Clause -> Clause -> Bool
$c/= :: Clause -> Clause -> Bool
/= :: Clause -> Clause -> Bool
Eq, Eq Clause
Eq Clause =>
(Clause -> Clause -> Ordering)
-> (Clause -> Clause -> Bool)
-> (Clause -> Clause -> Bool)
-> (Clause -> Clause -> Bool)
-> (Clause -> Clause -> Bool)
-> (Clause -> Clause -> Clause)
-> (Clause -> Clause -> Clause)
-> Ord Clause
Clause -> Clause -> Bool
Clause -> Clause -> Ordering
Clause -> Clause -> Clause
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Clause -> Clause -> Ordering
compare :: Clause -> Clause -> Ordering
$c< :: Clause -> Clause -> Bool
< :: Clause -> Clause -> Bool
$c<= :: Clause -> Clause -> Bool
<= :: Clause -> Clause -> Bool
$c> :: Clause -> Clause -> Bool
> :: Clause -> Clause -> Bool
$c>= :: Clause -> Clause -> Bool
>= :: Clause -> Clause -> Bool
$cmax :: Clause -> Clause -> Clause
max :: Clause -> Clause -> Clause
$cmin :: Clause -> Clause -> Clause
min :: Clause -> Clause -> Clause
Ord, (forall x. Clause -> Rep Clause x)
-> (forall x. Rep Clause x -> Clause) -> Generic Clause
forall x. Rep Clause x -> Clause
forall x. Clause -> Rep Clause x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Clause -> Rep Clause x
from :: forall x. Clause -> Rep Clause x
$cto :: forall x. Rep Clause x -> Clause
to :: forall x. Rep Clause x -> Clause
Generic )

-- | A Haskell expression.
data Exp
  = VarE Name                          -- ^ @{ x }@
  | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @
  | LitE Lit                           -- ^ @{ 5 or \'c\'}@
  | AppE Exp Exp                       -- ^ @{ f x }@
  | AppTypeE Exp Type                  -- ^ @{ f \@Int }@

  | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@

    -- It's a bit gruesome to use an Exp as the operator when a Name
    -- would suffice. Historically, Exp was used to make it easier to
    -- distinguish between infix constructors and non-constructors.
    -- This is a bit overkill, since one could just as well call
    -- `startsConId` or `startsConSym` (from `GHC.Lexeme`) on a Name.
    -- Unfortunately, changing this design now would involve lots of
    -- code churn for consumers of the TH API, so we continue to use
    -- an Exp as the operator and perform an extra check during conversion
    -- to ensure that the Exp is a constructor or a variable (#16895).

  | UInfixE Exp Exp Exp                -- ^ @{x + y}@
                                       --
                                       -- See "Language.Haskell.TH.Syntax#infix"
  | ParensE Exp                        -- ^ @{ (e) }@
                                       --
                                       -- See "Language.Haskell.TH.Syntax#infix"
  | LamE [Pat] Exp                     -- ^ @{ \\ p1 p2 -> e }@
  | LamCaseE [Match]                   -- ^ @{ \\case m1; m2 }@
  | LamCasesE [Clause]                 -- ^ @{ \\cases m1; m2 }@
  | TupE [Maybe Exp]                   -- ^ @{ (e1,e2) }  @
                                       --
                                       -- The 'Maybe' is necessary for handling
                                       -- tuple sections.
                                       --
                                       -- > (1,)
                                       --
                                       -- translates to
                                       --
                                       -- > TupE [Just (LitE (IntegerL 1)),Nothing]

  | UnboxedTupE [Maybe Exp]            -- ^ @{ (\# e1,e2 \#) }  @
                                       --
                                       -- The 'Maybe' is necessary for handling
                                       -- tuple sections.
                                       --
                                       -- > (# 'c', #)
                                       --
                                       -- translates to
                                       --
                                       -- > UnboxedTupE [Just (LitE (CharL 'c')),Nothing]

  | UnboxedSumE Exp SumAlt SumArity    -- ^ @{ (\#|e|\#) }@
  | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@
  | MultiIfE [(Guard, Exp)]            -- ^ @{ if | g1 -> e1 | g2 -> e2 }@
  | LetE [Dec] Exp                     -- ^ @{ let { x=e1; y=e2 } in e3 }@
  | CaseE Exp [Match]                  -- ^ @{ case e of m1; m2 }@
  | DoE (Maybe ModName) [Stmt]         -- ^ @{ do { p <- e1; e2 }  }@ or a qualified do if
                                       -- the module name is present
  | MDoE (Maybe ModName) [Stmt]        -- ^ @{ mdo { x <- e1 y; y <- e2 x; } }@ or a qualified
                                       -- mdo if the module name is present
  | CompE [Stmt]                       -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@
      --
      -- The result expression of the comprehension is
      -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.
      --
      -- E.g. translation:
      --
      -- > [ f x | x <- xs ]
      --
      -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]

  | ArithSeqE Range                    -- ^ @{ [ 1 ,2 .. 10 ] }@
  | ListE [ Exp ]                      -- ^ @{ [1,2,3] }@
  | SigE Exp Type                      -- ^ @{ e :: t }@
  | RecConE Name [FieldExp]            -- ^ @{ T { x = y, z = w } }@
  | RecUpdE Exp [FieldExp]             -- ^ @{ (f x) { z = w } }@
  | StaticE Exp                        -- ^ @{ static e }@
  | UnboundVarE Name                   -- ^ @{ _x }@
                                       --
                                       -- This is used for holes or unresolved
                                       -- identifiers in AST quotes. Note that
                                       -- it could either have a variable name
                                       -- or constructor name.
  | LabelE String                      -- ^ @{ #x }@ ( Overloaded label )
  | ImplicitParamVarE String           -- ^ @{ ?x }@ ( Implicit parameter )
  | GetFieldE Exp String               -- ^ @{ exp.field }@ ( Overloaded Record Dot )
  | ProjectionE (NonEmpty String)      -- ^ @(.x)@ or @(.x.y)@ (Record projections)
  | TypedBracketE Exp                  -- ^ @[|| e ||]@
  | TypedSpliceE Exp                   -- ^ @$$e@
  | TypeE Type                         -- ^ @{ type t }@
  | ForallE [TyVarBndr Specificity] Exp -- ^ @forall \<vars\>. \<expr\>@
  | ForallVisE [TyVarBndr ()] Exp      -- ^ @forall \<vars\> -> \<expr\>@
  | ConstrainedE [Exp] Exp             -- ^ @\<ctxt\> => \<expr\>@
  deriving( Int -> Exp -> ShowS
[Exp] -> ShowS
Exp -> String
(Int -> Exp -> ShowS)
-> (Exp -> String) -> ([Exp] -> ShowS) -> Show Exp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exp -> ShowS
showsPrec :: Int -> Exp -> ShowS
$cshow :: Exp -> String
show :: Exp -> String
$cshowList :: [Exp] -> ShowS
showList :: [Exp] -> ShowS
Show, Exp -> Exp -> Bool
(Exp -> Exp -> Bool) -> (Exp -> Exp -> Bool) -> Eq Exp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Exp -> Exp -> Bool
== :: Exp -> Exp -> Bool
$c/= :: Exp -> Exp -> Bool
/= :: Exp -> Exp -> Bool
Eq, Eq Exp
Eq Exp =>
(Exp -> Exp -> Ordering)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Exp)
-> (Exp -> Exp -> Exp)
-> Ord Exp
Exp -> Exp -> Bool
Exp -> Exp -> Ordering
Exp -> Exp -> Exp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Exp -> Exp -> Ordering
compare :: Exp -> Exp -> Ordering
$c< :: Exp -> Exp -> Bool
< :: Exp -> Exp -> Bool
$c<= :: Exp -> Exp -> Bool
<= :: Exp -> Exp -> Bool
$c> :: Exp -> Exp -> Bool
> :: Exp -> Exp -> Bool
$c>= :: Exp -> Exp -> Bool
>= :: Exp -> Exp -> Bool
$cmax :: Exp -> Exp -> Exp
max :: Exp -> Exp -> Exp
$cmin :: Exp -> Exp -> Exp
min :: Exp -> Exp -> Exp
Ord, (forall x. Exp -> Rep Exp x)
-> (forall x. Rep Exp x -> Exp) -> Generic Exp
forall x. Rep Exp x -> Exp
forall x. Exp -> Rep Exp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Exp -> Rep Exp x
from :: forall x. Exp -> Rep Exp x
$cto :: forall x. Rep Exp x -> Exp
to :: forall x. Rep Exp x -> Exp
Generic )

-- | A (field name, expression) pair. See 'RecConE' and 'RecUpdE'.
type FieldExp = (Name,Exp)

-- Omitted: implicit parameters

-- | A potentially guarded expression, as in function definitions or case
-- alternatives.
data Body
  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2
                                 --      | e3 = e4 }
                                 -- where ds@
  | NormalB Exp              -- ^ @f p { = e } where ds@
  deriving( Int -> Body -> ShowS
[Body] -> ShowS
Body -> String
(Int -> Body -> ShowS)
-> (Body -> String) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Body -> ShowS
showsPrec :: Int -> Body -> ShowS
$cshow :: Body -> String
show :: Body -> String
$cshowList :: [Body] -> ShowS
showList :: [Body] -> ShowS
Show, Body -> Body -> Bool
(Body -> Body -> Bool) -> (Body -> Body -> Bool) -> Eq Body
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
/= :: Body -> Body -> Bool
Eq, Eq Body
Eq Body =>
(Body -> Body -> Ordering)
-> (Body -> Body -> Bool)
-> (Body -> Body -> Bool)
-> (Body -> Body -> Bool)
-> (Body -> Body -> Bool)
-> (Body -> Body -> Body)
-> (Body -> Body -> Body)
-> Ord Body
Body -> Body -> Bool
Body -> Body -> Ordering
Body -> Body -> Body
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Body -> Body -> Ordering
compare :: Body -> Body -> Ordering
$c< :: Body -> Body -> Bool
< :: Body -> Body -> Bool
$c<= :: Body -> Body -> Bool
<= :: Body -> Body -> Bool
$c> :: Body -> Body -> Bool
> :: Body -> Body -> Bool
$c>= :: Body -> Body -> Bool
>= :: Body -> Body -> Bool
$cmax :: Body -> Body -> Body
max :: Body -> Body -> Body
$cmin :: Body -> Body -> Body
min :: Body -> Body -> Body
Ord, (forall x. Body -> Rep Body x)
-> (forall x. Rep Body x -> Body) -> Generic Body
forall x. Rep Body x -> Body
forall x. Body -> Rep Body x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Body -> Rep Body x
from :: forall x. Body -> Rep Body x
$cto :: forall x. Rep Body x -> Body
to :: forall x. Rep Body x -> Body
Generic )

-- | A single guard.
data Guard
  = NormalG Exp -- ^ @f x { | odd x } = x@
  | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@
  deriving( Int -> Guard -> ShowS
[Guard] -> ShowS
Guard -> String
(Int -> Guard -> ShowS)
-> (Guard -> String) -> ([Guard] -> ShowS) -> Show Guard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Guard -> ShowS
showsPrec :: Int -> Guard -> ShowS
$cshow :: Guard -> String
show :: Guard -> String
$cshowList :: [Guard] -> ShowS
showList :: [Guard] -> ShowS
Show, Guard -> Guard -> Bool
(Guard -> Guard -> Bool) -> (Guard -> Guard -> Bool) -> Eq Guard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Guard -> Guard -> Bool
== :: Guard -> Guard -> Bool
$c/= :: Guard -> Guard -> Bool
/= :: Guard -> Guard -> Bool
Eq, Eq Guard
Eq Guard =>
(Guard -> Guard -> Ordering)
-> (Guard -> Guard -> Bool)
-> (Guard -> Guard -> Bool)
-> (Guard -> Guard -> Bool)
-> (Guard -> Guard -> Bool)
-> (Guard -> Guard -> Guard)
-> (Guard -> Guard -> Guard)
-> Ord Guard
Guard -> Guard -> Bool
Guard -> Guard -> Ordering
Guard -> Guard -> Guard
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Guard -> Guard -> Ordering
compare :: Guard -> Guard -> Ordering
$c< :: Guard -> Guard -> Bool
< :: Guard -> Guard -> Bool
$c<= :: Guard -> Guard -> Bool
<= :: Guard -> Guard -> Bool
$c> :: Guard -> Guard -> Bool
> :: Guard -> Guard -> Bool
$c>= :: Guard -> Guard -> Bool
>= :: Guard -> Guard -> Bool
$cmax :: Guard -> Guard -> Guard
max :: Guard -> Guard -> Guard
$cmin :: Guard -> Guard -> Guard
min :: Guard -> Guard -> Guard
Ord, (forall x. Guard -> Rep Guard x)
-> (forall x. Rep Guard x -> Guard) -> Generic Guard
forall x. Rep Guard x -> Guard
forall x. Guard -> Rep Guard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Guard -> Rep Guard x
from :: forall x. Guard -> Rep Guard x
$cto :: forall x. Rep Guard x -> Guard
to :: forall x. Rep Guard x -> Guard
Generic )

-- | A single statement, as in @do@-notation.
data Stmt
  = BindS Pat Exp -- ^ @p <- e@
  | LetS [ Dec ]  -- ^ @{ let { x=e1; y=e2 } }@
  | NoBindS Exp   -- ^ @e@
  | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE')
  | RecS [Stmt]   -- ^ @rec { s1; s2 }@
  deriving( Int -> Stmt -> ShowS
[Stmt] -> ShowS
Stmt -> String
(Int -> Stmt -> ShowS)
-> (Stmt -> String) -> ([Stmt] -> ShowS) -> Show Stmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stmt -> ShowS
showsPrec :: Int -> Stmt -> ShowS
$cshow :: Stmt -> String
show :: Stmt -> String
$cshowList :: [Stmt] -> ShowS
showList :: [Stmt] -> ShowS
Show, Stmt -> Stmt -> Bool
(Stmt -> Stmt -> Bool) -> (Stmt -> Stmt -> Bool) -> Eq Stmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stmt -> Stmt -> Bool
== :: Stmt -> Stmt -> Bool
$c/= :: Stmt -> Stmt -> Bool
/= :: Stmt -> Stmt -> Bool
Eq, Eq Stmt
Eq Stmt =>
(Stmt -> Stmt -> Ordering)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Stmt)
-> (Stmt -> Stmt -> Stmt)
-> Ord Stmt
Stmt -> Stmt -> Bool
Stmt -> Stmt -> Ordering
Stmt -> Stmt -> Stmt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Stmt -> Stmt -> Ordering
compare :: Stmt -> Stmt -> Ordering
$c< :: Stmt -> Stmt -> Bool
< :: Stmt -> Stmt -> Bool
$c<= :: Stmt -> Stmt -> Bool
<= :: Stmt -> Stmt -> Bool
$c> :: Stmt -> Stmt -> Bool
> :: Stmt -> Stmt -> Bool
$c>= :: Stmt -> Stmt -> Bool
>= :: Stmt -> Stmt -> Bool
$cmax :: Stmt -> Stmt -> Stmt
max :: Stmt -> Stmt -> Stmt
$cmin :: Stmt -> Stmt -> Stmt
min :: Stmt -> Stmt -> Stmt
Ord, (forall x. Stmt -> Rep Stmt x)
-> (forall x. Rep Stmt x -> Stmt) -> Generic Stmt
forall x. Rep Stmt x -> Stmt
forall x. Stmt -> Rep Stmt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Stmt -> Rep Stmt x
from :: forall x. Stmt -> Rep Stmt x
$cto :: forall x. Rep Stmt x -> Stmt
to :: forall x. Rep Stmt x -> Stmt
Generic )

-- | A list/enum range expression.
data Range = FromR Exp               -- ^ @[n ..]@
           | FromThenR Exp Exp       -- ^ @[n, m ..]@
           | FromToR Exp Exp         -- ^ @[n .. m]@
           | FromThenToR Exp Exp Exp -- ^ @[n, m .. k]@
           deriving( Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Int -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Range -> ShowS
showsPrec :: Int -> Range -> ShowS
$cshow :: Range -> String
show :: Range -> String
$cshowList :: [Range] -> ShowS
showList :: [Range] -> ShowS
Show, Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq, Eq Range
Eq Range =>
(Range -> Range -> Ordering)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Range)
-> (Range -> Range -> Range)
-> Ord Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Range -> Range -> Ordering
compare :: Range -> Range -> Ordering
$c< :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
>= :: Range -> Range -> Bool
$cmax :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
min :: Range -> Range -> Range
Ord, (forall x. Range -> Rep Range x)
-> (forall x. Rep Range x -> Range) -> Generic Range
forall x. Rep Range x -> Range
forall x. Range -> Rep Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Range -> Rep Range x
from :: forall x. Range -> Rep Range x
$cto :: forall x. Rep Range x -> Range
to :: forall x. Rep Range x -> Range
Generic )

-- | A single declaration.
data Dec
  = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@
  | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@
  | DataD Cxt Name [TyVarBndr BndrVis]
          (Maybe Kind)            -- Kind signature (allowed only for GADTs)
          [Con] [DerivClause]
                                  -- ^ @{ data Cxt x => T x = A x | B (T x)
                                  --       deriving (Z,W)
                                  --       deriving stock Eq }@
  | NewtypeD Cxt Name [TyVarBndr BndrVis]
             (Maybe Kind)         -- Kind signature
             Con [DerivClause]    -- ^ @{ newtype Cxt x => T x = A (B x)
                                  --       deriving (Z,W Q)
                                  --       deriving stock Eq }@
  | TypeDataD Name [TyVarBndr BndrVis]
          (Maybe Kind)            -- Kind signature (allowed only for GADTs)
          [Con]                   -- ^ @{ type data T x = A x | B (T x) }@
  | TySynD Name [TyVarBndr BndrVis] Type -- ^ @{ type T x = (x,x) }@
  | ClassD Cxt Name [TyVarBndr BndrVis]
         [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@
  | InstanceD (Maybe Overlap) Cxt Type [Dec]
                                  -- ^ @{ instance {\-\# OVERLAPS \#-\}
                                  --        Show w => Show [w] where ds }@
  | SigD Name Type                -- ^ @{ length :: [a] -> Int }@
  | KiSigD Name Kind              -- ^ @{ type TypeRep :: k -> Type }@
  | ForeignD Foreign              -- ^ @{ foreign import ... }
                                  --{ foreign export ... }@

  | InfixD Fixity NamespaceSpecifier Name
                                  -- ^ @{ infix 3 data foo }@
  | DefaultD [Type]               -- ^ @{ default (Integer, Double) }@

  -- | pragmas
  | PragmaD Pragma                -- ^ @{ {\-\# INLINE [1] foo \#-\} }@

  -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
  | DataFamilyD Name [TyVarBndr BndrVis]
               (Maybe Kind)
         -- ^ @{ data family T a b c :: * }@

  | DataInstD Cxt (Maybe [TyVarBndr ()]) Type
             (Maybe Kind)         -- Kind signature
             [Con] [DerivClause]  -- ^ @{ data instance Cxt x => T [x]
                                  --       = A x | B (T x)
                                  --       deriving (Z,W)
                                  --       deriving stock Eq }@

  | NewtypeInstD Cxt (Maybe [TyVarBndr ()]) Type -- Quantified type vars
                 (Maybe Kind)      -- Kind signature
                 Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x]
                                   --        = A (B x)
                                   --        deriving (Z,W)
                                   --        deriving stock Eq }@
  | TySynInstD TySynEqn            -- ^ @{ type instance ... }@

  -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
  | OpenTypeFamilyD TypeFamilyHead
         -- ^ @{ type family T a b c = (r :: *) | r -> a b }@

  | ClosedTypeFamilyD TypeFamilyHead [TySynEqn]
       -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@

  | RoleAnnotD Name [Role]     -- ^ @{ type role T nominal representational }@
  | StandaloneDerivD (Maybe DerivStrategy) Cxt Type
       -- ^ @{ deriving stock instance Ord a => Ord (Foo a) }@
  | DefaultSigD Name Type      -- ^ @{ default size :: Data a => a -> Int }@

  -- | Pattern Synonyms
  | PatSynD Name PatSynArgs PatSynDir Pat
      -- ^ @{ pattern P v1 v2 .. vn <- p }@  unidirectional           or
      --   @{ pattern P v1 v2 .. vn = p  }@  implicit bidirectional   or
      --   @{ pattern P v1 v2 .. vn <- p
      --        where P v1 v2 .. vn = e  }@  explicit bidirectional
      --
      -- also, besides prefix pattern synonyms, both infix and record
      -- pattern synonyms are supported. See 'PatSynArgs' for details

  | PatSynSigD Name PatSynType  -- ^ A pattern synonym's type signature.

  | ImplicitParamBindD String Exp
      -- ^ @{ ?x = expr }@
      --
      -- Implicit parameter binding declaration. Can only be used in let
      -- and where clauses which consist entirely of implicit bindings.
  deriving( Int -> Dec -> ShowS
[Dec] -> ShowS
Dec -> String
(Int -> Dec -> ShowS)
-> (Dec -> String) -> ([Dec] -> ShowS) -> Show Dec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dec -> ShowS
showsPrec :: Int -> Dec -> ShowS
$cshow :: Dec -> String
show :: Dec -> String
$cshowList :: [Dec] -> ShowS
showList :: [Dec] -> ShowS
Show, Dec -> Dec -> Bool
(Dec -> Dec -> Bool) -> (Dec -> Dec -> Bool) -> Eq Dec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dec -> Dec -> Bool
== :: Dec -> Dec -> Bool
$c/= :: Dec -> Dec -> Bool
/= :: Dec -> Dec -> Bool
Eq, Eq Dec
Eq Dec =>
(Dec -> Dec -> Ordering)
-> (Dec -> Dec -> Bool)
-> (Dec -> Dec -> Bool)
-> (Dec -> Dec -> Bool)
-> (Dec -> Dec -> Bool)
-> (Dec -> Dec -> Dec)
-> (Dec -> Dec -> Dec)
-> Ord Dec
Dec -> Dec -> Bool
Dec -> Dec -> Ordering
Dec -> Dec -> Dec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Dec -> Dec -> Ordering
compare :: Dec -> Dec -> Ordering
$c< :: Dec -> Dec -> Bool
< :: Dec -> Dec -> Bool
$c<= :: Dec -> Dec -> Bool
<= :: Dec -> Dec -> Bool
$c> :: Dec -> Dec -> Bool
> :: Dec -> Dec -> Bool
$c>= :: Dec -> Dec -> Bool
>= :: Dec -> Dec -> Bool
$cmax :: Dec -> Dec -> Dec
max :: Dec -> Dec -> Dec
$cmin :: Dec -> Dec -> Dec
min :: Dec -> Dec -> Dec
Ord, (forall x. Dec -> Rep Dec x)
-> (forall x. Rep Dec x -> Dec) -> Generic Dec
forall x. Rep Dec x -> Dec
forall x. Dec -> Rep Dec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dec -> Rep Dec x
from :: forall x. Dec -> Rep Dec x
$cto :: forall x. Rep Dec x -> Dec
to :: forall x. Rep Dec x -> Dec
Generic )

-- | A way to specify a namespace to look in when GHC needs to find
--   a name's source
data NamespaceSpecifier
  = NoNamespaceSpecifier   -- ^ Name may be everything; If there are two
                           --   names in different namespaces, then consider both
  | TypeNamespaceSpecifier -- ^ Name should be a type-level entity, such as a
                           --   data type, type alias, type family, type class,
                           --   or type variable
  | DataNamespaceSpecifier -- ^ Name should be a term-level entity, such as a
                           --   function, data constructor, or pattern synonym
  deriving( Int -> NamespaceSpecifier -> ShowS
[NamespaceSpecifier] -> ShowS
NamespaceSpecifier -> String
(Int -> NamespaceSpecifier -> ShowS)
-> (NamespaceSpecifier -> String)
-> ([NamespaceSpecifier] -> ShowS)
-> Show NamespaceSpecifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamespaceSpecifier -> ShowS
showsPrec :: Int -> NamespaceSpecifier -> ShowS
$cshow :: NamespaceSpecifier -> String
show :: NamespaceSpecifier -> String
$cshowList :: [NamespaceSpecifier] -> ShowS
showList :: [NamespaceSpecifier] -> ShowS
Show, 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, Eq NamespaceSpecifier
Eq NamespaceSpecifier =>
(NamespaceSpecifier -> NamespaceSpecifier -> Ordering)
-> (NamespaceSpecifier -> NamespaceSpecifier -> Bool)
-> (NamespaceSpecifier -> NamespaceSpecifier -> Bool)
-> (NamespaceSpecifier -> NamespaceSpecifier -> Bool)
-> (NamespaceSpecifier -> NamespaceSpecifier -> Bool)
-> (NamespaceSpecifier -> NamespaceSpecifier -> NamespaceSpecifier)
-> (NamespaceSpecifier -> NamespaceSpecifier -> NamespaceSpecifier)
-> Ord NamespaceSpecifier
NamespaceSpecifier -> NamespaceSpecifier -> Bool
NamespaceSpecifier -> NamespaceSpecifier -> Ordering
NamespaceSpecifier -> NamespaceSpecifier -> NamespaceSpecifier
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NamespaceSpecifier -> NamespaceSpecifier -> Ordering
compare :: NamespaceSpecifier -> NamespaceSpecifier -> Ordering
$c< :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
< :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
$c<= :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
<= :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
$c> :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
> :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
$c>= :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
>= :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
$cmax :: NamespaceSpecifier -> NamespaceSpecifier -> NamespaceSpecifier
max :: NamespaceSpecifier -> NamespaceSpecifier -> NamespaceSpecifier
$cmin :: NamespaceSpecifier -> NamespaceSpecifier -> NamespaceSpecifier
min :: NamespaceSpecifier -> NamespaceSpecifier -> NamespaceSpecifier
Ord, (forall x. NamespaceSpecifier -> Rep NamespaceSpecifier x)
-> (forall x. Rep NamespaceSpecifier x -> NamespaceSpecifier)
-> Generic NamespaceSpecifier
forall x. Rep NamespaceSpecifier x -> NamespaceSpecifier
forall x. NamespaceSpecifier -> Rep NamespaceSpecifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NamespaceSpecifier -> Rep NamespaceSpecifier x
from :: forall x. NamespaceSpecifier -> Rep NamespaceSpecifier x
$cto :: forall x. Rep NamespaceSpecifier x -> NamespaceSpecifier
to :: forall x. Rep NamespaceSpecifier x -> NamespaceSpecifier
Generic )

-- | Varieties of allowed instance overlap.
data Overlap = Overlappable   -- ^ May be overlapped by more specific instances
             | Overlapping    -- ^ May overlap a more general instance
             | Overlaps       -- ^ Both 'Overlapping' and 'Overlappable'
             | Incoherent     -- ^ Both 'Overlapping' and 'Overlappable', and
                              -- pick an arbitrary one if multiple choices are
                              -- available.
  deriving( Int -> Overlap -> ShowS
[Overlap] -> ShowS
Overlap -> String
(Int -> Overlap -> ShowS)
-> (Overlap -> String) -> ([Overlap] -> ShowS) -> Show Overlap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Overlap -> ShowS
showsPrec :: Int -> Overlap -> ShowS
$cshow :: Overlap -> String
show :: Overlap -> String
$cshowList :: [Overlap] -> ShowS
showList :: [Overlap] -> ShowS
Show, Overlap -> Overlap -> Bool
(Overlap -> Overlap -> Bool)
-> (Overlap -> Overlap -> Bool) -> Eq Overlap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Overlap -> Overlap -> Bool
== :: Overlap -> Overlap -> Bool
$c/= :: Overlap -> Overlap -> Bool
/= :: Overlap -> Overlap -> Bool
Eq, Eq Overlap
Eq Overlap =>
(Overlap -> Overlap -> Ordering)
-> (Overlap -> Overlap -> Bool)
-> (Overlap -> Overlap -> Bool)
-> (Overlap -> Overlap -> Bool)
-> (Overlap -> Overlap -> Bool)
-> (Overlap -> Overlap -> Overlap)
-> (Overlap -> Overlap -> Overlap)
-> Ord Overlap
Overlap -> Overlap -> Bool
Overlap -> Overlap -> Ordering
Overlap -> Overlap -> Overlap
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Overlap -> Overlap -> Ordering
compare :: Overlap -> Overlap -> Ordering
$c< :: Overlap -> Overlap -> Bool
< :: Overlap -> Overlap -> Bool
$c<= :: Overlap -> Overlap -> Bool
<= :: Overlap -> Overlap -> Bool
$c> :: Overlap -> Overlap -> Bool
> :: Overlap -> Overlap -> Bool
$c>= :: Overlap -> Overlap -> Bool
>= :: Overlap -> Overlap -> Bool
$cmax :: Overlap -> Overlap -> Overlap
max :: Overlap -> Overlap -> Overlap
$cmin :: Overlap -> Overlap -> Overlap
min :: Overlap -> Overlap -> Overlap
Ord, (forall x. Overlap -> Rep Overlap x)
-> (forall x. Rep Overlap x -> Overlap) -> Generic Overlap
forall x. Rep Overlap x -> Overlap
forall x. Overlap -> Rep Overlap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Overlap -> Rep Overlap x
from :: forall x. Overlap -> Rep Overlap x
$cto :: forall x. Rep Overlap x -> Overlap
to :: forall x. Rep Overlap x -> Overlap
Generic )

-- | A single @deriving@ clause at the end of a datatype declaration.
data DerivClause = DerivClause (Maybe DerivStrategy) Cxt
    -- ^ @{ deriving stock (Eq, Ord) }@
  deriving( Int -> DerivClause -> ShowS
[DerivClause] -> ShowS
DerivClause -> String
(Int -> DerivClause -> ShowS)
-> (DerivClause -> String)
-> ([DerivClause] -> ShowS)
-> Show DerivClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DerivClause -> ShowS
showsPrec :: Int -> DerivClause -> ShowS
$cshow :: DerivClause -> String
show :: DerivClause -> String
$cshowList :: [DerivClause] -> ShowS
showList :: [DerivClause] -> ShowS
Show, DerivClause -> DerivClause -> Bool
(DerivClause -> DerivClause -> Bool)
-> (DerivClause -> DerivClause -> Bool) -> Eq DerivClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DerivClause -> DerivClause -> Bool
== :: DerivClause -> DerivClause -> Bool
$c/= :: DerivClause -> DerivClause -> Bool
/= :: DerivClause -> DerivClause -> Bool
Eq, Eq DerivClause
Eq DerivClause =>
(DerivClause -> DerivClause -> Ordering)
-> (DerivClause -> DerivClause -> Bool)
-> (DerivClause -> DerivClause -> Bool)
-> (DerivClause -> DerivClause -> Bool)
-> (DerivClause -> DerivClause -> Bool)
-> (DerivClause -> DerivClause -> DerivClause)
-> (DerivClause -> DerivClause -> DerivClause)
-> Ord DerivClause
DerivClause -> DerivClause -> Bool
DerivClause -> DerivClause -> Ordering
DerivClause -> DerivClause -> DerivClause
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DerivClause -> DerivClause -> Ordering
compare :: DerivClause -> DerivClause -> Ordering
$c< :: DerivClause -> DerivClause -> Bool
< :: DerivClause -> DerivClause -> Bool
$c<= :: DerivClause -> DerivClause -> Bool
<= :: DerivClause -> DerivClause -> Bool
$c> :: DerivClause -> DerivClause -> Bool
> :: DerivClause -> DerivClause -> Bool
$c>= :: DerivClause -> DerivClause -> Bool
>= :: DerivClause -> DerivClause -> Bool
$cmax :: DerivClause -> DerivClause -> DerivClause
max :: DerivClause -> DerivClause -> DerivClause
$cmin :: DerivClause -> DerivClause -> DerivClause
min :: DerivClause -> DerivClause -> DerivClause
Ord, (forall x. DerivClause -> Rep DerivClause x)
-> (forall x. Rep DerivClause x -> DerivClause)
-> Generic DerivClause
forall x. Rep DerivClause x -> DerivClause
forall x. DerivClause -> Rep DerivClause x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DerivClause -> Rep DerivClause x
from :: forall x. DerivClause -> Rep DerivClause x
$cto :: forall x. Rep DerivClause x -> DerivClause
to :: forall x. Rep DerivClause x -> DerivClause
Generic )

-- | What the user explicitly requests when deriving an instance with
-- @-XDerivingStrategies@.
data DerivStrategy = StockStrategy    -- ^ @deriving {stock} C@
                   | AnyclassStrategy -- ^ @deriving {anyclass} C@, @-XDeriveAnyClass@
                   | NewtypeStrategy  -- ^ @deriving {newtype} C@, @-XGeneralizedNewtypeDeriving@
                   | ViaStrategy Type -- ^ @deriving C {via T}@, @-XDerivingVia@
  deriving( Int -> DerivStrategy -> ShowS
[DerivStrategy] -> ShowS
DerivStrategy -> String
(Int -> DerivStrategy -> ShowS)
-> (DerivStrategy -> String)
-> ([DerivStrategy] -> ShowS)
-> Show DerivStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DerivStrategy -> ShowS
showsPrec :: Int -> DerivStrategy -> ShowS
$cshow :: DerivStrategy -> String
show :: DerivStrategy -> String
$cshowList :: [DerivStrategy] -> ShowS
showList :: [DerivStrategy] -> ShowS
Show, DerivStrategy -> DerivStrategy -> Bool
(DerivStrategy -> DerivStrategy -> Bool)
-> (DerivStrategy -> DerivStrategy -> Bool) -> Eq DerivStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DerivStrategy -> DerivStrategy -> Bool
== :: DerivStrategy -> DerivStrategy -> Bool
$c/= :: DerivStrategy -> DerivStrategy -> Bool
/= :: DerivStrategy -> DerivStrategy -> Bool
Eq, Eq DerivStrategy
Eq DerivStrategy =>
(DerivStrategy -> DerivStrategy -> Ordering)
-> (DerivStrategy -> DerivStrategy -> Bool)
-> (DerivStrategy -> DerivStrategy -> Bool)
-> (DerivStrategy -> DerivStrategy -> Bool)
-> (DerivStrategy -> DerivStrategy -> Bool)
-> (DerivStrategy -> DerivStrategy -> DerivStrategy)
-> (DerivStrategy -> DerivStrategy -> DerivStrategy)
-> Ord DerivStrategy
DerivStrategy -> DerivStrategy -> Bool
DerivStrategy -> DerivStrategy -> Ordering
DerivStrategy -> DerivStrategy -> DerivStrategy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DerivStrategy -> DerivStrategy -> Ordering
compare :: DerivStrategy -> DerivStrategy -> Ordering
$c< :: DerivStrategy -> DerivStrategy -> Bool
< :: DerivStrategy -> DerivStrategy -> Bool
$c<= :: DerivStrategy -> DerivStrategy -> Bool
<= :: DerivStrategy -> DerivStrategy -> Bool
$c> :: DerivStrategy -> DerivStrategy -> Bool
> :: DerivStrategy -> DerivStrategy -> Bool
$c>= :: DerivStrategy -> DerivStrategy -> Bool
>= :: DerivStrategy -> DerivStrategy -> Bool
$cmax :: DerivStrategy -> DerivStrategy -> DerivStrategy
max :: DerivStrategy -> DerivStrategy -> DerivStrategy
$cmin :: DerivStrategy -> DerivStrategy -> DerivStrategy
min :: DerivStrategy -> DerivStrategy -> DerivStrategy
Ord, (forall x. DerivStrategy -> Rep DerivStrategy x)
-> (forall x. Rep DerivStrategy x -> DerivStrategy)
-> Generic DerivStrategy
forall x. Rep DerivStrategy x -> DerivStrategy
forall x. DerivStrategy -> Rep DerivStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DerivStrategy -> Rep DerivStrategy x
from :: forall x. DerivStrategy -> Rep DerivStrategy x
$cto :: forall x. Rep DerivStrategy x -> DerivStrategy
to :: forall x. Rep DerivStrategy x -> DerivStrategy
Generic )

-- | A pattern synonym's type. Note that a pattern synonym's /fully/
-- specified type has a peculiar shape coming with two forall
-- quantifiers and two constraint contexts. For example, consider the
-- pattern synonym
--
-- > pattern P x1 x2 ... xn = <some-pattern>
--
-- P's complete type is of the following form
--
-- > pattern P :: forall universals.   required constraints
-- >           => forall existentials. provided constraints
-- >           => t1 -> t2 -> ... -> tn -> t
--
-- consisting of four parts:
--
--   1. the (possibly empty lists of) universally quantified type
--      variables and required constraints on them.
--   2. the (possibly empty lists of) existentially quantified
--      type variables and the provided constraints on them.
--   3. the types @t1@, @t2@, .., @tn@ of @x1@, @x2@, .., @xn@, respectively
--   4. the type @t@ of @\<some-pattern\>@, mentioning only universals.
--
-- Pattern synonym types interact with TH when (a) reifying a pattern
-- synonym, (b) pretty printing, or (c) specifying a pattern synonym's
-- type signature explicitly:
--
--   * Reification always returns a pattern synonym's /fully/ specified
--     type in abstract syntax.
--
--   * Pretty printing via 'Language.Haskell.TH.Ppr.pprPatSynType' abbreviates
--     a pattern synonym's type unambiguously in concrete syntax: The rule of
--     thumb is to print initial empty universals and the required
--     context as @() =>@, if existentials and a provided context
--     follow. If only universals and their required context, but no
--     existentials are specified, only the universals and their
--     required context are printed. If both or none are specified, so
--     both (or none) are printed.
--
--   * When specifying a pattern synonym's type explicitly with
--     'PatSynSigD' either one of the universals, the existentials, or
--     their contexts may be left empty.
--
-- See the GHC user's guide for more information on pattern synonyms
-- and their types:
-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#pattern-synonyms>.
type PatSynType = Type

-- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By
-- analogy with "head" for type classes and type class instances as
-- defined in /Type classes: an exploration of the design space/, the
-- @TypeFamilyHead@ is defined to be the elements of the declaration
-- between @type family@ and @where@.
data TypeFamilyHead =
  TypeFamilyHead Name [TyVarBndr BndrVis] FamilyResultSig (Maybe InjectivityAnn)
  deriving( Int -> TypeFamilyHead -> ShowS
[TypeFamilyHead] -> ShowS
TypeFamilyHead -> String
(Int -> TypeFamilyHead -> ShowS)
-> (TypeFamilyHead -> String)
-> ([TypeFamilyHead] -> ShowS)
-> Show TypeFamilyHead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeFamilyHead -> ShowS
showsPrec :: Int -> TypeFamilyHead -> ShowS
$cshow :: TypeFamilyHead -> String
show :: TypeFamilyHead -> String
$cshowList :: [TypeFamilyHead] -> ShowS
showList :: [TypeFamilyHead] -> ShowS
Show, TypeFamilyHead -> TypeFamilyHead -> Bool
(TypeFamilyHead -> TypeFamilyHead -> Bool)
-> (TypeFamilyHead -> TypeFamilyHead -> Bool) -> Eq TypeFamilyHead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeFamilyHead -> TypeFamilyHead -> Bool
== :: TypeFamilyHead -> TypeFamilyHead -> Bool
$c/= :: TypeFamilyHead -> TypeFamilyHead -> Bool
/= :: TypeFamilyHead -> TypeFamilyHead -> Bool
Eq, Eq TypeFamilyHead
Eq TypeFamilyHead =>
(TypeFamilyHead -> TypeFamilyHead -> Ordering)
-> (TypeFamilyHead -> TypeFamilyHead -> Bool)
-> (TypeFamilyHead -> TypeFamilyHead -> Bool)
-> (TypeFamilyHead -> TypeFamilyHead -> Bool)
-> (TypeFamilyHead -> TypeFamilyHead -> Bool)
-> (TypeFamilyHead -> TypeFamilyHead -> TypeFamilyHead)
-> (TypeFamilyHead -> TypeFamilyHead -> TypeFamilyHead)
-> Ord TypeFamilyHead
TypeFamilyHead -> TypeFamilyHead -> Bool
TypeFamilyHead -> TypeFamilyHead -> Ordering
TypeFamilyHead -> TypeFamilyHead -> TypeFamilyHead
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeFamilyHead -> TypeFamilyHead -> Ordering
compare :: TypeFamilyHead -> TypeFamilyHead -> Ordering
$c< :: TypeFamilyHead -> TypeFamilyHead -> Bool
< :: TypeFamilyHead -> TypeFamilyHead -> Bool
$c<= :: TypeFamilyHead -> TypeFamilyHead -> Bool
<= :: TypeFamilyHead -> TypeFamilyHead -> Bool
$c> :: TypeFamilyHead -> TypeFamilyHead -> Bool
> :: TypeFamilyHead -> TypeFamilyHead -> Bool
$c>= :: TypeFamilyHead -> TypeFamilyHead -> Bool
>= :: TypeFamilyHead -> TypeFamilyHead -> Bool
$cmax :: TypeFamilyHead -> TypeFamilyHead -> TypeFamilyHead
max :: TypeFamilyHead -> TypeFamilyHead -> TypeFamilyHead
$cmin :: TypeFamilyHead -> TypeFamilyHead -> TypeFamilyHead
min :: TypeFamilyHead -> TypeFamilyHead -> TypeFamilyHead
Ord, (forall x. TypeFamilyHead -> Rep TypeFamilyHead x)
-> (forall x. Rep TypeFamilyHead x -> TypeFamilyHead)
-> Generic TypeFamilyHead
forall x. Rep TypeFamilyHead x -> TypeFamilyHead
forall x. TypeFamilyHead -> Rep TypeFamilyHead x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeFamilyHead -> Rep TypeFamilyHead x
from :: forall x. TypeFamilyHead -> Rep TypeFamilyHead x
$cto :: forall x. Rep TypeFamilyHead x -> TypeFamilyHead
to :: forall x. Rep TypeFamilyHead x -> TypeFamilyHead
Generic )

-- | One equation of a type family instance or closed type family. The
-- arguments are the left-hand-side type and the right-hand-side result.
--
-- For instance, if you had the following type family:
--
-- @
-- type family Foo (a :: k) :: k where
--   forall k (a :: k). Foo \@k a = a
-- @
--
-- The @Foo \@k a = a@ equation would be represented as follows:
--
-- @
-- 'TySynEqn' ('Just' ['PlainTV' k, 'KindedTV' a ('VarT' k)])
--            ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a))
--            ('VarT' a)
-- @
data TySynEqn = TySynEqn (Maybe [TyVarBndr ()]) Type Type
  deriving( Int -> TySynEqn -> ShowS
[TySynEqn] -> ShowS
TySynEqn -> String
(Int -> TySynEqn -> ShowS)
-> (TySynEqn -> String) -> ([TySynEqn] -> ShowS) -> Show TySynEqn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TySynEqn -> ShowS
showsPrec :: Int -> TySynEqn -> ShowS
$cshow :: TySynEqn -> String
show :: TySynEqn -> String
$cshowList :: [TySynEqn] -> ShowS
showList :: [TySynEqn] -> ShowS
Show, TySynEqn -> TySynEqn -> Bool
(TySynEqn -> TySynEqn -> Bool)
-> (TySynEqn -> TySynEqn -> Bool) -> Eq TySynEqn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TySynEqn -> TySynEqn -> Bool
== :: TySynEqn -> TySynEqn -> Bool
$c/= :: TySynEqn -> TySynEqn -> Bool
/= :: TySynEqn -> TySynEqn -> Bool
Eq, Eq TySynEqn
Eq TySynEqn =>
(TySynEqn -> TySynEqn -> Ordering)
-> (TySynEqn -> TySynEqn -> Bool)
-> (TySynEqn -> TySynEqn -> Bool)
-> (TySynEqn -> TySynEqn -> Bool)
-> (TySynEqn -> TySynEqn -> Bool)
-> (TySynEqn -> TySynEqn -> TySynEqn)
-> (TySynEqn -> TySynEqn -> TySynEqn)
-> Ord TySynEqn
TySynEqn -> TySynEqn -> Bool
TySynEqn -> TySynEqn -> Ordering
TySynEqn -> TySynEqn -> TySynEqn
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TySynEqn -> TySynEqn -> Ordering
compare :: TySynEqn -> TySynEqn -> Ordering
$c< :: TySynEqn -> TySynEqn -> Bool
< :: TySynEqn -> TySynEqn -> Bool
$c<= :: TySynEqn -> TySynEqn -> Bool
<= :: TySynEqn -> TySynEqn -> Bool
$c> :: TySynEqn -> TySynEqn -> Bool
> :: TySynEqn -> TySynEqn -> Bool
$c>= :: TySynEqn -> TySynEqn -> Bool
>= :: TySynEqn -> TySynEqn -> Bool
$cmax :: TySynEqn -> TySynEqn -> TySynEqn
max :: TySynEqn -> TySynEqn -> TySynEqn
$cmin :: TySynEqn -> TySynEqn -> TySynEqn
min :: TySynEqn -> TySynEqn -> TySynEqn
Ord, (forall x. TySynEqn -> Rep TySynEqn x)
-> (forall x. Rep TySynEqn x -> TySynEqn) -> Generic TySynEqn
forall x. Rep TySynEqn x -> TySynEqn
forall x. TySynEqn -> Rep TySynEqn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TySynEqn -> Rep TySynEqn x
from :: forall x. TySynEqn -> Rep TySynEqn x
$cto :: forall x. Rep TySynEqn x -> TySynEqn
to :: forall x. Rep TySynEqn x -> TySynEqn
Generic )

-- | [Functional dependency](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/functional_dependencies.html)
-- syntax, as in a class declaration.
data FunDep = FunDep [Name] [Name] -- ^ @class C a b {| a -> b}@
  deriving( Int -> FunDep -> ShowS
[FunDep] -> ShowS
FunDep -> String
(Int -> FunDep -> ShowS)
-> (FunDep -> String) -> ([FunDep] -> ShowS) -> Show FunDep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunDep -> ShowS
showsPrec :: Int -> FunDep -> ShowS
$cshow :: FunDep -> String
show :: FunDep -> String
$cshowList :: [FunDep] -> ShowS
showList :: [FunDep] -> ShowS
Show, FunDep -> FunDep -> Bool
(FunDep -> FunDep -> Bool)
-> (FunDep -> FunDep -> Bool) -> Eq FunDep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunDep -> FunDep -> Bool
== :: FunDep -> FunDep -> Bool
$c/= :: FunDep -> FunDep -> Bool
/= :: FunDep -> FunDep -> Bool
Eq, Eq FunDep
Eq FunDep =>
(FunDep -> FunDep -> Ordering)
-> (FunDep -> FunDep -> Bool)
-> (FunDep -> FunDep -> Bool)
-> (FunDep -> FunDep -> Bool)
-> (FunDep -> FunDep -> Bool)
-> (FunDep -> FunDep -> FunDep)
-> (FunDep -> FunDep -> FunDep)
-> Ord FunDep
FunDep -> FunDep -> Bool
FunDep -> FunDep -> Ordering
FunDep -> FunDep -> FunDep
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FunDep -> FunDep -> Ordering
compare :: FunDep -> FunDep -> Ordering
$c< :: FunDep -> FunDep -> Bool
< :: FunDep -> FunDep -> Bool
$c<= :: FunDep -> FunDep -> Bool
<= :: FunDep -> FunDep -> Bool
$c> :: FunDep -> FunDep -> Bool
> :: FunDep -> FunDep -> Bool
$c>= :: FunDep -> FunDep -> Bool
>= :: FunDep -> FunDep -> Bool
$cmax :: FunDep -> FunDep -> FunDep
max :: FunDep -> FunDep -> FunDep
$cmin :: FunDep -> FunDep -> FunDep
min :: FunDep -> FunDep -> FunDep
Ord, (forall x. FunDep -> Rep FunDep x)
-> (forall x. Rep FunDep x -> FunDep) -> Generic FunDep
forall x. Rep FunDep x -> FunDep
forall x. FunDep -> Rep FunDep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunDep -> Rep FunDep x
from :: forall x. FunDep -> Rep FunDep x
$cto :: forall x. Rep FunDep x -> FunDep
to :: forall x. Rep FunDep x -> FunDep
Generic )

-- | A @foreign@ declaration.
data Foreign = ImportF Callconv Safety String Name Type
             -- ^ @foreign import callconv safety "foreign_name" haskellName :: type@
             | ExportF Callconv        String Name Type
             -- ^ @foreign export callconv "foreign_name" haskellName :: type@
         deriving( Int -> Foreign -> ShowS
[Foreign] -> ShowS
Foreign -> String
(Int -> Foreign -> ShowS)
-> (Foreign -> String) -> ([Foreign] -> ShowS) -> Show Foreign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Foreign -> ShowS
showsPrec :: Int -> Foreign -> ShowS
$cshow :: Foreign -> String
show :: Foreign -> String
$cshowList :: [Foreign] -> ShowS
showList :: [Foreign] -> ShowS
Show, Foreign -> Foreign -> Bool
(Foreign -> Foreign -> Bool)
-> (Foreign -> Foreign -> Bool) -> Eq Foreign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Foreign -> Foreign -> Bool
== :: Foreign -> Foreign -> Bool
$c/= :: Foreign -> Foreign -> Bool
/= :: Foreign -> Foreign -> Bool
Eq, Eq Foreign
Eq Foreign =>
(Foreign -> Foreign -> Ordering)
-> (Foreign -> Foreign -> Bool)
-> (Foreign -> Foreign -> Bool)
-> (Foreign -> Foreign -> Bool)
-> (Foreign -> Foreign -> Bool)
-> (Foreign -> Foreign -> Foreign)
-> (Foreign -> Foreign -> Foreign)
-> Ord Foreign
Foreign -> Foreign -> Bool
Foreign -> Foreign -> Ordering
Foreign -> Foreign -> Foreign
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Foreign -> Foreign -> Ordering
compare :: Foreign -> Foreign -> Ordering
$c< :: Foreign -> Foreign -> Bool
< :: Foreign -> Foreign -> Bool
$c<= :: Foreign -> Foreign -> Bool
<= :: Foreign -> Foreign -> Bool
$c> :: Foreign -> Foreign -> Bool
> :: Foreign -> Foreign -> Bool
$c>= :: Foreign -> Foreign -> Bool
>= :: Foreign -> Foreign -> Bool
$cmax :: Foreign -> Foreign -> Foreign
max :: Foreign -> Foreign -> Foreign
$cmin :: Foreign -> Foreign -> Foreign
min :: Foreign -> Foreign -> Foreign
Ord, (forall x. Foreign -> Rep Foreign x)
-> (forall x. Rep Foreign x -> Foreign) -> Generic Foreign
forall x. Rep Foreign x -> Foreign
forall x. Foreign -> Rep Foreign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Foreign -> Rep Foreign x
from :: forall x. Foreign -> Rep Foreign x
$cto :: forall x. Rep Foreign x -> Foreign
to :: forall x. Rep Foreign x -> Foreign
Generic )

-- keep Callconv in sync with module ForeignCall in ghc/compiler/GHC/Types/ForeignCall.hs
-- | A calling convention identifier, as in a 'Foreign' declaration.
data Callconv = CCall | StdCall | CApi | Prim | JavaScript
          deriving( Int -> Callconv -> ShowS
[Callconv] -> ShowS
Callconv -> String
(Int -> Callconv -> ShowS)
-> (Callconv -> String) -> ([Callconv] -> ShowS) -> Show Callconv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Callconv -> ShowS
showsPrec :: Int -> Callconv -> ShowS
$cshow :: Callconv -> String
show :: Callconv -> String
$cshowList :: [Callconv] -> ShowS
showList :: [Callconv] -> ShowS
Show, Callconv -> Callconv -> Bool
(Callconv -> Callconv -> Bool)
-> (Callconv -> Callconv -> Bool) -> Eq Callconv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Callconv -> Callconv -> Bool
== :: Callconv -> Callconv -> Bool
$c/= :: Callconv -> Callconv -> Bool
/= :: Callconv -> Callconv -> Bool
Eq, Eq Callconv
Eq Callconv =>
(Callconv -> Callconv -> Ordering)
-> (Callconv -> Callconv -> Bool)
-> (Callconv -> Callconv -> Bool)
-> (Callconv -> Callconv -> Bool)
-> (Callconv -> Callconv -> Bool)
-> (Callconv -> Callconv -> Callconv)
-> (Callconv -> Callconv -> Callconv)
-> Ord Callconv
Callconv -> Callconv -> Bool
Callconv -> Callconv -> Ordering
Callconv -> Callconv -> Callconv
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Callconv -> Callconv -> Ordering
compare :: Callconv -> Callconv -> Ordering
$c< :: Callconv -> Callconv -> Bool
< :: Callconv -> Callconv -> Bool
$c<= :: Callconv -> Callconv -> Bool
<= :: Callconv -> Callconv -> Bool
$c> :: Callconv -> Callconv -> Bool
> :: Callconv -> Callconv -> Bool
$c>= :: Callconv -> Callconv -> Bool
>= :: Callconv -> Callconv -> Bool
$cmax :: Callconv -> Callconv -> Callconv
max :: Callconv -> Callconv -> Callconv
$cmin :: Callconv -> Callconv -> Callconv
min :: Callconv -> Callconv -> Callconv
Ord, (forall x. Callconv -> Rep Callconv x)
-> (forall x. Rep Callconv x -> Callconv) -> Generic Callconv
forall x. Rep Callconv x -> Callconv
forall x. Callconv -> Rep Callconv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Callconv -> Rep Callconv x
from :: forall x. Callconv -> Rep Callconv x
$cto :: forall x. Rep Callconv x -> Callconv
to :: forall x. Rep Callconv x -> Callconv
Generic )

-- | A safety level, as in a 'Foreign' declaration.
data Safety = Unsafe | Safe | Interruptible
        deriving( Int -> Safety -> ShowS
[Safety] -> ShowS
Safety -> String
(Int -> Safety -> ShowS)
-> (Safety -> String) -> ([Safety] -> ShowS) -> Show Safety
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Safety -> ShowS
showsPrec :: Int -> Safety -> ShowS
$cshow :: Safety -> String
show :: Safety -> String
$cshowList :: [Safety] -> ShowS
showList :: [Safety] -> ShowS
Show, Safety -> Safety -> Bool
(Safety -> Safety -> Bool)
-> (Safety -> Safety -> Bool) -> Eq Safety
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Safety -> Safety -> Bool
== :: Safety -> Safety -> Bool
$c/= :: Safety -> Safety -> Bool
/= :: Safety -> Safety -> Bool
Eq, Eq Safety
Eq Safety =>
(Safety -> Safety -> Ordering)
-> (Safety -> Safety -> Bool)
-> (Safety -> Safety -> Bool)
-> (Safety -> Safety -> Bool)
-> (Safety -> Safety -> Bool)
-> (Safety -> Safety -> Safety)
-> (Safety -> Safety -> Safety)
-> Ord Safety
Safety -> Safety -> Bool
Safety -> Safety -> Ordering
Safety -> Safety -> Safety
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Safety -> Safety -> Ordering
compare :: Safety -> Safety -> Ordering
$c< :: Safety -> Safety -> Bool
< :: Safety -> Safety -> Bool
$c<= :: Safety -> Safety -> Bool
<= :: Safety -> Safety -> Bool
$c> :: Safety -> Safety -> Bool
> :: Safety -> Safety -> Bool
$c>= :: Safety -> Safety -> Bool
>= :: Safety -> Safety -> Bool
$cmax :: Safety -> Safety -> Safety
max :: Safety -> Safety -> Safety
$cmin :: Safety -> Safety -> Safety
min :: Safety -> Safety -> Safety
Ord, (forall x. Safety -> Rep Safety x)
-> (forall x. Rep Safety x -> Safety) -> Generic Safety
forall x. Rep Safety x -> Safety
forall x. Safety -> Rep Safety x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Safety -> Rep Safety x
from :: forall x. Safety -> Rep Safety x
$cto :: forall x. Rep Safety x -> Safety
to :: forall x. Rep Safety x -> Safety
Generic )

data Pragma = InlineP         Name Inline RuleMatch Phases
            -- ^ @{ {\-\# [inline] [rule match] [phases] [phases] name #-} }@. See
            -- 'Inline' and 'RuleMatch'.
            | OpaqueP         Name
            -- ^ @{ {\-\# OPAQUE T #-} }@
            | SpecialiseEP    (Maybe [TyVarBndr ()]) [RuleBndr] Exp (Maybe Inline) Phases
            -- ^ @{ {\-\# SPECIALISE [forall t_1 ... t_i]. [forall b_1 ... b_j] [INLINE] [phases] exp #-} }@
            | SpecialiseInstP Type
            -- ^ @{ {\-\# SPECIALISE instance I #-} }@
            | RuleP           String (Maybe [TyVarBndr ()]) [RuleBndr] Exp Exp Phases
            -- ^ @{ {\-\# RULES "name" [phases] [forall t_1 ... t_i]. [forall b_1 ... b_j] rules... e_1 = e_2 #-} }@
            | AnnP            AnnTarget Exp
            -- ^ @{ {\-\# ANN target exp #-} }@
            | LineP           Int String
            -- ^ @{ {\-\# LINE n "file name" #-} }@
            | CompleteP       [Name] (Maybe Name)
                -- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@
            | SCCP            Name (Maybe String)
                -- ^ @{ {\-\# SCC fun "optional_name" \#-} }@
        deriving( Int -> Pragma -> ShowS
[Pragma] -> ShowS
Pragma -> String
(Int -> Pragma -> ShowS)
-> (Pragma -> String) -> ([Pragma] -> ShowS) -> Show Pragma
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pragma -> ShowS
showsPrec :: Int -> Pragma -> ShowS
$cshow :: Pragma -> String
show :: Pragma -> String
$cshowList :: [Pragma] -> ShowS
showList :: [Pragma] -> ShowS
Show, Pragma -> Pragma -> Bool
(Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool) -> Eq Pragma
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pragma -> Pragma -> Bool
== :: Pragma -> Pragma -> Bool
$c/= :: Pragma -> Pragma -> Bool
/= :: Pragma -> Pragma -> Bool
Eq, Eq Pragma
Eq Pragma =>
(Pragma -> Pragma -> Ordering)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Bool)
-> (Pragma -> Pragma -> Pragma)
-> (Pragma -> Pragma -> Pragma)
-> Ord Pragma
Pragma -> Pragma -> Bool
Pragma -> Pragma -> Ordering
Pragma -> Pragma -> Pragma
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pragma -> Pragma -> Ordering
compare :: Pragma -> Pragma -> Ordering
$c< :: Pragma -> Pragma -> Bool
< :: Pragma -> Pragma -> Bool
$c<= :: Pragma -> Pragma -> Bool
<= :: Pragma -> Pragma -> Bool
$c> :: Pragma -> Pragma -> Bool
> :: Pragma -> Pragma -> Bool
$c>= :: Pragma -> Pragma -> Bool
>= :: Pragma -> Pragma -> Bool
$cmax :: Pragma -> Pragma -> Pragma
max :: Pragma -> Pragma -> Pragma
$cmin :: Pragma -> Pragma -> Pragma
min :: Pragma -> Pragma -> Pragma
Ord, (forall x. Pragma -> Rep Pragma x)
-> (forall x. Rep Pragma x -> Pragma) -> Generic Pragma
forall x. Rep Pragma x -> Pragma
forall x. Pragma -> Rep Pragma x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Pragma -> Rep Pragma x
from :: forall x. Pragma -> Rep Pragma x
$cto :: forall x. Rep Pragma x -> Pragma
to :: forall x. Rep Pragma x -> Pragma
Generic )

-- | An inline pragma.
data Inline = NoInline
            -- ^ @{ {\-\# NOINLINE ... #-} }@
            | Inline
            -- ^ @{ {\-\# INLINE ... #-} }@
            | Inlinable
            -- ^ @{ {\-\# INLINABLE ... #-} }@
            deriving (Int -> Inline -> ShowS
[Inline] -> ShowS
Inline -> String
(Int -> Inline -> ShowS)
-> (Inline -> String) -> ([Inline] -> ShowS) -> Show Inline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inline -> ShowS
showsPrec :: Int -> Inline -> ShowS
$cshow :: Inline -> String
show :: Inline -> String
$cshowList :: [Inline] -> ShowS
showList :: [Inline] -> ShowS
Show, Inline -> Inline -> Bool
(Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool) -> Eq Inline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Inline -> Inline -> Bool
== :: Inline -> Inline -> Bool
$c/= :: Inline -> Inline -> Bool
/= :: Inline -> Inline -> Bool
Eq, Eq Inline
Eq Inline =>
(Inline -> Inline -> Ordering)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool)
-> (Inline -> Inline -> Inline)
-> (Inline -> Inline -> Inline)
-> Ord Inline
Inline -> Inline -> Bool
Inline -> Inline -> Ordering
Inline -> Inline -> Inline
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Inline -> Inline -> Ordering
compare :: Inline -> Inline -> Ordering
$c< :: Inline -> Inline -> Bool
< :: Inline -> Inline -> Bool
$c<= :: Inline -> Inline -> Bool
<= :: Inline -> Inline -> Bool
$c> :: Inline -> Inline -> Bool
> :: Inline -> Inline -> Bool
$c>= :: Inline -> Inline -> Bool
>= :: Inline -> Inline -> Bool
$cmax :: Inline -> Inline -> Inline
max :: Inline -> Inline -> Inline
$cmin :: Inline -> Inline -> Inline
min :: Inline -> Inline -> Inline
Ord, (forall x. Inline -> Rep Inline x)
-> (forall x. Rep Inline x -> Inline) -> Generic Inline
forall x. Rep Inline x -> Inline
forall x. Inline -> Rep Inline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Inline -> Rep Inline x
from :: forall x. Inline -> Rep Inline x
$cto :: forall x. Rep Inline x -> Inline
to :: forall x. Rep Inline x -> Inline
Generic)

-- | A @CONLIKE@ modifier, as in one of the various inline pragmas, or lack
-- thereof ('FunLike').
data RuleMatch = ConLike
               -- ^ @{ {\-\# CONLIKE [inline] ... #-} }@
               | FunLike
               -- ^ @{ {\-\# [inline] ... #-} }@
               deriving (Int -> RuleMatch -> ShowS
[RuleMatch] -> ShowS
RuleMatch -> String
(Int -> RuleMatch -> ShowS)
-> (RuleMatch -> String)
-> ([RuleMatch] -> ShowS)
-> Show RuleMatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuleMatch -> ShowS
showsPrec :: Int -> RuleMatch -> ShowS
$cshow :: RuleMatch -> String
show :: RuleMatch -> String
$cshowList :: [RuleMatch] -> ShowS
showList :: [RuleMatch] -> ShowS
Show, RuleMatch -> RuleMatch -> Bool
(RuleMatch -> RuleMatch -> Bool)
-> (RuleMatch -> RuleMatch -> Bool) -> Eq RuleMatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuleMatch -> RuleMatch -> Bool
== :: RuleMatch -> RuleMatch -> Bool
$c/= :: RuleMatch -> RuleMatch -> Bool
/= :: RuleMatch -> RuleMatch -> Bool
Eq, Eq RuleMatch
Eq RuleMatch =>
(RuleMatch -> RuleMatch -> Ordering)
-> (RuleMatch -> RuleMatch -> Bool)
-> (RuleMatch -> RuleMatch -> Bool)
-> (RuleMatch -> RuleMatch -> Bool)
-> (RuleMatch -> RuleMatch -> Bool)
-> (RuleMatch -> RuleMatch -> RuleMatch)
-> (RuleMatch -> RuleMatch -> RuleMatch)
-> Ord RuleMatch
RuleMatch -> RuleMatch -> Bool
RuleMatch -> RuleMatch -> Ordering
RuleMatch -> RuleMatch -> RuleMatch
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RuleMatch -> RuleMatch -> Ordering
compare :: RuleMatch -> RuleMatch -> Ordering
$c< :: RuleMatch -> RuleMatch -> Bool
< :: RuleMatch -> RuleMatch -> Bool
$c<= :: RuleMatch -> RuleMatch -> Bool
<= :: RuleMatch -> RuleMatch -> Bool
$c> :: RuleMatch -> RuleMatch -> Bool
> :: RuleMatch -> RuleMatch -> Bool
$c>= :: RuleMatch -> RuleMatch -> Bool
>= :: RuleMatch -> RuleMatch -> Bool
$cmax :: RuleMatch -> RuleMatch -> RuleMatch
max :: RuleMatch -> RuleMatch -> RuleMatch
$cmin :: RuleMatch -> RuleMatch -> RuleMatch
min :: RuleMatch -> RuleMatch -> RuleMatch
Ord, (forall x. RuleMatch -> Rep RuleMatch x)
-> (forall x. Rep RuleMatch x -> RuleMatch) -> Generic RuleMatch
forall x. Rep RuleMatch x -> RuleMatch
forall x. RuleMatch -> Rep RuleMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RuleMatch -> Rep RuleMatch x
from :: forall x. RuleMatch -> Rep RuleMatch x
$cto :: forall x. Rep RuleMatch x -> RuleMatch
to :: forall x. Rep RuleMatch x -> RuleMatch
Generic)

-- | Phase control syntax.
data Phases = AllPhases
            -- ^ The default when unspecified
            | FromPhase Int
            -- ^ @[n]@
            | BeforePhase Int
            -- ^ @[~n]@
            deriving (Int -> Phases -> ShowS
[Phases] -> ShowS
Phases -> String
(Int -> Phases -> ShowS)
-> (Phases -> String) -> ([Phases] -> ShowS) -> Show Phases
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Phases -> ShowS
showsPrec :: Int -> Phases -> ShowS
$cshow :: Phases -> String
show :: Phases -> String
$cshowList :: [Phases] -> ShowS
showList :: [Phases] -> ShowS
Show, Phases -> Phases -> Bool
(Phases -> Phases -> Bool)
-> (Phases -> Phases -> Bool) -> Eq Phases
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Phases -> Phases -> Bool
== :: Phases -> Phases -> Bool
$c/= :: Phases -> Phases -> Bool
/= :: Phases -> Phases -> Bool
Eq, Eq Phases
Eq Phases =>
(Phases -> Phases -> Ordering)
-> (Phases -> Phases -> Bool)
-> (Phases -> Phases -> Bool)
-> (Phases -> Phases -> Bool)
-> (Phases -> Phases -> Bool)
-> (Phases -> Phases -> Phases)
-> (Phases -> Phases -> Phases)
-> Ord Phases
Phases -> Phases -> Bool
Phases -> Phases -> Ordering
Phases -> Phases -> Phases
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Phases -> Phases -> Ordering
compare :: Phases -> Phases -> Ordering
$c< :: Phases -> Phases -> Bool
< :: Phases -> Phases -> Bool
$c<= :: Phases -> Phases -> Bool
<= :: Phases -> Phases -> Bool
$c> :: Phases -> Phases -> Bool
> :: Phases -> Phases -> Bool
$c>= :: Phases -> Phases -> Bool
>= :: Phases -> Phases -> Bool
$cmax :: Phases -> Phases -> Phases
max :: Phases -> Phases -> Phases
$cmin :: Phases -> Phases -> Phases
min :: Phases -> Phases -> Phases
Ord, (forall x. Phases -> Rep Phases x)
-> (forall x. Rep Phases x -> Phases) -> Generic Phases
forall x. Rep Phases x -> Phases
forall x. Phases -> Rep Phases x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Phases -> Rep Phases x
from :: forall x. Phases -> Rep Phases x
$cto :: forall x. Rep Phases x -> Phases
to :: forall x. Rep Phases x -> Phases
Generic)

-- | A binder found in the @forall@ of a @RULES@ pragma.
data RuleBndr = RuleVar Name
              -- ^ @forall {a} ... .@
              | TypedRuleVar Name Type
              -- ^ @forall {(a :: t)} ... .@
              deriving (Int -> RuleBndr -> ShowS
[RuleBndr] -> ShowS
RuleBndr -> String
(Int -> RuleBndr -> ShowS)
-> (RuleBndr -> String) -> ([RuleBndr] -> ShowS) -> Show RuleBndr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuleBndr -> ShowS
showsPrec :: Int -> RuleBndr -> ShowS
$cshow :: RuleBndr -> String
show :: RuleBndr -> String
$cshowList :: [RuleBndr] -> ShowS
showList :: [RuleBndr] -> ShowS
Show, RuleBndr -> RuleBndr -> Bool
(RuleBndr -> RuleBndr -> Bool)
-> (RuleBndr -> RuleBndr -> Bool) -> Eq RuleBndr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuleBndr -> RuleBndr -> Bool
== :: RuleBndr -> RuleBndr -> Bool
$c/= :: RuleBndr -> RuleBndr -> Bool
/= :: RuleBndr -> RuleBndr -> Bool
Eq, Eq RuleBndr
Eq RuleBndr =>
(RuleBndr -> RuleBndr -> Ordering)
-> (RuleBndr -> RuleBndr -> Bool)
-> (RuleBndr -> RuleBndr -> Bool)
-> (RuleBndr -> RuleBndr -> Bool)
-> (RuleBndr -> RuleBndr -> Bool)
-> (RuleBndr -> RuleBndr -> RuleBndr)
-> (RuleBndr -> RuleBndr -> RuleBndr)
-> Ord RuleBndr
RuleBndr -> RuleBndr -> Bool
RuleBndr -> RuleBndr -> Ordering
RuleBndr -> RuleBndr -> RuleBndr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RuleBndr -> RuleBndr -> Ordering
compare :: RuleBndr -> RuleBndr -> Ordering
$c< :: RuleBndr -> RuleBndr -> Bool
< :: RuleBndr -> RuleBndr -> Bool
$c<= :: RuleBndr -> RuleBndr -> Bool
<= :: RuleBndr -> RuleBndr -> Bool
$c> :: RuleBndr -> RuleBndr -> Bool
> :: RuleBndr -> RuleBndr -> Bool
$c>= :: RuleBndr -> RuleBndr -> Bool
>= :: RuleBndr -> RuleBndr -> Bool
$cmax :: RuleBndr -> RuleBndr -> RuleBndr
max :: RuleBndr -> RuleBndr -> RuleBndr
$cmin :: RuleBndr -> RuleBndr -> RuleBndr
min :: RuleBndr -> RuleBndr -> RuleBndr
Ord, (forall x. RuleBndr -> Rep RuleBndr x)
-> (forall x. Rep RuleBndr x -> RuleBndr) -> Generic RuleBndr
forall x. Rep RuleBndr x -> RuleBndr
forall x. RuleBndr -> Rep RuleBndr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RuleBndr -> Rep RuleBndr x
from :: forall x. RuleBndr -> Rep RuleBndr x
$cto :: forall x. Rep RuleBndr x -> RuleBndr
to :: forall x. Rep RuleBndr x -> RuleBndr
Generic)

-- | The target of an @ANN@ pragma
data AnnTarget = ModuleAnnotation
               -- ^ @{\-\# ANN {module} ... #-}@
               | TypeAnnotation Name
               -- ^ @{\-\# ANN type {name} ... #-}@
               | ValueAnnotation Name
               -- ^ @{\-\# ANN {name} ... #-}@
              deriving (Int -> AnnTarget -> ShowS
[AnnTarget] -> ShowS
AnnTarget -> String
(Int -> AnnTarget -> ShowS)
-> (AnnTarget -> String)
-> ([AnnTarget] -> ShowS)
-> Show AnnTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnnTarget -> ShowS
showsPrec :: Int -> AnnTarget -> ShowS
$cshow :: AnnTarget -> String
show :: AnnTarget -> String
$cshowList :: [AnnTarget] -> ShowS
showList :: [AnnTarget] -> ShowS
Show, AnnTarget -> AnnTarget -> Bool
(AnnTarget -> AnnTarget -> Bool)
-> (AnnTarget -> AnnTarget -> Bool) -> Eq AnnTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnnTarget -> AnnTarget -> Bool
== :: AnnTarget -> AnnTarget -> Bool
$c/= :: AnnTarget -> AnnTarget -> Bool
/= :: AnnTarget -> AnnTarget -> Bool
Eq, Eq AnnTarget
Eq AnnTarget =>
(AnnTarget -> AnnTarget -> Ordering)
-> (AnnTarget -> AnnTarget -> Bool)
-> (AnnTarget -> AnnTarget -> Bool)
-> (AnnTarget -> AnnTarget -> Bool)
-> (AnnTarget -> AnnTarget -> Bool)
-> (AnnTarget -> AnnTarget -> AnnTarget)
-> (AnnTarget -> AnnTarget -> AnnTarget)
-> Ord AnnTarget
AnnTarget -> AnnTarget -> Bool
AnnTarget -> AnnTarget -> Ordering
AnnTarget -> AnnTarget -> AnnTarget
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AnnTarget -> AnnTarget -> Ordering
compare :: AnnTarget -> AnnTarget -> Ordering
$c< :: AnnTarget -> AnnTarget -> Bool
< :: AnnTarget -> AnnTarget -> Bool
$c<= :: AnnTarget -> AnnTarget -> Bool
<= :: AnnTarget -> AnnTarget -> Bool
$c> :: AnnTarget -> AnnTarget -> Bool
> :: AnnTarget -> AnnTarget -> Bool
$c>= :: AnnTarget -> AnnTarget -> Bool
>= :: AnnTarget -> AnnTarget -> Bool
$cmax :: AnnTarget -> AnnTarget -> AnnTarget
max :: AnnTarget -> AnnTarget -> AnnTarget
$cmin :: AnnTarget -> AnnTarget -> AnnTarget
min :: AnnTarget -> AnnTarget -> AnnTarget
Ord, (forall x. AnnTarget -> Rep AnnTarget x)
-> (forall x. Rep AnnTarget x -> AnnTarget) -> Generic AnnTarget
forall x. Rep AnnTarget x -> AnnTarget
forall x. AnnTarget -> Rep AnnTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnnTarget -> Rep AnnTarget x
from :: forall x. AnnTarget -> Rep AnnTarget x
$cto :: forall x. Rep AnnTarget x -> AnnTarget
to :: forall x. Rep AnnTarget x -> AnnTarget
Generic)

-- | A context, as found on the left side of a @=>@ in a type.
type Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@

-- | Since the advent of @ConstraintKinds@, constraints are really just types.
-- Equality constraints use the 'EqualityT' constructor. Constraints may also
-- be tuples of other constraints.
type Pred = Type

-- | 'SourceUnpackedness' corresponds to unpack annotations found in the source code.
--
-- This may not agree with the annotations returned by 'reifyConStrictness'.
-- See 'reifyConStrictness' for more information.
data SourceUnpackedness
  = NoSourceUnpackedness -- ^ @C a@
  | SourceNoUnpack       -- ^ @C { {\-\# NOUNPACK \#-\} } a@
  | SourceUnpack         -- ^ @C { {\-\# UNPACK \#-\} } a@
        deriving (Int -> SourceUnpackedness -> ShowS
[SourceUnpackedness] -> ShowS
SourceUnpackedness -> String
(Int -> SourceUnpackedness -> ShowS)
-> (SourceUnpackedness -> String)
-> ([SourceUnpackedness] -> ShowS)
-> Show SourceUnpackedness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceUnpackedness -> ShowS
showsPrec :: Int -> SourceUnpackedness -> ShowS
$cshow :: SourceUnpackedness -> String
show :: SourceUnpackedness -> String
$cshowList :: [SourceUnpackedness] -> ShowS
showList :: [SourceUnpackedness] -> ShowS
Show, SourceUnpackedness -> SourceUnpackedness -> Bool
(SourceUnpackedness -> SourceUnpackedness -> Bool)
-> (SourceUnpackedness -> SourceUnpackedness -> Bool)
-> Eq SourceUnpackedness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceUnpackedness -> SourceUnpackedness -> Bool
== :: SourceUnpackedness -> SourceUnpackedness -> Bool
$c/= :: SourceUnpackedness -> SourceUnpackedness -> Bool
/= :: SourceUnpackedness -> SourceUnpackedness -> Bool
Eq, Eq SourceUnpackedness
Eq SourceUnpackedness =>
(SourceUnpackedness -> SourceUnpackedness -> Ordering)
-> (SourceUnpackedness -> SourceUnpackedness -> Bool)
-> (SourceUnpackedness -> SourceUnpackedness -> Bool)
-> (SourceUnpackedness -> SourceUnpackedness -> Bool)
-> (SourceUnpackedness -> SourceUnpackedness -> Bool)
-> (SourceUnpackedness -> SourceUnpackedness -> SourceUnpackedness)
-> (SourceUnpackedness -> SourceUnpackedness -> SourceUnpackedness)
-> Ord SourceUnpackedness
SourceUnpackedness -> SourceUnpackedness -> Bool
SourceUnpackedness -> SourceUnpackedness -> Ordering
SourceUnpackedness -> SourceUnpackedness -> SourceUnpackedness
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourceUnpackedness -> SourceUnpackedness -> Ordering
compare :: SourceUnpackedness -> SourceUnpackedness -> Ordering
$c< :: SourceUnpackedness -> SourceUnpackedness -> Bool
< :: SourceUnpackedness -> SourceUnpackedness -> Bool
$c<= :: SourceUnpackedness -> SourceUnpackedness -> Bool
<= :: SourceUnpackedness -> SourceUnpackedness -> Bool
$c> :: SourceUnpackedness -> SourceUnpackedness -> Bool
> :: SourceUnpackedness -> SourceUnpackedness -> Bool
$c>= :: SourceUnpackedness -> SourceUnpackedness -> Bool
>= :: SourceUnpackedness -> SourceUnpackedness -> Bool
$cmax :: SourceUnpackedness -> SourceUnpackedness -> SourceUnpackedness
max :: SourceUnpackedness -> SourceUnpackedness -> SourceUnpackedness
$cmin :: SourceUnpackedness -> SourceUnpackedness -> SourceUnpackedness
min :: SourceUnpackedness -> SourceUnpackedness -> SourceUnpackedness
Ord, (forall x. SourceUnpackedness -> Rep SourceUnpackedness x)
-> (forall x. Rep SourceUnpackedness x -> SourceUnpackedness)
-> Generic SourceUnpackedness
forall x. Rep SourceUnpackedness x -> SourceUnpackedness
forall x. SourceUnpackedness -> Rep SourceUnpackedness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceUnpackedness -> Rep SourceUnpackedness x
from :: forall x. SourceUnpackedness -> Rep SourceUnpackedness x
$cto :: forall x. Rep SourceUnpackedness x -> SourceUnpackedness
to :: forall x. Rep SourceUnpackedness x -> SourceUnpackedness
Generic)

-- | 'SourceStrictness' corresponds to strictness annotations found in the source code.
--
-- This may not agree with the annotations returned by 'reifyConStrictness'.
-- See 'reifyConStrictness' for more information.
data SourceStrictness = NoSourceStrictness    -- ^ @C a@
                      | SourceLazy            -- ^ @C {~}a@
                      | SourceStrict          -- ^ @C {!}a@
        deriving (Int -> SourceStrictness -> ShowS
[SourceStrictness] -> ShowS
SourceStrictness -> String
(Int -> SourceStrictness -> ShowS)
-> (SourceStrictness -> String)
-> ([SourceStrictness] -> ShowS)
-> Show SourceStrictness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceStrictness -> ShowS
showsPrec :: Int -> SourceStrictness -> ShowS
$cshow :: SourceStrictness -> String
show :: SourceStrictness -> String
$cshowList :: [SourceStrictness] -> ShowS
showList :: [SourceStrictness] -> ShowS
Show, SourceStrictness -> SourceStrictness -> Bool
(SourceStrictness -> SourceStrictness -> Bool)
-> (SourceStrictness -> SourceStrictness -> Bool)
-> Eq SourceStrictness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceStrictness -> SourceStrictness -> Bool
== :: SourceStrictness -> SourceStrictness -> Bool
$c/= :: SourceStrictness -> SourceStrictness -> Bool
/= :: SourceStrictness -> SourceStrictness -> Bool
Eq, Eq SourceStrictness
Eq SourceStrictness =>
(SourceStrictness -> SourceStrictness -> Ordering)
-> (SourceStrictness -> SourceStrictness -> Bool)
-> (SourceStrictness -> SourceStrictness -> Bool)
-> (SourceStrictness -> SourceStrictness -> Bool)
-> (SourceStrictness -> SourceStrictness -> Bool)
-> (SourceStrictness -> SourceStrictness -> SourceStrictness)
-> (SourceStrictness -> SourceStrictness -> SourceStrictness)
-> Ord SourceStrictness
SourceStrictness -> SourceStrictness -> Bool
SourceStrictness -> SourceStrictness -> Ordering
SourceStrictness -> SourceStrictness -> SourceStrictness
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourceStrictness -> SourceStrictness -> Ordering
compare :: SourceStrictness -> SourceStrictness -> Ordering
$c< :: SourceStrictness -> SourceStrictness -> Bool
< :: SourceStrictness -> SourceStrictness -> Bool
$c<= :: SourceStrictness -> SourceStrictness -> Bool
<= :: SourceStrictness -> SourceStrictness -> Bool
$c> :: SourceStrictness -> SourceStrictness -> Bool
> :: SourceStrictness -> SourceStrictness -> Bool
$c>= :: SourceStrictness -> SourceStrictness -> Bool
>= :: SourceStrictness -> SourceStrictness -> Bool
$cmax :: SourceStrictness -> SourceStrictness -> SourceStrictness
max :: SourceStrictness -> SourceStrictness -> SourceStrictness
$cmin :: SourceStrictness -> SourceStrictness -> SourceStrictness
min :: SourceStrictness -> SourceStrictness -> SourceStrictness
Ord, (forall x. SourceStrictness -> Rep SourceStrictness x)
-> (forall x. Rep SourceStrictness x -> SourceStrictness)
-> Generic SourceStrictness
forall x. Rep SourceStrictness x -> SourceStrictness
forall x. SourceStrictness -> Rep SourceStrictness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceStrictness -> Rep SourceStrictness x
from :: forall x. SourceStrictness -> Rep SourceStrictness x
$cto :: forall x. Rep SourceStrictness x -> SourceStrictness
to :: forall x. Rep SourceStrictness x -> SourceStrictness
Generic)

-- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness'
-- refers to the strictness annotations that the compiler chooses for a data constructor
-- field, which may be different from what is written in source code.
--
-- Note that non-unpacked strict fields are assigned 'DecidedLazy' when a bang would be inappropriate,
-- such as the field of a newtype constructor and fields that have an unlifted type.
--
-- See 'reifyConStrictness' for more information.
data DecidedStrictness = DecidedLazy -- ^ Field inferred to not have a bang.
                       | DecidedStrict -- ^ Field inferred to have a bang.
                       | DecidedUnpack -- ^ Field inferred to be unpacked.
        deriving (Int -> DecidedStrictness -> ShowS
[DecidedStrictness] -> ShowS
DecidedStrictness -> String
(Int -> DecidedStrictness -> ShowS)
-> (DecidedStrictness -> String)
-> ([DecidedStrictness] -> ShowS)
-> Show DecidedStrictness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecidedStrictness -> ShowS
showsPrec :: Int -> DecidedStrictness -> ShowS
$cshow :: DecidedStrictness -> String
show :: DecidedStrictness -> String
$cshowList :: [DecidedStrictness] -> ShowS
showList :: [DecidedStrictness] -> ShowS
Show, DecidedStrictness -> DecidedStrictness -> Bool
(DecidedStrictness -> DecidedStrictness -> Bool)
-> (DecidedStrictness -> DecidedStrictness -> Bool)
-> Eq DecidedStrictness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecidedStrictness -> DecidedStrictness -> Bool
== :: DecidedStrictness -> DecidedStrictness -> Bool
$c/= :: DecidedStrictness -> DecidedStrictness -> Bool
/= :: DecidedStrictness -> DecidedStrictness -> Bool
Eq, Eq DecidedStrictness
Eq DecidedStrictness =>
(DecidedStrictness -> DecidedStrictness -> Ordering)
-> (DecidedStrictness -> DecidedStrictness -> Bool)
-> (DecidedStrictness -> DecidedStrictness -> Bool)
-> (DecidedStrictness -> DecidedStrictness -> Bool)
-> (DecidedStrictness -> DecidedStrictness -> Bool)
-> (DecidedStrictness -> DecidedStrictness -> DecidedStrictness)
-> (DecidedStrictness -> DecidedStrictness -> DecidedStrictness)
-> Ord DecidedStrictness
DecidedStrictness -> DecidedStrictness -> Bool
DecidedStrictness -> DecidedStrictness -> Ordering
DecidedStrictness -> DecidedStrictness -> DecidedStrictness
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DecidedStrictness -> DecidedStrictness -> Ordering
compare :: DecidedStrictness -> DecidedStrictness -> Ordering
$c< :: DecidedStrictness -> DecidedStrictness -> Bool
< :: DecidedStrictness -> DecidedStrictness -> Bool
$c<= :: DecidedStrictness -> DecidedStrictness -> Bool
<= :: DecidedStrictness -> DecidedStrictness -> Bool
$c> :: DecidedStrictness -> DecidedStrictness -> Bool
> :: DecidedStrictness -> DecidedStrictness -> Bool
$c>= :: DecidedStrictness -> DecidedStrictness -> Bool
>= :: DecidedStrictness -> DecidedStrictness -> Bool
$cmax :: DecidedStrictness -> DecidedStrictness -> DecidedStrictness
max :: DecidedStrictness -> DecidedStrictness -> DecidedStrictness
$cmin :: DecidedStrictness -> DecidedStrictness -> DecidedStrictness
min :: DecidedStrictness -> DecidedStrictness -> DecidedStrictness
Ord, (forall x. DecidedStrictness -> Rep DecidedStrictness x)
-> (forall x. Rep DecidedStrictness x -> DecidedStrictness)
-> Generic DecidedStrictness
forall x. Rep DecidedStrictness x -> DecidedStrictness
forall x. DecidedStrictness -> Rep DecidedStrictness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DecidedStrictness -> Rep DecidedStrictness x
from :: forall x. DecidedStrictness -> Rep DecidedStrictness x
$cto :: forall x. Rep DecidedStrictness x -> DecidedStrictness
to :: forall x. Rep DecidedStrictness x -> DecidedStrictness
Generic)

-- | A data constructor.
--
-- The constructors for 'Con' can roughly be divided up into two categories:
-- those for constructors with \"vanilla\" syntax ('NormalC', 'RecC', and
-- 'InfixC'), and those for constructors with GADT syntax ('GadtC' and
-- 'RecGadtC'). The 'ForallC' constructor, which quantifies additional type
-- variables and class contexts, can surround either variety of constructor.
-- However, the type variables that it quantifies are different depending
-- on what constructor syntax is used:
--
-- * If a 'ForallC' surrounds a constructor with vanilla syntax, then the
--   'ForallC' will only quantify /existential/ type variables. For example:
--
--   @
--   data Foo a = forall b. MkFoo a b
--   @
--
--   In @MkFoo@, 'ForallC' will quantify @b@, but not @a@.
--
-- * If a 'ForallC' surrounds a constructor with GADT syntax, then the
--   'ForallC' will quantify /all/ type variables used in the constructor.
--   For example:
--
--   @
--   data Bar a b where
--     MkBar :: (a ~ b) => c -> MkBar a b
--   @
--
--   In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@.
--
-- Multiplicity annotations for data types are currently not supported
-- in Template Haskell (i.e. all fields represented by Template Haskell
-- will be linear).
data Con =
  -- | @C Int a@
    NormalC Name [BangType]

  -- | @C { v :: Int, w :: a }@
  | RecC Name [VarBangType]

  -- | @Int :+ a@
  | InfixC BangType Name BangType

  -- | @forall a. Eq a => C [a]@
  | ForallC [TyVarBndr Specificity] Cxt Con

  -- @C :: a -> b -> T b Int@
  | GadtC [Name]
            -- ^ The list of constructors, corresponding to the GADT constructor
            -- syntax @C1, C2 :: a -> T b@.
            --
            -- Invariant: the list must be non-empty.
          [BangType] -- ^ The constructor arguments
          Type -- ^ See Note [GADT return type]

  -- | @C :: { v :: Int } -> T b Int@
  | RecGadtC [Name]
             -- ^ The list of constructors, corresponding to the GADT record
             -- constructor syntax @C1, C2 :: { fld :: a } -> T b@.
             --
             -- Invariant: the list must be non-empty.
             [VarBangType] -- ^ The constructor arguments
             Type -- ^ See Note [GADT return type]
        deriving (Int -> Con -> ShowS
[Con] -> ShowS
Con -> String
(Int -> Con -> ShowS)
-> (Con -> String) -> ([Con] -> ShowS) -> Show Con
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Con -> ShowS
showsPrec :: Int -> Con -> ShowS
$cshow :: Con -> String
show :: Con -> String
$cshowList :: [Con] -> ShowS
showList :: [Con] -> ShowS
Show, Con -> Con -> Bool
(Con -> Con -> Bool) -> (Con -> Con -> Bool) -> Eq Con
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Con -> Con -> Bool
== :: Con -> Con -> Bool
$c/= :: Con -> Con -> Bool
/= :: Con -> Con -> Bool
Eq, Eq Con
Eq Con =>
(Con -> Con -> Ordering)
-> (Con -> Con -> Bool)
-> (Con -> Con -> Bool)
-> (Con -> Con -> Bool)
-> (Con -> Con -> Bool)
-> (Con -> Con -> Con)
-> (Con -> Con -> Con)
-> Ord Con
Con -> Con -> Bool
Con -> Con -> Ordering
Con -> Con -> Con
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Con -> Con -> Ordering
compare :: Con -> Con -> Ordering
$c< :: Con -> Con -> Bool
< :: Con -> Con -> Bool
$c<= :: Con -> Con -> Bool
<= :: Con -> Con -> Bool
$c> :: Con -> Con -> Bool
> :: Con -> Con -> Bool
$c>= :: Con -> Con -> Bool
>= :: Con -> Con -> Bool
$cmax :: Con -> Con -> Con
max :: Con -> Con -> Con
$cmin :: Con -> Con -> Con
min :: Con -> Con -> Con
Ord, (forall x. Con -> Rep Con x)
-> (forall x. Rep Con x -> Con) -> Generic Con
forall x. Rep Con x -> Con
forall x. Con -> Rep Con x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Con -> Rep Con x
from :: forall x. Con -> Rep Con x
$cto :: forall x. Rep Con x -> Con
to :: forall x. Rep Con x -> Con
Generic)

-- Note [GADT return type]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- The return type of a GADT constructor does not necessarily match the name of
-- the data type:
--
-- type S = T
--
-- data T a where
--     MkT :: S Int
--
--
-- type S a = T
--
-- data T a where
--     MkT :: S Char Int
--
--
-- type Id a = a
-- type S a = T
--
-- data T a where
--     MkT :: Id (S Char Int)
--
--
-- That is why we allow the return type stored by a constructor to be an
-- arbitrary type. See also #11341

-- | Strictness information in a data constructor's argument.
data Bang = Bang SourceUnpackedness SourceStrictness
         -- ^ @C { {\-\# UNPACK \#-\} !}a@
        deriving (Int -> Bang -> ShowS
[Bang] -> ShowS
Bang -> String
(Int -> Bang -> ShowS)
-> (Bang -> String) -> ([Bang] -> ShowS) -> Show Bang
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bang -> ShowS
showsPrec :: Int -> Bang -> ShowS
$cshow :: Bang -> String
show :: Bang -> String
$cshowList :: [Bang] -> ShowS
showList :: [Bang] -> ShowS
Show, Bang -> Bang -> Bool
(Bang -> Bang -> Bool) -> (Bang -> Bang -> Bool) -> Eq Bang
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bang -> Bang -> Bool
== :: Bang -> Bang -> Bool
$c/= :: Bang -> Bang -> Bool
/= :: Bang -> Bang -> Bool
Eq, Eq Bang
Eq Bang =>
(Bang -> Bang -> Ordering)
-> (Bang -> Bang -> Bool)
-> (Bang -> Bang -> Bool)
-> (Bang -> Bang -> Bool)
-> (Bang -> Bang -> Bool)
-> (Bang -> Bang -> Bang)
-> (Bang -> Bang -> Bang)
-> Ord Bang
Bang -> Bang -> Bool
Bang -> Bang -> Ordering
Bang -> Bang -> Bang
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Bang -> Bang -> Ordering
compare :: Bang -> Bang -> Ordering
$c< :: Bang -> Bang -> Bool
< :: Bang -> Bang -> Bool
$c<= :: Bang -> Bang -> Bool
<= :: Bang -> Bang -> Bool
$c> :: Bang -> Bang -> Bool
> :: Bang -> Bang -> Bool
$c>= :: Bang -> Bang -> Bool
>= :: Bang -> Bang -> Bool
$cmax :: Bang -> Bang -> Bang
max :: Bang -> Bang -> Bang
$cmin :: Bang -> Bang -> Bang
min :: Bang -> Bang -> Bang
Ord, (forall x. Bang -> Rep Bang x)
-> (forall x. Rep Bang x -> Bang) -> Generic Bang
forall x. Rep Bang x -> Bang
forall x. Bang -> Rep Bang x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bang -> Rep Bang x
from :: forall x. Bang -> Rep Bang x
$cto :: forall x. Rep Bang x -> Bang
to :: forall x. Rep Bang x -> Bang
Generic)

-- | A type with a strictness annotation, as in data constructors. See 'Con'.
type BangType    = (Bang, Type)

-- | 'BangType', but for record fields. See 'Con'.
type VarBangType = (Name, Bang, Type)

-- | As of @template-haskell-2.11.0.0@, 'Strict' has been replaced by 'Bang'.
type Strict      = Bang

-- | As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by
-- 'BangType'.
type StrictType    = BangType

-- | As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by
-- 'VarBangType'.
type VarStrictType = VarBangType

-- | A pattern synonym's directionality.
data PatSynDir
  = Unidir             -- ^ @pattern P x {<-} p@
  | ImplBidir          -- ^ @pattern P x {=} p@
  | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@
  deriving( Int -> PatSynDir -> ShowS
[PatSynDir] -> ShowS
PatSynDir -> String
(Int -> PatSynDir -> ShowS)
-> (PatSynDir -> String)
-> ([PatSynDir] -> ShowS)
-> Show PatSynDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatSynDir -> ShowS
showsPrec :: Int -> PatSynDir -> ShowS
$cshow :: PatSynDir -> String
show :: PatSynDir -> String
$cshowList :: [PatSynDir] -> ShowS
showList :: [PatSynDir] -> ShowS
Show, PatSynDir -> PatSynDir -> Bool
(PatSynDir -> PatSynDir -> Bool)
-> (PatSynDir -> PatSynDir -> Bool) -> Eq PatSynDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatSynDir -> PatSynDir -> Bool
== :: PatSynDir -> PatSynDir -> Bool
$c/= :: PatSynDir -> PatSynDir -> Bool
/= :: PatSynDir -> PatSynDir -> Bool
Eq, Eq PatSynDir
Eq PatSynDir =>
(PatSynDir -> PatSynDir -> Ordering)
-> (PatSynDir -> PatSynDir -> Bool)
-> (PatSynDir -> PatSynDir -> Bool)
-> (PatSynDir -> PatSynDir -> Bool)
-> (PatSynDir -> PatSynDir -> Bool)
-> (PatSynDir -> PatSynDir -> PatSynDir)
-> (PatSynDir -> PatSynDir -> PatSynDir)
-> Ord PatSynDir
PatSynDir -> PatSynDir -> Bool
PatSynDir -> PatSynDir -> Ordering
PatSynDir -> PatSynDir -> PatSynDir
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PatSynDir -> PatSynDir -> Ordering
compare :: PatSynDir -> PatSynDir -> Ordering
$c< :: PatSynDir -> PatSynDir -> Bool
< :: PatSynDir -> PatSynDir -> Bool
$c<= :: PatSynDir -> PatSynDir -> Bool
<= :: PatSynDir -> PatSynDir -> Bool
$c> :: PatSynDir -> PatSynDir -> Bool
> :: PatSynDir -> PatSynDir -> Bool
$c>= :: PatSynDir -> PatSynDir -> Bool
>= :: PatSynDir -> PatSynDir -> Bool
$cmax :: PatSynDir -> PatSynDir -> PatSynDir
max :: PatSynDir -> PatSynDir -> PatSynDir
$cmin :: PatSynDir -> PatSynDir -> PatSynDir
min :: PatSynDir -> PatSynDir -> PatSynDir
Ord, (forall x. PatSynDir -> Rep PatSynDir x)
-> (forall x. Rep PatSynDir x -> PatSynDir) -> Generic PatSynDir
forall x. Rep PatSynDir x -> PatSynDir
forall x. PatSynDir -> Rep PatSynDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PatSynDir -> Rep PatSynDir x
from :: forall x. PatSynDir -> Rep PatSynDir x
$cto :: forall x. Rep PatSynDir x -> PatSynDir
to :: forall x. Rep PatSynDir x -> PatSynDir
Generic )

-- | A pattern synonym's argument type.
data PatSynArgs
  = PrefixPatSyn [Name]        -- ^ @pattern P {x y z} = p@
  | InfixPatSyn Name Name      -- ^ @pattern {x P y} = p@
  | RecordPatSyn [Name]        -- ^ @pattern P { {x,y,z} } = p@
  deriving( Int -> PatSynArgs -> ShowS
[PatSynArgs] -> ShowS
PatSynArgs -> String
(Int -> PatSynArgs -> ShowS)
-> (PatSynArgs -> String)
-> ([PatSynArgs] -> ShowS)
-> Show PatSynArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatSynArgs -> ShowS
showsPrec :: Int -> PatSynArgs -> ShowS
$cshow :: PatSynArgs -> String
show :: PatSynArgs -> String
$cshowList :: [PatSynArgs] -> ShowS
showList :: [PatSynArgs] -> ShowS
Show, PatSynArgs -> PatSynArgs -> Bool
(PatSynArgs -> PatSynArgs -> Bool)
-> (PatSynArgs -> PatSynArgs -> Bool) -> Eq PatSynArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatSynArgs -> PatSynArgs -> Bool
== :: PatSynArgs -> PatSynArgs -> Bool
$c/= :: PatSynArgs -> PatSynArgs -> Bool
/= :: PatSynArgs -> PatSynArgs -> Bool
Eq, Eq PatSynArgs
Eq PatSynArgs =>
(PatSynArgs -> PatSynArgs -> Ordering)
-> (PatSynArgs -> PatSynArgs -> Bool)
-> (PatSynArgs -> PatSynArgs -> Bool)
-> (PatSynArgs -> PatSynArgs -> Bool)
-> (PatSynArgs -> PatSynArgs -> Bool)
-> (PatSynArgs -> PatSynArgs -> PatSynArgs)
-> (PatSynArgs -> PatSynArgs -> PatSynArgs)
-> Ord PatSynArgs
PatSynArgs -> PatSynArgs -> Bool
PatSynArgs -> PatSynArgs -> Ordering
PatSynArgs -> PatSynArgs -> PatSynArgs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PatSynArgs -> PatSynArgs -> Ordering
compare :: PatSynArgs -> PatSynArgs -> Ordering
$c< :: PatSynArgs -> PatSynArgs -> Bool
< :: PatSynArgs -> PatSynArgs -> Bool
$c<= :: PatSynArgs -> PatSynArgs -> Bool
<= :: PatSynArgs -> PatSynArgs -> Bool
$c> :: PatSynArgs -> PatSynArgs -> Bool
> :: PatSynArgs -> PatSynArgs -> Bool
$c>= :: PatSynArgs -> PatSynArgs -> Bool
>= :: PatSynArgs -> PatSynArgs -> Bool
$cmax :: PatSynArgs -> PatSynArgs -> PatSynArgs
max :: PatSynArgs -> PatSynArgs -> PatSynArgs
$cmin :: PatSynArgs -> PatSynArgs -> PatSynArgs
min :: PatSynArgs -> PatSynArgs -> PatSynArgs
Ord, (forall x. PatSynArgs -> Rep PatSynArgs x)
-> (forall x. Rep PatSynArgs x -> PatSynArgs) -> Generic PatSynArgs
forall x. Rep PatSynArgs x -> PatSynArgs
forall x. PatSynArgs -> Rep PatSynArgs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PatSynArgs -> Rep PatSynArgs x
from :: forall x. PatSynArgs -> Rep PatSynArgs x
$cto :: forall x. Rep PatSynArgs x -> PatSynArgs
to :: forall x. Rep PatSynArgs x -> PatSynArgs
Generic )

-- | A Haskell type.
data Type = ForallT [TyVarBndr Specificity] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@
          | ForallVisT [TyVarBndr ()] Type -- ^ @forall \<vars\> -> \<type\>@
          | AppT Type Type                 -- ^ @T a b@
          | AppKindT Type Kind             -- ^ @T \@k t@
          | SigT Type Kind                 -- ^ @t :: k@
          | VarT Name                      -- ^ @a@
          | ConT Name                      -- ^ @T@
          | PromotedT Name                 -- ^ @'T@
          | InfixT Type Name Type          -- ^ @T + T@
          | UInfixT Type Name Type         -- ^ @T + T@
                                           --
                                           -- See "Language.Haskell.TH.Syntax#infix"
          | PromotedInfixT Type Name Type  -- ^ @T :+: T@
          | PromotedUInfixT Type Name Type -- ^ @T :+: T@
                                           --
                                           -- See "Language.Haskell.TH.Syntax#infix"
          | ParensT Type                   -- ^ @(T)@

          -- See Note [Representing concrete syntax in types]
          | TupleT Int                     -- ^ @(,)@, @(,,)@, etc.
          | UnboxedTupleT Int              -- ^ @(\#,\#)@, @(\#,,\#)@, etc.
          | UnboxedSumT SumArity           -- ^ @(\#|\#)@, @(\#||\#)@, etc.
          | ArrowT                         -- ^ @->@
          | MulArrowT                      -- ^ @%n ->@
                                           --
                                           -- Generalised arrow type with multiplicity argument
          | EqualityT                      -- ^ @~@
          | ListT                          -- ^ @[]@
          | PromotedTupleT Int             -- ^ @'()@, @'(,)@, @'(,,)@, etc.
          | PromotedNilT                   -- ^ @'[]@
          | PromotedConsT                  -- ^ @'(:)@
          | StarT                          -- ^ @*@
          | ConstraintT                    -- ^ @Constraint@
          | LitT TyLit                     -- ^ @0@, @1@, @2@, etc.
          | WildCardT                      -- ^ @_@
          | ImplicitParamT String Type     -- ^ @?x :: t@
      deriving( Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq, Eq Type
Eq Type =>
(Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Type -> Type -> Ordering
compare :: Type -> Type -> Ordering
$c< :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
>= :: Type -> Type -> Bool
$cmax :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
min :: Type -> Type -> Type
Ord, (forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Type -> Rep Type x
from :: forall x. Type -> Rep Type x
$cto :: forall x. Rep Type x -> Type
to :: forall x. Rep Type x -> Type
Generic )

-- | The specificity of a type variable in a @forall ...@.
data Specificity = SpecifiedSpec          -- ^ @a@
                 | InferredSpec           -- ^ @{a}@
      deriving( Int -> Specificity -> ShowS
[Specificity] -> ShowS
Specificity -> String
(Int -> Specificity -> ShowS)
-> (Specificity -> String)
-> ([Specificity] -> ShowS)
-> Show Specificity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Specificity -> ShowS
showsPrec :: Int -> Specificity -> ShowS
$cshow :: Specificity -> String
show :: Specificity -> String
$cshowList :: [Specificity] -> ShowS
showList :: [Specificity] -> ShowS
Show, Specificity -> Specificity -> Bool
(Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Bool) -> Eq Specificity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Specificity -> Specificity -> Bool
== :: Specificity -> Specificity -> Bool
$c/= :: Specificity -> Specificity -> Bool
/= :: Specificity -> Specificity -> Bool
Eq, Eq Specificity
Eq Specificity =>
(Specificity -> Specificity -> Ordering)
-> (Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Specificity)
-> (Specificity -> Specificity -> Specificity)
-> Ord Specificity
Specificity -> Specificity -> Bool
Specificity -> Specificity -> Ordering
Specificity -> Specificity -> Specificity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Specificity -> Specificity -> Ordering
compare :: Specificity -> Specificity -> Ordering
$c< :: Specificity -> Specificity -> Bool
< :: Specificity -> Specificity -> Bool
$c<= :: Specificity -> Specificity -> Bool
<= :: Specificity -> Specificity -> Bool
$c> :: Specificity -> Specificity -> Bool
> :: Specificity -> Specificity -> Bool
$c>= :: Specificity -> Specificity -> Bool
>= :: Specificity -> Specificity -> Bool
$cmax :: Specificity -> Specificity -> Specificity
max :: Specificity -> Specificity -> Specificity
$cmin :: Specificity -> Specificity -> Specificity
min :: Specificity -> Specificity -> Specificity
Ord, (forall x. Specificity -> Rep Specificity x)
-> (forall x. Rep Specificity x -> Specificity)
-> Generic Specificity
forall x. Rep Specificity x -> Specificity
forall x. Specificity -> Rep Specificity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Specificity -> Rep Specificity x
from :: forall x. Specificity -> Rep Specificity x
$cto :: forall x. Rep Specificity x -> Specificity
to :: forall x. Rep Specificity x -> Specificity
Generic )

-- | The @flag@ type parameter is instantiated to one of the following types:
--
--   * 'Specificity' (examples: 'ForallC', 'ForallT')
--   * 'BndrVis' (examples: 'DataD', 'ClassD', etc.)
--   * '()', a catch-all type for other forms of binders, including 'ForallVisT', 'DataInstD', 'RuleP', and 'TyVarSig'
--
data TyVarBndr flag = PlainTV  Name flag      -- ^ @a@
                    | KindedTV Name flag Kind -- ^ @(a :: k)@
      deriving( Int -> TyVarBndr flag -> ShowS
[TyVarBndr flag] -> ShowS
TyVarBndr flag -> String
(Int -> TyVarBndr flag -> ShowS)
-> (TyVarBndr flag -> String)
-> ([TyVarBndr flag] -> ShowS)
-> Show (TyVarBndr flag)
forall flag. Show flag => Int -> TyVarBndr flag -> ShowS
forall flag. Show flag => [TyVarBndr flag] -> ShowS
forall flag. Show flag => TyVarBndr flag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall flag. Show flag => Int -> TyVarBndr flag -> ShowS
showsPrec :: Int -> TyVarBndr flag -> ShowS
$cshow :: forall flag. Show flag => TyVarBndr flag -> String
show :: TyVarBndr flag -> String
$cshowList :: forall flag. Show flag => [TyVarBndr flag] -> ShowS
showList :: [TyVarBndr flag] -> ShowS
Show, TyVarBndr flag -> TyVarBndr flag -> Bool
(TyVarBndr flag -> TyVarBndr flag -> Bool)
-> (TyVarBndr flag -> TyVarBndr flag -> Bool)
-> Eq (TyVarBndr flag)
forall flag. Eq flag => TyVarBndr flag -> TyVarBndr flag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall flag. Eq flag => TyVarBndr flag -> TyVarBndr flag -> Bool
== :: TyVarBndr flag -> TyVarBndr flag -> Bool
$c/= :: forall flag. Eq flag => TyVarBndr flag -> TyVarBndr flag -> Bool
/= :: TyVarBndr flag -> TyVarBndr flag -> Bool
Eq, Eq (TyVarBndr flag)
Eq (TyVarBndr flag) =>
(TyVarBndr flag -> TyVarBndr flag -> Ordering)
-> (TyVarBndr flag -> TyVarBndr flag -> Bool)
-> (TyVarBndr flag -> TyVarBndr flag -> Bool)
-> (TyVarBndr flag -> TyVarBndr flag -> Bool)
-> (TyVarBndr flag -> TyVarBndr flag -> Bool)
-> (TyVarBndr flag -> TyVarBndr flag -> TyVarBndr flag)
-> (TyVarBndr flag -> TyVarBndr flag -> TyVarBndr flag)
-> Ord (TyVarBndr flag)
TyVarBndr flag -> TyVarBndr flag -> Bool
TyVarBndr flag -> TyVarBndr flag -> Ordering
TyVarBndr flag -> TyVarBndr flag -> TyVarBndr flag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall flag. Ord flag => Eq (TyVarBndr flag)
forall flag. Ord flag => TyVarBndr flag -> TyVarBndr flag -> Bool
forall flag.
Ord flag =>
TyVarBndr flag -> TyVarBndr flag -> Ordering
forall flag.
Ord flag =>
TyVarBndr flag -> TyVarBndr flag -> TyVarBndr flag
$ccompare :: forall flag.
Ord flag =>
TyVarBndr flag -> TyVarBndr flag -> Ordering
compare :: TyVarBndr flag -> TyVarBndr flag -> Ordering
$c< :: forall flag. Ord flag => TyVarBndr flag -> TyVarBndr flag -> Bool
< :: TyVarBndr flag -> TyVarBndr flag -> Bool
$c<= :: forall flag. Ord flag => TyVarBndr flag -> TyVarBndr flag -> Bool
<= :: TyVarBndr flag -> TyVarBndr flag -> Bool
$c> :: forall flag. Ord flag => TyVarBndr flag -> TyVarBndr flag -> Bool
> :: TyVarBndr flag -> TyVarBndr flag -> Bool
$c>= :: forall flag. Ord flag => TyVarBndr flag -> TyVarBndr flag -> Bool
>= :: TyVarBndr flag -> TyVarBndr flag -> Bool
$cmax :: forall flag.
Ord flag =>
TyVarBndr flag -> TyVarBndr flag -> TyVarBndr flag
max :: TyVarBndr flag -> TyVarBndr flag -> TyVarBndr flag
$cmin :: forall flag.
Ord flag =>
TyVarBndr flag -> TyVarBndr flag -> TyVarBndr flag
min :: TyVarBndr flag -> TyVarBndr flag -> TyVarBndr flag
Ord, (forall x. TyVarBndr flag -> Rep (TyVarBndr flag) x)
-> (forall x. Rep (TyVarBndr flag) x -> TyVarBndr flag)
-> Generic (TyVarBndr flag)
forall x. Rep (TyVarBndr flag) x -> TyVarBndr flag
forall x. TyVarBndr flag -> Rep (TyVarBndr flag) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall flag x. Rep (TyVarBndr flag) x -> TyVarBndr flag
forall flag x. TyVarBndr flag -> Rep (TyVarBndr flag) x
$cfrom :: forall flag x. TyVarBndr flag -> Rep (TyVarBndr flag) x
from :: forall x. TyVarBndr flag -> Rep (TyVarBndr flag) x
$cto :: forall flag x. Rep (TyVarBndr flag) x -> TyVarBndr flag
to :: forall x. Rep (TyVarBndr flag) x -> TyVarBndr flag
Generic, (forall a b. (a -> b) -> TyVarBndr a -> TyVarBndr b)
-> (forall a b. a -> TyVarBndr b -> TyVarBndr a)
-> Functor TyVarBndr
forall a b. a -> TyVarBndr b -> TyVarBndr a
forall a b. (a -> b) -> TyVarBndr a -> TyVarBndr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TyVarBndr a -> TyVarBndr b
fmap :: forall a b. (a -> b) -> TyVarBndr a -> TyVarBndr b
$c<$ :: forall a b. a -> TyVarBndr b -> TyVarBndr a
<$ :: forall a b. a -> TyVarBndr b -> TyVarBndr a
Functor, (forall m. Monoid m => TyVarBndr m -> m)
-> (forall m a. Monoid m => (a -> m) -> TyVarBndr a -> m)
-> (forall m a. Monoid m => (a -> m) -> TyVarBndr a -> m)
-> (forall a b. (a -> b -> b) -> b -> TyVarBndr a -> b)
-> (forall a b. (a -> b -> b) -> b -> TyVarBndr a -> b)
-> (forall b a. (b -> a -> b) -> b -> TyVarBndr a -> b)
-> (forall b a. (b -> a -> b) -> b -> TyVarBndr a -> b)
-> (forall a. (a -> a -> a) -> TyVarBndr a -> a)
-> (forall a. (a -> a -> a) -> TyVarBndr a -> a)
-> (forall a. TyVarBndr a -> [a])
-> (forall a. TyVarBndr a -> Bool)
-> (forall a. TyVarBndr a -> Int)
-> (forall a. Eq a => a -> TyVarBndr a -> Bool)
-> (forall a. Ord a => TyVarBndr a -> a)
-> (forall a. Ord a => TyVarBndr a -> a)
-> (forall a. Num a => TyVarBndr a -> a)
-> (forall a. Num a => TyVarBndr a -> a)
-> Foldable TyVarBndr
forall a. Eq a => a -> TyVarBndr a -> Bool
forall a. Num a => TyVarBndr a -> a
forall a. Ord a => TyVarBndr a -> a
forall m. Monoid m => TyVarBndr m -> m
forall a. TyVarBndr a -> Bool
forall a. TyVarBndr a -> Int
forall a. TyVarBndr a -> [a]
forall a. (a -> a -> a) -> TyVarBndr a -> a
forall m a. Monoid m => (a -> m) -> TyVarBndr a -> m
forall b a. (b -> a -> b) -> b -> TyVarBndr a -> b
forall a b. (a -> b -> b) -> b -> TyVarBndr a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => TyVarBndr m -> m
fold :: forall m. Monoid m => TyVarBndr m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TyVarBndr a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> TyVarBndr a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TyVarBndr a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> TyVarBndr a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> TyVarBndr a -> b
foldr :: forall a b. (a -> b -> b) -> b -> TyVarBndr a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TyVarBndr a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> TyVarBndr a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TyVarBndr a -> b
foldl :: forall b a. (b -> a -> b) -> b -> TyVarBndr a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TyVarBndr a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> TyVarBndr a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> TyVarBndr a -> a
foldr1 :: forall a. (a -> a -> a) -> TyVarBndr a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TyVarBndr a -> a
foldl1 :: forall a. (a -> a -> a) -> TyVarBndr a -> a
$ctoList :: forall a. TyVarBndr a -> [a]
toList :: forall a. TyVarBndr a -> [a]
$cnull :: forall a. TyVarBndr a -> Bool
null :: forall a. TyVarBndr a -> Bool
$clength :: forall a. TyVarBndr a -> Int
length :: forall a. TyVarBndr a -> Int
$celem :: forall a. Eq a => a -> TyVarBndr a -> Bool
elem :: forall a. Eq a => a -> TyVarBndr a -> Bool
$cmaximum :: forall a. Ord a => TyVarBndr a -> a
maximum :: forall a. Ord a => TyVarBndr a -> a
$cminimum :: forall a. Ord a => TyVarBndr a -> a
minimum :: forall a. Ord a => TyVarBndr a -> a
$csum :: forall a. Num a => TyVarBndr a -> a
sum :: forall a. Num a => TyVarBndr a -> a
$cproduct :: forall a. Num a => TyVarBndr a -> a
product :: forall a. Num a => TyVarBndr a -> a
Foldable, Functor TyVarBndr
Foldable TyVarBndr
(Functor TyVarBndr, Foldable TyVarBndr) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> TyVarBndr a -> f (TyVarBndr b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TyVarBndr (f a) -> f (TyVarBndr a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TyVarBndr a -> m (TyVarBndr b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TyVarBndr (m a) -> m (TyVarBndr a))
-> Traversable TyVarBndr
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
TyVarBndr (m a) -> m (TyVarBndr a)
forall (f :: * -> *) a.
Applicative f =>
TyVarBndr (f a) -> f (TyVarBndr a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TyVarBndr a -> m (TyVarBndr b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TyVarBndr a -> f (TyVarBndr b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TyVarBndr a -> f (TyVarBndr b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TyVarBndr a -> f (TyVarBndr b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TyVarBndr (f a) -> f (TyVarBndr a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
TyVarBndr (f a) -> f (TyVarBndr a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TyVarBndr a -> m (TyVarBndr b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TyVarBndr a -> m (TyVarBndr b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
TyVarBndr (m a) -> m (TyVarBndr a)
sequence :: forall (m :: * -> *) a.
Monad m =>
TyVarBndr (m a) -> m (TyVarBndr a)
Traversable )

-- | Visibility of a type variable. See [Inferred vs. specified type variables](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_applications.html#inferred-vs-specified-type-variables).
data BndrVis = BndrReq                    -- ^ @a@
             | BndrInvis                  -- ^ @\@a@
      deriving( Int -> BndrVis -> ShowS
[BndrVis] -> ShowS
BndrVis -> String
(Int -> BndrVis -> ShowS)
-> (BndrVis -> String) -> ([BndrVis] -> ShowS) -> Show BndrVis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BndrVis -> ShowS
showsPrec :: Int -> BndrVis -> ShowS
$cshow :: BndrVis -> String
show :: BndrVis -> String
$cshowList :: [BndrVis] -> ShowS
showList :: [BndrVis] -> ShowS
Show, BndrVis -> BndrVis -> Bool
(BndrVis -> BndrVis -> Bool)
-> (BndrVis -> BndrVis -> Bool) -> Eq BndrVis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BndrVis -> BndrVis -> Bool
== :: BndrVis -> BndrVis -> Bool
$c/= :: BndrVis -> BndrVis -> Bool
/= :: BndrVis -> BndrVis -> Bool
Eq, Eq BndrVis
Eq BndrVis =>
(BndrVis -> BndrVis -> Ordering)
-> (BndrVis -> BndrVis -> Bool)
-> (BndrVis -> BndrVis -> Bool)
-> (BndrVis -> BndrVis -> Bool)
-> (BndrVis -> BndrVis -> Bool)
-> (BndrVis -> BndrVis -> BndrVis)
-> (BndrVis -> BndrVis -> BndrVis)
-> Ord BndrVis
BndrVis -> BndrVis -> Bool
BndrVis -> BndrVis -> Ordering
BndrVis -> BndrVis -> BndrVis
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BndrVis -> BndrVis -> Ordering
compare :: BndrVis -> BndrVis -> Ordering
$c< :: BndrVis -> BndrVis -> Bool
< :: BndrVis -> BndrVis -> Bool
$c<= :: BndrVis -> BndrVis -> Bool
<= :: BndrVis -> BndrVis -> Bool
$c> :: BndrVis -> BndrVis -> Bool
> :: BndrVis -> BndrVis -> Bool
$c>= :: BndrVis -> BndrVis -> Bool
>= :: BndrVis -> BndrVis -> Bool
$cmax :: BndrVis -> BndrVis -> BndrVis
max :: BndrVis -> BndrVis -> BndrVis
$cmin :: BndrVis -> BndrVis -> BndrVis
min :: BndrVis -> BndrVis -> BndrVis
Ord, (forall x. BndrVis -> Rep BndrVis x)
-> (forall x. Rep BndrVis x -> BndrVis) -> Generic BndrVis
forall x. Rep BndrVis x -> BndrVis
forall x. BndrVis -> Rep BndrVis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BndrVis -> Rep BndrVis x
from :: forall x. BndrVis -> Rep BndrVis x
$cto :: forall x. Rep BndrVis x -> BndrVis
to :: forall x. Rep BndrVis x -> BndrVis
Generic )

-- | Type family result signature
data FamilyResultSig = NoSig              -- ^ no signature
                     | KindSig  Kind      -- ^ @k@
                     | TyVarSig (TyVarBndr ()) -- ^ @= r, = (r :: k)@
      deriving( Int -> FamilyResultSig -> ShowS
[FamilyResultSig] -> ShowS
FamilyResultSig -> String
(Int -> FamilyResultSig -> ShowS)
-> (FamilyResultSig -> String)
-> ([FamilyResultSig] -> ShowS)
-> Show FamilyResultSig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FamilyResultSig -> ShowS
showsPrec :: Int -> FamilyResultSig -> ShowS
$cshow :: FamilyResultSig -> String
show :: FamilyResultSig -> String
$cshowList :: [FamilyResultSig] -> ShowS
showList :: [FamilyResultSig] -> ShowS
Show, FamilyResultSig -> FamilyResultSig -> Bool
(FamilyResultSig -> FamilyResultSig -> Bool)
-> (FamilyResultSig -> FamilyResultSig -> Bool)
-> Eq FamilyResultSig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FamilyResultSig -> FamilyResultSig -> Bool
== :: FamilyResultSig -> FamilyResultSig -> Bool
$c/= :: FamilyResultSig -> FamilyResultSig -> Bool
/= :: FamilyResultSig -> FamilyResultSig -> Bool
Eq, Eq FamilyResultSig
Eq FamilyResultSig =>
(FamilyResultSig -> FamilyResultSig -> Ordering)
-> (FamilyResultSig -> FamilyResultSig -> Bool)
-> (FamilyResultSig -> FamilyResultSig -> Bool)
-> (FamilyResultSig -> FamilyResultSig -> Bool)
-> (FamilyResultSig -> FamilyResultSig -> Bool)
-> (FamilyResultSig -> FamilyResultSig -> FamilyResultSig)
-> (FamilyResultSig -> FamilyResultSig -> FamilyResultSig)
-> Ord FamilyResultSig
FamilyResultSig -> FamilyResultSig -> Bool
FamilyResultSig -> FamilyResultSig -> Ordering
FamilyResultSig -> FamilyResultSig -> FamilyResultSig
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FamilyResultSig -> FamilyResultSig -> Ordering
compare :: FamilyResultSig -> FamilyResultSig -> Ordering
$c< :: FamilyResultSig -> FamilyResultSig -> Bool
< :: FamilyResultSig -> FamilyResultSig -> Bool
$c<= :: FamilyResultSig -> FamilyResultSig -> Bool
<= :: FamilyResultSig -> FamilyResultSig -> Bool
$c> :: FamilyResultSig -> FamilyResultSig -> Bool
> :: FamilyResultSig -> FamilyResultSig -> Bool
$c>= :: FamilyResultSig -> FamilyResultSig -> Bool
>= :: FamilyResultSig -> FamilyResultSig -> Bool
$cmax :: FamilyResultSig -> FamilyResultSig -> FamilyResultSig
max :: FamilyResultSig -> FamilyResultSig -> FamilyResultSig
$cmin :: FamilyResultSig -> FamilyResultSig -> FamilyResultSig
min :: FamilyResultSig -> FamilyResultSig -> FamilyResultSig
Ord, (forall x. FamilyResultSig -> Rep FamilyResultSig x)
-> (forall x. Rep FamilyResultSig x -> FamilyResultSig)
-> Generic FamilyResultSig
forall x. Rep FamilyResultSig x -> FamilyResultSig
forall x. FamilyResultSig -> Rep FamilyResultSig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FamilyResultSig -> Rep FamilyResultSig x
from :: forall x. FamilyResultSig -> Rep FamilyResultSig x
$cto :: forall x. Rep FamilyResultSig x -> FamilyResultSig
to :: forall x. Rep FamilyResultSig x -> FamilyResultSig
Generic )

-- | Injectivity annotation as in an [injective type family](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_families.html)
data InjectivityAnn = InjectivityAnn Name [Name]
  deriving ( Int -> InjectivityAnn -> ShowS
[InjectivityAnn] -> ShowS
InjectivityAnn -> String
(Int -> InjectivityAnn -> ShowS)
-> (InjectivityAnn -> String)
-> ([InjectivityAnn] -> ShowS)
-> Show InjectivityAnn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InjectivityAnn -> ShowS
showsPrec :: Int -> InjectivityAnn -> ShowS
$cshow :: InjectivityAnn -> String
show :: InjectivityAnn -> String
$cshowList :: [InjectivityAnn] -> ShowS
showList :: [InjectivityAnn] -> ShowS
Show, InjectivityAnn -> InjectivityAnn -> Bool
(InjectivityAnn -> InjectivityAnn -> Bool)
-> (InjectivityAnn -> InjectivityAnn -> Bool) -> Eq InjectivityAnn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InjectivityAnn -> InjectivityAnn -> Bool
== :: InjectivityAnn -> InjectivityAnn -> Bool
$c/= :: InjectivityAnn -> InjectivityAnn -> Bool
/= :: InjectivityAnn -> InjectivityAnn -> Bool
Eq, Eq InjectivityAnn
Eq InjectivityAnn =>
(InjectivityAnn -> InjectivityAnn -> Ordering)
-> (InjectivityAnn -> InjectivityAnn -> Bool)
-> (InjectivityAnn -> InjectivityAnn -> Bool)
-> (InjectivityAnn -> InjectivityAnn -> Bool)
-> (InjectivityAnn -> InjectivityAnn -> Bool)
-> (InjectivityAnn -> InjectivityAnn -> InjectivityAnn)
-> (InjectivityAnn -> InjectivityAnn -> InjectivityAnn)
-> Ord InjectivityAnn
InjectivityAnn -> InjectivityAnn -> Bool
InjectivityAnn -> InjectivityAnn -> Ordering
InjectivityAnn -> InjectivityAnn -> InjectivityAnn
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InjectivityAnn -> InjectivityAnn -> Ordering
compare :: InjectivityAnn -> InjectivityAnn -> Ordering
$c< :: InjectivityAnn -> InjectivityAnn -> Bool
< :: InjectivityAnn -> InjectivityAnn -> Bool
$c<= :: InjectivityAnn -> InjectivityAnn -> Bool
<= :: InjectivityAnn -> InjectivityAnn -> Bool
$c> :: InjectivityAnn -> InjectivityAnn -> Bool
> :: InjectivityAnn -> InjectivityAnn -> Bool
$c>= :: InjectivityAnn -> InjectivityAnn -> Bool
>= :: InjectivityAnn -> InjectivityAnn -> Bool
$cmax :: InjectivityAnn -> InjectivityAnn -> InjectivityAnn
max :: InjectivityAnn -> InjectivityAnn -> InjectivityAnn
$cmin :: InjectivityAnn -> InjectivityAnn -> InjectivityAnn
min :: InjectivityAnn -> InjectivityAnn -> InjectivityAnn
Ord, (forall x. InjectivityAnn -> Rep InjectivityAnn x)
-> (forall x. Rep InjectivityAnn x -> InjectivityAnn)
-> Generic InjectivityAnn
forall x. Rep InjectivityAnn x -> InjectivityAnn
forall x. InjectivityAnn -> Rep InjectivityAnn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InjectivityAnn -> Rep InjectivityAnn x
from :: forall x. InjectivityAnn -> Rep InjectivityAnn x
$cto :: forall x. Rep InjectivityAnn x -> InjectivityAnn
to :: forall x. Rep InjectivityAnn x -> InjectivityAnn
Generic )

-- | Type-level literals.
data TyLit = NumTyLit Integer             -- ^ @2@
           | StrTyLit String              -- ^ @\"Hello\"@
           | CharTyLit Char               -- ^ @\'C\'@, @since 4.16.0.0
  deriving ( Int -> TyLit -> ShowS
[TyLit] -> ShowS
TyLit -> String
(Int -> TyLit -> ShowS)
-> (TyLit -> String) -> ([TyLit] -> ShowS) -> Show TyLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TyLit -> ShowS
showsPrec :: Int -> TyLit -> ShowS
$cshow :: TyLit -> String
show :: TyLit -> String
$cshowList :: [TyLit] -> ShowS
showList :: [TyLit] -> ShowS
Show, TyLit -> TyLit -> Bool
(TyLit -> TyLit -> Bool) -> (TyLit -> TyLit -> Bool) -> Eq TyLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TyLit -> TyLit -> Bool
== :: TyLit -> TyLit -> Bool
$c/= :: TyLit -> TyLit -> Bool
/= :: TyLit -> TyLit -> Bool
Eq, Eq TyLit
Eq TyLit =>
(TyLit -> TyLit -> Ordering)
-> (TyLit -> TyLit -> Bool)
-> (TyLit -> TyLit -> Bool)
-> (TyLit -> TyLit -> Bool)
-> (TyLit -> TyLit -> Bool)
-> (TyLit -> TyLit -> TyLit)
-> (TyLit -> TyLit -> TyLit)
-> Ord TyLit
TyLit -> TyLit -> Bool
TyLit -> TyLit -> Ordering
TyLit -> TyLit -> TyLit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TyLit -> TyLit -> Ordering
compare :: TyLit -> TyLit -> Ordering
$c< :: TyLit -> TyLit -> Bool
< :: TyLit -> TyLit -> Bool
$c<= :: TyLit -> TyLit -> Bool
<= :: TyLit -> TyLit -> Bool
$c> :: TyLit -> TyLit -> Bool
> :: TyLit -> TyLit -> Bool
$c>= :: TyLit -> TyLit -> Bool
>= :: TyLit -> TyLit -> Bool
$cmax :: TyLit -> TyLit -> TyLit
max :: TyLit -> TyLit -> TyLit
$cmin :: TyLit -> TyLit -> TyLit
min :: TyLit -> TyLit -> TyLit
Ord, (forall x. TyLit -> Rep TyLit x)
-> (forall x. Rep TyLit x -> TyLit) -> Generic TyLit
forall x. Rep TyLit x -> TyLit
forall x. TyLit -> Rep TyLit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TyLit -> Rep TyLit x
from :: forall x. TyLit -> Rep TyLit x
$cto :: forall x. Rep TyLit x -> TyLit
to :: forall x. Rep TyLit x -> TyLit
Generic )

-- | Role annotations
data Role = NominalR            -- ^ @nominal@
          | RepresentationalR   -- ^ @representational@
          | PhantomR            -- ^ @phantom@
          | InferR              -- ^ @_@
  deriving( Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, Eq Role
Eq Role =>
(Role -> Role -> Ordering)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Role)
-> (Role -> Role -> Role)
-> Ord Role
Role -> Role -> Bool
Role -> Role -> Ordering
Role -> Role -> Role
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Role -> Role -> Ordering
compare :: Role -> Role -> Ordering
$c< :: Role -> Role -> Bool
< :: Role -> Role -> Bool
$c<= :: Role -> Role -> Bool
<= :: Role -> Role -> Bool
$c> :: Role -> Role -> Bool
> :: Role -> Role -> Bool
$c>= :: Role -> Role -> Bool
>= :: Role -> Role -> Bool
$cmax :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
min :: Role -> Role -> Role
Ord, (forall x. Role -> Rep Role x)
-> (forall x. Rep Role x -> Role) -> Generic Role
forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Role -> Rep Role x
from :: forall x. Role -> Rep Role x
$cto :: forall x. Rep Role x -> Role
to :: forall x. Rep Role x -> Role
Generic )

-- | Annotation target for reifyAnnotations
data AnnLookup = AnnLookupModule Module
               | AnnLookupName Name
               deriving( Int -> AnnLookup -> ShowS
[AnnLookup] -> ShowS
AnnLookup -> String
(Int -> AnnLookup -> ShowS)
-> (AnnLookup -> String)
-> ([AnnLookup] -> ShowS)
-> Show AnnLookup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnnLookup -> ShowS
showsPrec :: Int -> AnnLookup -> ShowS
$cshow :: AnnLookup -> String
show :: AnnLookup -> String
$cshowList :: [AnnLookup] -> ShowS
showList :: [AnnLookup] -> ShowS
Show, AnnLookup -> AnnLookup -> Bool
(AnnLookup -> AnnLookup -> Bool)
-> (AnnLookup -> AnnLookup -> Bool) -> Eq AnnLookup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnnLookup -> AnnLookup -> Bool
== :: AnnLookup -> AnnLookup -> Bool
$c/= :: AnnLookup -> AnnLookup -> Bool
/= :: AnnLookup -> AnnLookup -> Bool
Eq, Eq AnnLookup
Eq AnnLookup =>
(AnnLookup -> AnnLookup -> Ordering)
-> (AnnLookup -> AnnLookup -> Bool)
-> (AnnLookup -> AnnLookup -> Bool)
-> (AnnLookup -> AnnLookup -> Bool)
-> (AnnLookup -> AnnLookup -> Bool)
-> (AnnLookup -> AnnLookup -> AnnLookup)
-> (AnnLookup -> AnnLookup -> AnnLookup)
-> Ord AnnLookup
AnnLookup -> AnnLookup -> Bool
AnnLookup -> AnnLookup -> Ordering
AnnLookup -> AnnLookup -> AnnLookup
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AnnLookup -> AnnLookup -> Ordering
compare :: AnnLookup -> AnnLookup -> Ordering
$c< :: AnnLookup -> AnnLookup -> Bool
< :: AnnLookup -> AnnLookup -> Bool
$c<= :: AnnLookup -> AnnLookup -> Bool
<= :: AnnLookup -> AnnLookup -> Bool
$c> :: AnnLookup -> AnnLookup -> Bool
> :: AnnLookup -> AnnLookup -> Bool
$c>= :: AnnLookup -> AnnLookup -> Bool
>= :: AnnLookup -> AnnLookup -> Bool
$cmax :: AnnLookup -> AnnLookup -> AnnLookup
max :: AnnLookup -> AnnLookup -> AnnLookup
$cmin :: AnnLookup -> AnnLookup -> AnnLookup
min :: AnnLookup -> AnnLookup -> AnnLookup
Ord, (forall x. AnnLookup -> Rep AnnLookup x)
-> (forall x. Rep AnnLookup x -> AnnLookup) -> Generic AnnLookup
forall x. Rep AnnLookup x -> AnnLookup
forall x. AnnLookup -> Rep AnnLookup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnnLookup -> Rep AnnLookup x
from :: forall x. AnnLookup -> Rep AnnLookup x
$cto :: forall x. Rep AnnLookup x -> AnnLookup
to :: forall x. Rep AnnLookup x -> AnnLookup
Generic )

-- | To avoid duplication between kinds and types, they
-- are defined to be the same. Naturally, you would never
-- have a type be 'StarT' and you would never have a kind
-- be 'SigT', but many of the other constructors are shared.
-- Note that the kind @Bool@ is denoted with 'ConT', not
-- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',
-- not 'PromotedTupleT'.

type Kind = Type

{- Note [Representing concrete syntax in types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Haskell has a rich concrete syntax for types, including
  t1 -> t2, (t1,t2), [t], and so on
In TH we represent all of this using AppT, with a distinguished
type constructor at the head.  So,
  Type              TH representation
  -----------------------------------------------
  t1 -> t2          ArrowT `AppT` t2 `AppT` t2
  [t]               ListT `AppT` t
  (t1,t2)           TupleT 2 `AppT` t1 `AppT` t2
  '(t1,t2)          PromotedTupleT 2 `AppT` t1 `AppT` t2

But if the original HsSyn used prefix application, we won't use
these special TH constructors.  For example
  [] t              ConT "[]" `AppT` t
  (->) t            ConT "->" `AppT` t
In this way we can faithfully represent in TH whether the original
HsType used concrete syntax or not.

The one case that doesn't fit this pattern is that of promoted lists
  '[ Maybe, IO ]    PromotedListT 2 `AppT` t1 `AppT` t2
but it's very smelly because there really is no type constructor
corresponding to PromotedListT. So we encode HsExplicitListTy with
PromotedConsT and PromotedNilT (which *do* have underlying type
constructors):
  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT`
                    (PromotedConsT  `AppT` IO `AppT` PromotedNilT)
-}

-- | A location at which to attach Haddock documentation.
-- Note that adding documentation to a 'Name' defined oustide of the current
-- module will cause an error.
data DocLoc
  = ModuleDoc         -- ^ At the current module's header.
  | DeclDoc Name      -- ^ At a declaration, not necessarily top level.
  | ArgDoc Name Int   -- ^ At a specific argument of a function, indexed by its
                      -- position.
  | InstDoc Type      -- ^ At a class or family instance.
  deriving ( Int -> DocLoc -> ShowS
[DocLoc] -> ShowS
DocLoc -> String
(Int -> DocLoc -> ShowS)
-> (DocLoc -> String) -> ([DocLoc] -> ShowS) -> Show DocLoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocLoc -> ShowS
showsPrec :: Int -> DocLoc -> ShowS
$cshow :: DocLoc -> String
show :: DocLoc -> String
$cshowList :: [DocLoc] -> ShowS
showList :: [DocLoc] -> ShowS
Show, DocLoc -> DocLoc -> Bool
(DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> Bool) -> Eq DocLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocLoc -> DocLoc -> Bool
== :: DocLoc -> DocLoc -> Bool
$c/= :: DocLoc -> DocLoc -> Bool
/= :: DocLoc -> DocLoc -> Bool
Eq, Eq DocLoc
Eq DocLoc =>
(DocLoc -> DocLoc -> Ordering)
-> (DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> DocLoc)
-> (DocLoc -> DocLoc -> DocLoc)
-> Ord DocLoc
DocLoc -> DocLoc -> Bool
DocLoc -> DocLoc -> Ordering
DocLoc -> DocLoc -> DocLoc
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DocLoc -> DocLoc -> Ordering
compare :: DocLoc -> DocLoc -> Ordering
$c< :: DocLoc -> DocLoc -> Bool
< :: DocLoc -> DocLoc -> Bool
$c<= :: DocLoc -> DocLoc -> Bool
<= :: DocLoc -> DocLoc -> Bool
$c> :: DocLoc -> DocLoc -> Bool
> :: DocLoc -> DocLoc -> Bool
$c>= :: DocLoc -> DocLoc -> Bool
>= :: DocLoc -> DocLoc -> Bool
$cmax :: DocLoc -> DocLoc -> DocLoc
max :: DocLoc -> DocLoc -> DocLoc
$cmin :: DocLoc -> DocLoc -> DocLoc
min :: DocLoc -> DocLoc -> DocLoc
Ord, (forall x. DocLoc -> Rep DocLoc x)
-> (forall x. Rep DocLoc x -> DocLoc) -> Generic DocLoc
forall x. Rep DocLoc x -> DocLoc
forall x. DocLoc -> Rep DocLoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DocLoc -> Rep DocLoc x
from :: forall x. DocLoc -> Rep DocLoc x
$cto :: forall x. Rep DocLoc x -> DocLoc
to :: forall x. Rep DocLoc x -> DocLoc
Generic )

-----------------------------------------------------
--              Internal helper functions
-----------------------------------------------------

-- | Internal helper function.
cmpEq :: Ordering -> Bool
cmpEq :: Ordering -> Bool
cmpEq Ordering
EQ = Bool
True
cmpEq Ordering
_  = Bool
False

-- | Internal helper function.
thenCmp :: Ordering -> Ordering -> Ordering
thenCmp :: Ordering -> Ordering -> Ordering
thenCmp Ordering
EQ Ordering
o2 = Ordering
o2
thenCmp Ordering
o1 Ordering
_  = Ordering
o1

-- | Internal helper function.
get_cons_names :: Con -> [Name]
get_cons_names :: Con -> [Name]
get_cons_names (NormalC Name
n [BangType]
_)     = [Name
n]
get_cons_names (RecC Name
n [VarBangType]
_)        = [Name
n]
get_cons_names (InfixC BangType
_ Name
n BangType
_)    = [Name
n]
get_cons_names (ForallC [TyVarBndr Specificity]
_ [Type]
_ Con
con) = Con -> [Name]
get_cons_names Con
con
-- GadtC can have multiple names, e.g
-- > data Bar a where
-- >   MkBar1, MkBar2 :: a -> Bar a
-- Will have one GadtC with [MkBar1, MkBar2] as names
get_cons_names (GadtC [Name]
ns [BangType]
_ Type
_)    = [Name]
ns
get_cons_names (RecGadtC [Name]
ns [VarBangType]
_ Type
_) = [Name]
ns