    {- Language/Haskell/TH/Desugar/AST.hs

    (c) Ryan Scott 2018

    Defines the desugared Template Haskell AST. The desugared types and
    constructors are prefixed with a D.
    -}

    {-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric #-}

    module Language.Haskell.TH.Desugar.AST where

    import Data.Data hiding (Fixity)
    import GHC.Generics hiding (Fixity)
    import Language.Haskell.TH

    -- | Corresponds to TH's @Exp@ type. Note that @DLamE@ takes names, not patterns.
    data DExp = DVarE Name
              | DConE Name
              | DLitE Lit
              | DAppE DExp DExp
              | DAppTypeE DExp DType
              | DLamE [Name] DExp
              | DCaseE DExp [DMatch]
              | DLetE [DLetDec] DExp
              | DSigE DExp DType
              | DStaticE DExp
              deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @Pat@ type.
    data DPat = DLitPa Lit
              | DVarPa Name
              | DConPa Name [DPat]
              | DTildePa DPat
              | DBangPa DPat
              | DSigPa DPat DType
              | DWildPa
              deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @Type@ type, used to represent
    -- types and kinds.
    data DType = DForallT [DTyVarBndr] DCxt DType
               | DAppT DType DType
               | DSigT DType DKind
               | DVarT Name
               | DConT Name
               | DArrowT
               | DLitT TyLit
               | DWildCardT
               deriving (Show, Typeable, Data, Generic)

    -- | Kinds are types.
    type DKind = DType

    -- | Corresponds to TH's @Cxt@
    type DCxt = [DPred]

    -- | Corresponds to TH's @Pred@
    data DPred = DForallPr [DTyVarBndr] DCxt DPred
               | DAppPr DPred DType
               | DSigPr DPred DKind
               | DVarPr Name
               | DConPr Name
               | DWildCardPr
               deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @TyVarBndr@
    data DTyVarBndr = DPlainTV Name
                    | DKindedTV Name DKind
                    deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @Match@ type.
    data DMatch = DMatch DPat DExp
      deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @Clause@ type.
    data DClause = DClause [DPat] DExp
      deriving (Show, Typeable, Data, Generic)

    -- | Declarations as used in a @let@ statement.
    data DLetDec = DFunD Name [DClause]
                 | DValD DPat DExp
                 | DSigD Name DType
                 | DInfixD Fixity Name
                 | DPragmaD DPragma
                 deriving (Show, Typeable, Data, Generic)

    -- | Is it a @newtype@ or a @data@ type?
    data NewOrData = Newtype
                   | Data
                   deriving (Eq, Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @Dec@ type.
    data DDec = DLetDec DLetDec
              | DDataD NewOrData DCxt Name [DTyVarBndr] (Maybe DKind) [DCon] [DDerivClause]
              | DTySynD Name [DTyVarBndr] DType
              | DClassD DCxt Name [DTyVarBndr] [FunDep] [DDec]
              | DInstanceD (Maybe Overlap) DCxt DType [DDec]
              | DForeignD DForeign
              | DOpenTypeFamilyD DTypeFamilyHead
              | DClosedTypeFamilyD DTypeFamilyHead [DTySynEqn]
              | DDataFamilyD Name [DTyVarBndr] (Maybe DKind)
              | DDataInstD NewOrData DCxt Name [DType] (Maybe DKind) [DCon] [DDerivClause]
              | DTySynInstD Name DTySynEqn
              | DRoleAnnotD Name [Role]
              | DStandaloneDerivD (Maybe DDerivStrategy) DCxt DType
              | DDefaultSigD Name DType
              | DPatSynD Name PatSynArgs DPatSynDir DPat
              | DPatSynSigD Name DPatSynType
              deriving (Show, Typeable, Data, Generic)

    #if __GLASGOW_HASKELL__ < 711
    data Overlap = Overlappable | Overlapping | Overlaps | Incoherent
      deriving (Eq, Ord, Show, Typeable, Data, Generic)
    #endif

    -- | Corresponds to TH's 'PatSynDir' type
    data DPatSynDir = DUnidir              -- ^ @pattern P x {<-} p@
                    | DImplBidir           -- ^ @pattern P x {=} p@
                    | DExplBidir [DClause] -- ^ @pattern P x {<-} p where P x = e@
                    deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's 'PatSynType' type
    type DPatSynType = DType

    #if __GLASGOW_HASKELL__ < 801
    -- | Same as @PatSynArgs@ from TH; defined here for backwards compatibility.
    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 (Show, Typeable, Data, Generic)
    #endif

    -- | Corresponds to TH's 'TypeFamilyHead' type
    data DTypeFamilyHead = DTypeFamilyHead Name [DTyVarBndr] DFamilyResultSig
                                           (Maybe InjectivityAnn)
                         deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's 'FamilyResultSig' type
    data DFamilyResultSig = DNoSig
                          | DKindSig DKind
                          | DTyVarSig DTyVarBndr
                          deriving (Show, Typeable, Data, Generic)

    #if __GLASGOW_HASKELL__ <= 710
    data InjectivityAnn = InjectivityAnn Name [Name]
      deriving (Eq, Ord, Show, Typeable, Data, Generic)
    #endif

    -- | Corresponds to TH's 'Con' type. Unlike 'Con', all 'DCon's reflect GADT
    -- syntax. This is beneficial for @th-desugar@'s since it means
    -- that all data type declarations can support explicit return kinds, so
    -- one does not need to represent them with something like @'Maybe' 'DKind'@,
    -- since Haskell98-style data declaration syntax isn't used. Accordingly,
    -- there are some differences between 'DCon' and 'Con' to keep in mind:
    --
    -- * Unlike 'ForallC', where the meaning of the 'TyVarBndr's changes depending
    --   on whether it's followed by 'GadtC'/'RecGadtC' or not, the meaning of the
    --   'DTyVarBndr's in a 'DCon' is always the same: it is the list of
    --   universally /and/ existentially quantified type variables. Note that it is
    --   not guaranteed that one set of type variables will appear before the
    --   other.
    --
    -- * A 'DCon' always has an explicit return type.
    data DCon = DCon [DTyVarBndr] DCxt Name DConFields
                     DType  -- ^ The GADT result type
              deriving (Show, Typeable, Data, Generic)

    -- | A list of fields either for a standard data constructor or a record
    -- data constructor.
    data DConFields = DNormalC DDeclaredInfix [DBangType]
                    | DRecC [DVarBangType]
                    deriving (Show, Typeable, Data, Generic)

    -- | 'True' if a constructor is declared infix. For normal ADTs, this means
    -- that is was written in infix style. For example, both of the constructors
    -- below are declared infix.
    --
    -- @
    -- data Infix = Int `Infix` Int | Int :*: Int
    -- @
    --
    -- Whereas neither of these constructors are declared infix:
    --
    -- @
    -- data Prefix = Prefix Int Int | (:+:) Int Int
    -- @
    --
    -- For GADTs, detecting whether a constructor is declared infix is a bit
    -- trickier, as one cannot write a GADT constructor "infix-style" like one
    -- can for normal ADT constructors. GHC considers a GADT constructor to be
    -- declared infix if it meets the following three criteria:
    --
    -- 1. Its name uses operator syntax (e.g., @(:*:)@).
    -- 2. It has exactly two fields (without record syntax).
    -- 3. It has a programmer-specified fixity declaration.
    --
    -- For example, in the following GADT:
    --
    -- @
    -- infixl 5 :**:, :&&:, :^^:, `ActuallyPrefix`
    -- data InfixGADT a where
    --   (:**:) :: Int -> b -> InfixGADT (Maybe b) -- Only this one is infix
    --   ActuallyPrefix :: Char -> Bool -> InfixGADT Double
    --   (:&&:) :: { infixGADT1 :: b, infixGADT2 :: Int } -> InfixGADT [b]
    --   (:^^:) :: Int -> Int -> Int -> InfixGADT Int
    --   (:!!:) :: Char -> Char -> InfixGADT Char
    -- @
    --
    -- Only the @(:**:)@ constructor is declared infix. The other constructors
    -- are not declared infix, because:
    --
    -- * @ActuallyPrefix@ does not use operator syntax (criterion 1).
    -- * @(:&&:)@ uses record syntax (criterion 2).
    -- * @(:^^:)@ does not have exactly two fields (criterion 2).
    -- * @(:!!:)@ does not have a programmer-specified fixity declaration (criterion 3).
    type DDeclaredInfix = Bool

    -- | Corresponds to TH's @BangType@ type.
    type DBangType = (Bang, DType)

    -- | Corresponds to TH's @VarBangType@ type.
    type DVarBangType = (Name, Bang, DType)

    #if __GLASGOW_HASKELL__ <= 710
    -- | Corresponds to TH's definition
    data SourceUnpackedness = NoSourceUnpackedness
                            | SourceNoUnpack
                            | SourceUnpack
      deriving (Eq, Ord, Show, Typeable, Data, Generic)

    -- | Corresponds to TH's definition
    data SourceStrictness = NoSourceStrictness
                          | SourceLazy
                          | SourceStrict
      deriving (Eq, Ord, Show, Typeable, Data, Generic)

    -- | Corresponds to TH's definition
    data Bang = Bang SourceUnpackedness SourceStrictness
      deriving (Eq, Ord, Show, Typeable, Data, Generic)
    #endif

    -- | Corresponds to TH's @Foreign@ type.
    data DForeign = DImportF Callconv Safety String Name DType
                  | DExportF Callconv String Name DType
                  deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @Pragma@ type.
    data DPragma = DInlineP Name Inline RuleMatch Phases
                 | DSpecialiseP Name DType (Maybe Inline) Phases
                 | DSpecialiseInstP DType
                 | DRuleP String [DRuleBndr] DExp DExp Phases
                 | DAnnP AnnTarget DExp
                 | DLineP Int String
                 | DCompleteP [Name] (Maybe Name)
                 deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @RuleBndr@ type.
    data DRuleBndr = DRuleVar Name
                   | DTypedRuleVar Name DType
                   deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @TySynEqn@ type (to store type family equations).
    data DTySynEqn = DTySynEqn [DType] DType
                   deriving (Show, Typeable, Data, Generic)

    #if __GLASGOW_HASKELL__ < 707
    -- | Same as @Role@ from TH; defined here for GHC 7.6.3 compatibility.
    data Role = NominalR | RepresentationalR | PhantomR | InferR
              deriving (Show, Typeable, Data, Generic)

    -- | Same as @AnnTarget@ from TH; defined here for GHC 7.6.3 compatibility.
    data AnnTarget = ModuleAnnotation
                   | TypeAnnotation Name
                   | ValueAnnotation Name
                   deriving (Show, Typeable, Data, Generic)
    #endif

    -- | Corresponds to TH's @Info@ type.
    data DInfo = DTyConI DDec (Maybe [DInstanceDec])
               | DVarI Name DType (Maybe Name)
                   -- ^ The @Maybe Name@ stores the name of the enclosing definition
                   -- (datatype, for a data constructor; class, for a method),
                   -- if any
               | DTyVarI Name DKind
               | DPrimTyConI Name Int Bool
                   -- ^ The @Int@ is the arity; the @Bool@ is whether this tycon
                   -- is unlifted.
               | DPatSynI Name DPatSynType
               deriving (Show, Typeable, Data, Generic)

    type DInstanceDec = DDec -- ^ Guaranteed to be an instance declaration

    -- | Corresponds to TH's @DerivClause@ type.
    data DDerivClause = DDerivClause (Maybe DDerivStrategy) DCxt
                      deriving (Show, Typeable, Data, Generic)

    -- | Corresponds to TH's @DerivStrategy@ type.
    data DDerivStrategy = DStockStrategy     -- ^ A \"standard\" derived instance
                        | DAnyclassStrategy  -- ^ @-XDeriveAnyClass@
                        | DNewtypeStrategy   -- ^ @-XGeneralizedNewtypeDeriving@
                        | DViaStrategy DType -- ^ @-XDerivingVia@
                        deriving (Show, Typeable, Data, Generic)