{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternSynonyms #-}

-- | Types to pretty-print certain parts of Haskell codes.
--
-- We define new types to pretty-print AST nodes rather than define
-- functions to print comments easily using the 'Pretty' implementation of
-- 'GenLocated'.
module HIndent.Pretty.Types
  ( InfixExpr(..)
  , InfixOp(..)
  , PrefixOp(..)
  , InfixApp(..)
  , GRHSsExpr(..)
  , GRHSExpr(..)
  , GRHSProc(..)
  , RecConPat(..)
  , RecConField(..)
  , HsSigType'(..)
  , pattern HsSigTypeInsideInstDecl
  , pattern HsSigTypeInsideVerticalFuncSig
  , pattern HsSigTypeInsideDeclSig
  , HsType'(..)
  , pattern HsTypeInsideVerticalFuncSig
  , pattern HsTypeInsideDeclSig
  , pattern HsTypeInsideInstDecl
  , pattern HsTypeWithVerticalAppTy
  , DataFamInstDecl'(..)
  , pattern DataFamInstDeclTopLevel
  , pattern DataFamInstDeclInsideClassInst
  , FamEqn'(..)
  , pattern FamEqnTopLevel
  , pattern FamEqnInsideClassInst
  , StmtLRInsideVerticalList(..)
  , ParStmtBlockInsideVerticalList(..)
  , DeclSig(..)
  , TopLevelTyFamInstDecl(..)
  , Context(..)
  , HorizontalContext(..)
  , VerticalContext(..)
  , ModuleNameWithPrefix(..)
  , PatInsidePatDecl(..)
  , LambdaCase(..)
  , ModuleDeprecatedPragma(..)
  , ListComprehension(..)
  , DoExpression(..)
  , DoOrMdo(..)
  , LetIn(..)
  , NodeComments(..)
  , GRHSExprType(..)
  , GRHSProcType(..)
  , HsTypeFor(..)
  , HsTypeDir(..)
  , CaseOrCases(..)
  , DataFamInstDeclFor(..)
  ) where

import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Unit
import GHC.Unit.Module.Warnings

-- | `LHsExpr` used as a infix operator
newtype InfixExpr =
  InfixExpr (LHsExpr GhcPs)

newtype InfixOp =
  InfixOp RdrName

-- | A wrapper type for printing an identifier as a prefix operator.
--
-- Printing a `PrefixOp` value containing a symbol operator wraps it with
-- parentheses.
newtype PrefixOp =
  PrefixOp RdrName

-- | An infix operator application.
--
-- `immediatelyAfterDo` is `True` if an application is next to a `do`
-- keyword. It needs an extra indent in such cases because
--
-- > do a
-- > * b
--
-- is not a valid Haskell code.
data InfixApp = InfixApp
  { InfixApp -> LHsExpr GhcPs
lhs :: LHsExpr GhcPs
  , InfixApp -> LHsExpr GhcPs
op :: LHsExpr GhcPs
  , InfixApp -> LHsExpr GhcPs
rhs :: LHsExpr GhcPs
  , InfixApp -> Bool
immediatelyAfterDo :: Bool
  }

-- | `GRHSs` with a label indicating in which context the RHS is located
-- in.
data GRHSsExpr = GRHSsExpr
  { GRHSsExpr -> GRHSExprType
grhssExprType :: GRHSExprType
  , GRHSsExpr -> GRHSs GhcPs (LHsExpr GhcPs)
grhssExpr :: GRHSs GhcPs (LHsExpr GhcPs)
  }

-- | 'GRHS' for a normal binding.
data GRHSExpr = GRHSExpr
  { GRHSExpr -> GRHSExprType
grhsExprType :: GRHSExprType
  , GRHSExpr -> GRHS GhcPs (LHsExpr GhcPs)
grhsExpr :: GRHS GhcPs (LHsExpr GhcPs)
  }

-- | 'GRHS' for a @proc@ binding.
newtype GRHSProc =
  GRHSProc (GRHS GhcPs (LHsCmd GhcPs))

-- | A pattern match against a record.
newtype RecConPat =
  RecConPat (HsRecFields GhcPs (LPat GhcPs))
#if MIN_VERSION_ghc_lib_parser(9,4,1)
-- | A record field in a pattern match.
newtype RecConField =
  RecConField (HsFieldBind (LFieldOcc GhcPs) (LPat GhcPs))
#else
-- | A record field in a pattern match.
newtype RecConField =
  RecConField (HsRecField' (FieldOcc GhcPs) (LPat GhcPs))
#endif
-- | A wrapper for `HsSigType`.
data HsSigType' = HsSigType'
  { HsSigType' -> HsTypeFor
hsSigTypeFor :: HsTypeFor -- ^ In which context a `HsSigType` is located in.
  , HsSigType' -> HsTypeDir
hsSigTypeDir :: HsTypeDir -- ^ How a `HsSigType` should be printed;
                                -- either horizontally or vertically.
  , HsSigType' -> HsSigType GhcPs
hsSigType :: HsSigType GhcPs -- ^ The actual signature.
  }

-- | `HsSigType'` for instance declarations.
pattern HsSigTypeInsideInstDecl :: HsSigType GhcPs -> HsSigType'
pattern $mHsSigTypeInsideInstDecl :: forall {r}.
HsSigType' -> (HsSigType GhcPs -> r) -> ((# #) -> r) -> r
$bHsSigTypeInsideInstDecl :: HsSigType GhcPs -> HsSigType'
HsSigTypeInsideInstDecl x = HsSigType' HsTypeForInstDecl HsTypeNoDir x

-- | `HsSigType'` for function declarations; printed horizontally.
pattern HsSigTypeInsideVerticalFuncSig :: HsSigType GhcPs -> HsSigType'
pattern $mHsSigTypeInsideVerticalFuncSig :: forall {r}.
HsSigType' -> (HsSigType GhcPs -> r) -> ((# #) -> r) -> r
$bHsSigTypeInsideVerticalFuncSig :: HsSigType GhcPs -> HsSigType'
HsSigTypeInsideVerticalFuncSig x = HsSigType' HsTypeForFuncSig HsTypeVertical x

-- | `HsSigType'` for a top-level function signature.
pattern HsSigTypeInsideDeclSig :: HsSigType GhcPs -> HsSigType'
pattern $mHsSigTypeInsideDeclSig :: forall {r}.
HsSigType' -> (HsSigType GhcPs -> r) -> ((# #) -> r) -> r
$bHsSigTypeInsideDeclSig :: HsSigType GhcPs -> HsSigType'
HsSigTypeInsideDeclSig x = HsSigType' HsTypeForDeclSig HsTypeNoDir x

-- | A wrapper for `HsType`.
data HsType' = HsType'
  { HsType' -> HsTypeFor
hsTypeFor :: HsTypeFor -- ^ In which context a `HsType` is located in.
  , HsType' -> HsTypeDir
hsTypeDir :: HsTypeDir -- ^ How a function signature is printed;
                           -- either horizontally or vertically.
  , HsType' -> HsType GhcPs
hsType :: HsType GhcPs -- ^ The actual type.
  }

-- | `HsType'` inside a function signature declaration; printed horizontally.
pattern HsTypeInsideVerticalFuncSig :: HsType GhcPs -> HsType'
pattern $mHsTypeInsideVerticalFuncSig :: forall {r}. HsType' -> (HsType GhcPs -> r) -> ((# #) -> r) -> r
$bHsTypeInsideVerticalFuncSig :: HsType GhcPs -> HsType'
HsTypeInsideVerticalFuncSig x = HsType' HsTypeForFuncSig HsTypeVertical x

-- | `HsType'` inside a top-level function signature declaration.
pattern HsTypeInsideDeclSig :: HsType GhcPs -> HsType'
pattern $mHsTypeInsideDeclSig :: forall {r}. HsType' -> (HsType GhcPs -> r) -> ((# #) -> r) -> r
$bHsTypeInsideDeclSig :: HsType GhcPs -> HsType'
HsTypeInsideDeclSig x = HsType' HsTypeForDeclSig HsTypeNoDir x

-- | `HsType'` inside a instance signature declaration.
pattern HsTypeInsideInstDecl :: HsType GhcPs -> HsType'
pattern $mHsTypeInsideInstDecl :: forall {r}. HsType' -> (HsType GhcPs -> r) -> ((# #) -> r) -> r
$bHsTypeInsideInstDecl :: HsType GhcPs -> HsType'
HsTypeInsideInstDecl x = HsType' HsTypeForInstDecl HsTypeNoDir x

-- | `HsType'` to pretty-print a `HsAppTy` vertically.
pattern HsTypeWithVerticalAppTy :: HsType GhcPs -> HsType'
pattern $mHsTypeWithVerticalAppTy :: forall {r}. HsType' -> (HsType GhcPs -> r) -> ((# #) -> r) -> r
$bHsTypeWithVerticalAppTy :: HsType GhcPs -> HsType'
HsTypeWithVerticalAppTy x = HsType' HsTypeForVerticalAppTy HsTypeVertical x

-- | A wrapper of `DataFamInstDecl`.
data DataFamInstDecl' = DataFamInstDecl'
  { DataFamInstDecl' -> DataFamInstDeclFor
dataFamInstDeclFor :: DataFamInstDeclFor -- ^ Where a data family instance is declared.
  , DataFamInstDecl' -> DataFamInstDecl GhcPs
dataFamInstDecl :: DataFamInstDecl GhcPs -- ^ The actual value.
  }

-- | `DataFamInstDecl'` wrapping a `DataFamInstDecl` representing
-- a top-level data family instance.
pattern DataFamInstDeclTopLevel :: DataFamInstDecl GhcPs -> DataFamInstDecl'
pattern $mDataFamInstDeclTopLevel :: forall {r}.
DataFamInstDecl'
-> (DataFamInstDecl GhcPs -> r) -> ((# #) -> r) -> r
$bDataFamInstDeclTopLevel :: DataFamInstDecl GhcPs -> DataFamInstDecl'
DataFamInstDeclTopLevel x = DataFamInstDecl' DataFamInstDeclForTopLevel x

-- | `DataFamInstDecl'` wrapping a `DataFamInstDecl` representing a data
-- family instance inside a class instance.
pattern DataFamInstDeclInsideClassInst :: DataFamInstDecl GhcPs -> DataFamInstDecl'
pattern $mDataFamInstDeclInsideClassInst :: forall {r}.
DataFamInstDecl'
-> (DataFamInstDecl GhcPs -> r) -> ((# #) -> r) -> r
$bDataFamInstDeclInsideClassInst :: DataFamInstDecl GhcPs -> DataFamInstDecl'
DataFamInstDeclInsideClassInst x = DataFamInstDecl' DataFamInstDeclForInsideClassInst x

-- | A wrapper for `FamEqn`.
data FamEqn' = FamEqn'
  { FamEqn' -> DataFamInstDeclFor
famEqnFor :: DataFamInstDeclFor -- ^ Where a data family instance is declared.
  , FamEqn' -> FamEqn GhcPs (HsDataDefn GhcPs)
famEqn :: FamEqn GhcPs (HsDataDefn GhcPs)
  }

-- | `FamEqn'` wrapping a `FamEqn` representing a top-level data family
-- instance.
pattern FamEqnTopLevel :: FamEqn GhcPs (HsDataDefn GhcPs) -> FamEqn'
pattern $mFamEqnTopLevel :: forall {r}.
FamEqn'
-> (FamEqn GhcPs (HsDataDefn GhcPs) -> r) -> ((# #) -> r) -> r
$bFamEqnTopLevel :: FamEqn GhcPs (HsDataDefn GhcPs) -> FamEqn'
FamEqnTopLevel x = FamEqn' DataFamInstDeclForTopLevel x

-- | `FamEqn'` wrapping a `FamEqn` representing a data family instance
-- inside a class instance.
pattern FamEqnInsideClassInst :: FamEqn GhcPs (HsDataDefn GhcPs) -> FamEqn'
pattern $mFamEqnInsideClassInst :: forall {r}.
FamEqn'
-> (FamEqn GhcPs (HsDataDefn GhcPs) -> r) -> ((# #) -> r) -> r
$bFamEqnInsideClassInst :: FamEqn GhcPs (HsDataDefn GhcPs) -> FamEqn'
FamEqnInsideClassInst x = FamEqn' DataFamInstDeclForInsideClassInst x

-- | `StmtLR` inside a vertically printed list.
newtype StmtLRInsideVerticalList =
  StmtLRInsideVerticalList (StmtLR GhcPs GhcPs (LHsExpr GhcPs))

-- | `ParStmtBlock` inside a vertically printed list.
newtype ParStmtBlockInsideVerticalList =
  ParStmtBlockInsideVerticalList (ParStmtBlock GhcPs GhcPs)

-- | A top-level function signature.
newtype DeclSig =
  DeclSig (Sig GhcPs)

-- | A top-level type family instance declaration.
newtype TopLevelTyFamInstDecl =
  TopLevelTyFamInstDecl (TyFamInstDecl GhcPs)
#if MIN_VERSION_ghc_lib_parser(9,4,1)
-- | A wrapper type for type class constraints; e.g., (Eq a, Ord a) of (Eq
-- a, Ord a) => [a] -> [a]. Either 'HorizontalContext' or 'VerticalContext'
-- is used internally.
newtype Context =
  Context (LHsContext GhcPs)

-- | A wrapper type for printing a context horizontally.
newtype HorizontalContext =
  HorizontalContext (LHsContext GhcPs)

-- | A wrapper type for printing a context vertically.
newtype VerticalContext =
  VerticalContext (LHsContext GhcPs)
#else
-- | A wrapper type for type class constraints; e.g., (Eq a, Ord a) of (Eq
-- a, Ord a) => [a] -> [a]. Either 'HorizontalContext' or 'VerticalContext'
-- is used internally.
newtype Context =
  Context (Maybe (LHsContext GhcPs))

-- | A wrapper type for printing a context horizontally.
newtype HorizontalContext =
  HorizontalContext (Maybe (LHsContext GhcPs))

-- | A wrapper type for printing a context vertically.
newtype VerticalContext =
  VerticalContext (Maybe (LHsContext GhcPs))
#endif
-- | A wrapper type for pretty-printing a value of @ModuleName@ with the
-- @module @ prefix.
--
-- Pretty-printing it via @(string "module " >> pretty (name ::
-- ModuleName))@ locates comments before @name@ in the same line as @module
-- @ and the name will be in the next line. This type is to avoid the
-- problem.
newtype ModuleNameWithPrefix =
  ModuleNameWithPrefix ModuleName

-- | A wrapper for 'LPat' inside a pattern declaration. Here, all infix
-- patterns have extra spaces around the operators, like x : xs.
newtype PatInsidePatDecl =
  PatInsidePatDecl (Pat GhcPs)

-- | Lambda case.
data LambdaCase = LambdaCase
  { LambdaCase -> MatchGroup GhcPs (LHsExpr GhcPs)
lamCaseGroup :: MatchGroup GhcPs (LHsExpr GhcPs)
  , LambdaCase -> CaseOrCases
caseOrCases :: CaseOrCases
  }
#if MIN_VERSION_ghc_lib_parser(9,4,1)
-- | A deprecation pragma for a module.
newtype ModuleDeprecatedPragma =
  ModuleDeprecatedPragma (WarningTxt GhcPs)
#else
-- | A deprecation pragma for a module.
newtype ModuleDeprecatedPragma =
  ModuleDeprecatedPragma WarningTxt
#endif
-- | Use this type to pretty-print a list comprehension.
data ListComprehension = ListComprehension
  { ListComprehension -> ExprLStmt GhcPs
listCompLhs :: ExprLStmt GhcPs -- ^ @f x@ of @[f x| x <- xs]@.
  , ListComprehension -> [ExprLStmt GhcPs]
listCompRhs :: [ExprLStmt GhcPs] -- ^ @x <- xs@ of @[f x| x <- xs]@.
  }

-- | Use this type to pretty-print a do expression.
data DoExpression = DoExpression
  { DoExpression -> [ExprLStmt GhcPs]
doStmts :: [ExprLStmt GhcPs]
  , DoExpression -> DoOrMdo
doOrMdo :: DoOrMdo
  }

-- | Use this type to pretty-print a @let ... in ...@ expression.
data LetIn = LetIn
  { LetIn -> HsLocalBinds GhcPs
letBinds :: HsLocalBinds GhcPs
  , LetIn -> LHsExpr GhcPs
inExpr :: LHsExpr GhcPs
  }

-- | Comments belonging to an AST node.
data NodeComments = NodeComments
  { NodeComments -> [LEpaComment]
commentsBefore :: [LEpaComment]
  , NodeComments -> [LEpaComment]
commentsOnSameLine :: [LEpaComment]
  , NodeComments -> [LEpaComment]
commentsAfter :: [LEpaComment]
  }

-- | Values indicating whether `do` or `mdo` is used.
data DoOrMdo
  = Do
  | Mdo

-- | Values indicating in which context a RHS is located.
data GRHSExprType
  = GRHSExprNormal
  | GRHSExprCase
  | GRHSExprMultiWayIf
  | GRHSExprLambda
  deriving (GRHSExprType -> GRHSExprType -> Bool
(GRHSExprType -> GRHSExprType -> Bool)
-> (GRHSExprType -> GRHSExprType -> Bool) -> Eq GRHSExprType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GRHSExprType -> GRHSExprType -> Bool
== :: GRHSExprType -> GRHSExprType -> Bool
$c/= :: GRHSExprType -> GRHSExprType -> Bool
/= :: GRHSExprType -> GRHSExprType -> Bool
Eq)

-- | Values indicating in which context a RHS in a proc expression is located.
data GRHSProcType
  = GRHSProcCase
  | GRHSProcLambda

-- | Values indicating in which context a `HsType` is located.
data HsTypeFor
  = HsTypeForNormalDecl
  | HsTypeForInstDecl
  | HsTypeForFuncSig
  | HsTypeForDeclSig
  | HsTypeForVerticalAppTy

-- | Values indicating how a node should be printed; either horizontally or
-- vertically.
data HsTypeDir
  = HsTypeNoDir
  | HsTypeVertical

-- | Values indicating whether `case` or `cases` is used.
data CaseOrCases
  = Case
  | Cases

-- | Values indicating where a data family instance is declared.
data DataFamInstDeclFor
  = DataFamInstDeclForTopLevel
  | DataFamInstDeclForInsideClassInst