{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Annotation
  ( Annotation
  , mkAnnotation
  ) where

import HIndent.Ast.Declaration.Annotation.Provenance
import HIndent.Ast.NodeComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data Annotation = Annotation
  { Annotation -> Provenance
provenance :: Provenance
  , Annotation -> LHsExpr GhcPs
expr :: GHC.LHsExpr GHC.GhcPs
  }

instance CommentExtraction Annotation where
  nodeComments :: Annotation -> NodeComments
nodeComments Annotation {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty Annotation where
  pretty' :: Annotation -> Printer ()
pretty' Annotation {LHsExpr GhcPs
Provenance
provenance :: Annotation -> Provenance
expr :: Annotation -> LHsExpr GhcPs
provenance :: Provenance
expr :: LHsExpr GhcPs
..} =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# ANN", Provenance -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Provenance
provenance, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"#-}"]

mkAnnotation :: GHC.AnnDecl GHC.GhcPs -> Annotation
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
mkAnnotation :: AnnDecl GhcPs -> Annotation
mkAnnotation (GHC.HsAnnotation XHsAnnotation GhcPs
_ AnnProvenance GhcPs
prov LHsExpr GhcPs
expr) =
  Annotation {provenance :: Provenance
provenance = AnnProvenance GhcPs -> Provenance
mkProvenance AnnProvenance GhcPs
prov, LHsExpr GhcPs
expr :: LHsExpr GhcPs
expr :: LHsExpr GhcPs
..}
#else
mkAnnotation (GHC.HsAnnotation _ _ prov expr) =
  Annotation {provenance = mkProvenance prov, ..}
#endif