{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration
  ( Declaration(..)
  , mkDeclaration
  , isSignature
  ) where

import Control.Applicative
import Data.Maybe
import HIndent.Ast.Declaration.Annotation
import HIndent.Ast.Declaration.Annotation.Role
import HIndent.Ast.Declaration.Bind
import HIndent.Ast.Declaration.Class
import HIndent.Ast.Declaration.Data
import HIndent.Ast.Declaration.Default
import HIndent.Ast.Declaration.Family.Data
import HIndent.Ast.Declaration.Family.Type
import HIndent.Ast.Declaration.Foreign
import HIndent.Ast.Declaration.Instance.Class
import HIndent.Ast.Declaration.Instance.Family.Data
import HIndent.Ast.Declaration.Instance.Family.Type
import HIndent.Ast.Declaration.Rule.Collection
import HIndent.Ast.Declaration.Signature
import HIndent.Ast.Declaration.Signature.StandaloneKind
import HIndent.Ast.Declaration.Splice
import HIndent.Ast.Declaration.StandAloneDeriving
import HIndent.Ast.Declaration.TypeSynonym
import HIndent.Ast.Declaration.Warning.Collection
import HIndent.Ast.NodeComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.NodeComments

data Declaration
  = DataFamily DataFamily
  | TypeFamily TypeFamily
  | DataDeclaration DataDeclaration
  | ClassDeclaration ClassDeclaration
  | TypeSynonym TypeSynonym
  | ClassInstance ClassInstance
  | DataFamilyInstance DataFamilyInstance
  | TypeFamilyInstance TypeFamilyInstance
  | StandAloneDeriving StandAloneDeriving
  | Bind Bind
  | Signature Signature
  | StandaloneKindSignature StandaloneKind
  | Default DefaultDeclaration
  | Foreign ForeignDeclaration
  | Warnings WarningCollection
  | Annotation Annotation
  | RuleDecl RuleCollection
  | Splice SpliceDeclaration
  | RoleAnnotDecl RoleAnnotation

instance CommentExtraction Declaration where
  nodeComments :: Declaration -> NodeComments
nodeComments DataFamily {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments TypeFamily {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments DataDeclaration {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments ClassDeclaration {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments TypeSynonym {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments ClassInstance {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments DataFamilyInstance {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments TypeFamilyInstance {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments StandAloneDeriving {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Bind {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Signature {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments StandaloneKindSignature {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Default {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Foreign {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Warnings {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Annotation {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments RuleDecl {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Splice {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments RoleAnnotDecl {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty Declaration where
  pretty' :: Declaration -> Printer ()
pretty' (DataFamily DataFamily
x) = DataFamily -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DataFamily
x
  pretty' (TypeFamily TypeFamily
x) = TypeFamily -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty TypeFamily
x
  pretty' (DataDeclaration DataDeclaration
x) = DataDeclaration -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DataDeclaration
x
  pretty' (ClassDeclaration ClassDeclaration
x) = ClassDeclaration -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ClassDeclaration
x
  pretty' (TypeSynonym TypeSynonym
x) = TypeSynonym -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty TypeSynonym
x
  pretty' (ClassInstance ClassInstance
x) = ClassInstance -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ClassInstance
x
  pretty' (DataFamilyInstance DataFamilyInstance
x) = DataFamilyInstance -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DataFamilyInstance
x
  pretty' (TypeFamilyInstance TypeFamilyInstance
x) = TypeFamilyInstance -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty TypeFamilyInstance
x
  pretty' (StandAloneDeriving StandAloneDeriving
x) = StandAloneDeriving -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty StandAloneDeriving
x
  pretty' (Bind Bind
x) = Bind -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Bind
x
  pretty' (Signature Signature
x) = Signature -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Signature
x
  pretty' (StandaloneKindSignature StandaloneKind
x) = StandaloneKind -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty StandaloneKind
x
  pretty' (Default DefaultDeclaration
x) = DefaultDeclaration -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DefaultDeclaration
x
  pretty' (Foreign ForeignDeclaration
x) = ForeignDeclaration -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty ForeignDeclaration
x
  pretty' (Warnings WarningCollection
x) = WarningCollection -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WarningCollection
x
  pretty' (Annotation Annotation
x) = Annotation -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Annotation
x
  pretty' (RuleDecl RuleCollection
x) = RuleCollection -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty RuleCollection
x
  pretty' (Splice SpliceDeclaration
x) = SpliceDeclaration -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty SpliceDeclaration
x
  pretty' (RoleAnnotDecl RoleAnnotation
x) = RoleAnnotation -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty RoleAnnotation
x

mkDeclaration :: GHC.HsDecl GHC.GhcPs -> Declaration
mkDeclaration :: HsDecl GhcPs -> Declaration
mkDeclaration (GHC.TyClD XTyClD GhcPs
_ (GHC.FamDecl XFamDecl GhcPs
_ FamilyDecl GhcPs
x)) =
  Declaration -> Maybe Declaration -> Declaration
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Declaration
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable.")
    (Maybe Declaration -> Declaration)
-> Maybe Declaration -> Declaration
forall a b. (a -> b) -> a -> b
$ DataFamily -> Declaration
DataFamily (DataFamily -> Declaration)
-> Maybe DataFamily -> Maybe Declaration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FamilyDecl GhcPs -> Maybe DataFamily
mkDataFamily FamilyDecl GhcPs
x Maybe Declaration -> Maybe Declaration -> Maybe Declaration
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeFamily -> Declaration
TypeFamily (TypeFamily -> Declaration)
-> Maybe TypeFamily -> Maybe Declaration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FamilyDecl GhcPs -> Maybe TypeFamily
mkTypeFamily FamilyDecl GhcPs
x
mkDeclaration (GHC.TyClD XTyClD GhcPs
_ x :: TyClDecl GhcPs
x@GHC.SynDecl {}) = TypeSynonym -> Declaration
TypeSynonym (TypeSynonym -> Declaration) -> TypeSynonym -> Declaration
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcPs -> TypeSynonym
mkTypeSynonym TyClDecl GhcPs
x
mkDeclaration (GHC.TyClD XTyClD GhcPs
_ x :: TyClDecl GhcPs
x@GHC.DataDecl {}) =
  Declaration
-> (DataDeclaration -> Declaration)
-> Maybe DataDeclaration
-> Declaration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Declaration
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable.") DataDeclaration -> Declaration
DataDeclaration (TyClDecl GhcPs -> Maybe DataDeclaration
mkDataDeclaration TyClDecl GhcPs
x)
mkDeclaration (GHC.TyClD XTyClD GhcPs
_ x :: TyClDecl GhcPs
x@GHC.ClassDecl {}) =
  Declaration
-> (ClassDeclaration -> Declaration)
-> Maybe ClassDeclaration
-> Declaration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Declaration
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable.") ClassDeclaration -> Declaration
ClassDeclaration (TyClDecl GhcPs -> Maybe ClassDeclaration
mkClassDeclaration TyClDecl GhcPs
x)
mkDeclaration (GHC.InstD XInstD GhcPs
_ x :: InstDecl GhcPs
x@GHC.ClsInstD {}) =
  Declaration
-> (ClassInstance -> Declaration)
-> Maybe ClassInstance
-> Declaration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Declaration
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable.") ClassInstance -> Declaration
ClassInstance (InstDecl GhcPs -> Maybe ClassInstance
mkClassInstance InstDecl GhcPs
x)
mkDeclaration (GHC.InstD XInstD GhcPs
_ GHC.DataFamInstD {dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
GHC.dfid_inst = GHC.DataFamInstDecl {FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn :: FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
..}}) =
  DataFamilyInstance -> Declaration
DataFamilyInstance (DataFamilyInstance -> Declaration)
-> DataFamilyInstance -> Declaration
forall a b. (a -> b) -> a -> b
$ FamEqn GhcPs (HsDataDefn GhcPs) -> DataFamilyInstance
mkDataFamilyInstance FamEqn GhcPs (HsDataDefn GhcPs)
dfid_eqn
mkDeclaration (GHC.InstD XInstD GhcPs
_ x :: InstDecl GhcPs
x@GHC.TyFamInstD {}) =
  Declaration
-> (TypeFamilyInstance -> Declaration)
-> Maybe TypeFamilyInstance
-> Declaration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Declaration
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable.") TypeFamilyInstance -> Declaration
TypeFamilyInstance (Maybe TypeFamilyInstance -> Declaration)
-> Maybe TypeFamilyInstance -> Declaration
forall a b. (a -> b) -> a -> b
$ InstDecl GhcPs -> Maybe TypeFamilyInstance
mkTypeFamilyInstance InstDecl GhcPs
x
mkDeclaration (GHC.DerivD XDerivD GhcPs
_ DerivDecl GhcPs
x) = StandAloneDeriving -> Declaration
StandAloneDeriving (StandAloneDeriving -> Declaration)
-> StandAloneDeriving -> Declaration
forall a b. (a -> b) -> a -> b
$ DerivDecl GhcPs -> StandAloneDeriving
mkStandAloneDeriving DerivDecl GhcPs
x
mkDeclaration (GHC.ValD XValD GhcPs
_ HsBind GhcPs
x) = Bind -> Declaration
Bind (Bind -> Declaration) -> Bind -> Declaration
forall a b. (a -> b) -> a -> b
$ HsBind GhcPs -> Bind
mkBind HsBind GhcPs
x
mkDeclaration (GHC.SigD XSigD GhcPs
_ Sig GhcPs
x) = Signature -> Declaration
Signature (Signature -> Declaration) -> Signature -> Declaration
forall a b. (a -> b) -> a -> b
$ Sig GhcPs -> Signature
mkSignature Sig GhcPs
x
mkDeclaration (GHC.KindSigD XKindSigD GhcPs
_ StandaloneKindSig GhcPs
x) = StandaloneKind -> Declaration
StandaloneKindSignature (StandaloneKind -> Declaration) -> StandaloneKind -> Declaration
forall a b. (a -> b) -> a -> b
$ StandaloneKindSig GhcPs -> StandaloneKind
mkStandaloneKind StandaloneKindSig GhcPs
x
mkDeclaration (GHC.DefD XDefD GhcPs
_ DefaultDecl GhcPs
x) = DefaultDeclaration -> Declaration
Default (DefaultDeclaration -> Declaration)
-> DefaultDeclaration -> Declaration
forall a b. (a -> b) -> a -> b
$ DefaultDecl GhcPs -> DefaultDeclaration
mkDefaultDeclaration DefaultDecl GhcPs
x
mkDeclaration (GHC.ForD XForD GhcPs
_ ForeignDecl GhcPs
x) = ForeignDeclaration -> Declaration
Foreign (ForeignDeclaration -> Declaration)
-> ForeignDeclaration -> Declaration
forall a b. (a -> b) -> a -> b
$ ForeignDecl GhcPs -> ForeignDeclaration
mkForeignDeclaration ForeignDecl GhcPs
x
mkDeclaration (GHC.WarningD XWarningD GhcPs
_ WarnDecls GhcPs
x) = WarningCollection -> Declaration
Warnings (WarningCollection -> Declaration)
-> WarningCollection -> Declaration
forall a b. (a -> b) -> a -> b
$ WarnDecls GhcPs -> WarningCollection
mkWarningCollection WarnDecls GhcPs
x
mkDeclaration (GHC.AnnD XAnnD GhcPs
_ AnnDecl GhcPs
x) = Annotation -> Declaration
Annotation (Annotation -> Declaration) -> Annotation -> Declaration
forall a b. (a -> b) -> a -> b
$ AnnDecl GhcPs -> Annotation
mkAnnotation AnnDecl GhcPs
x
mkDeclaration (GHC.RuleD XRuleD GhcPs
_ RuleDecls GhcPs
x) = RuleCollection -> Declaration
RuleDecl (RuleCollection -> Declaration) -> RuleCollection -> Declaration
forall a b. (a -> b) -> a -> b
$ RuleDecls GhcPs -> RuleCollection
mkRuleCollection RuleDecls GhcPs
x
mkDeclaration (GHC.SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
x) = SpliceDeclaration -> Declaration
Splice (SpliceDeclaration -> Declaration)
-> SpliceDeclaration -> Declaration
forall a b. (a -> b) -> a -> b
$ SpliceDecl GhcPs -> SpliceDeclaration
mkSpliceDeclaration SpliceDecl GhcPs
x
mkDeclaration (GHC.RoleAnnotD XRoleAnnotD GhcPs
_ RoleAnnotDecl GhcPs
x) = RoleAnnotation -> Declaration
RoleAnnotDecl (RoleAnnotation -> Declaration) -> RoleAnnotation -> Declaration
forall a b. (a -> b) -> a -> b
$ RoleAnnotDecl GhcPs -> RoleAnnotation
mkRoleAnnotation RoleAnnotDecl GhcPs
x
mkDeclaration GHC.DocD {} =
  [Char] -> Declaration
forall a. HasCallStack => [Char] -> a
error
    [Char]
"This node should never appear in the AST. If you see this error, please report it to the HIndent maintainers."

isSignature :: Declaration -> Bool
isSignature :: Declaration -> Bool
isSignature Signature {} = Bool
True
isSignature StandaloneKindSignature {} = Bool
True
isSignature Declaration
_ = Bool
False