module HIndent.Ast.Declaration.Default
  ( DefaultDeclaration
  , mkDefaultDeclaration
  ) where

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

newtype DefaultDeclaration =
  DefaultDeclaration [GHC.LHsType GHC.GhcPs]

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

instance Pretty DefaultDeclaration where
  pretty' :: DefaultDeclaration -> Printer ()
pretty' (DefaultDeclaration [LHsType GhcPs]
xs) =
    [Printer ()] -> Printer ()
spaced [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"default", [Printer ()] -> Printer ()
hTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs]

mkDefaultDeclaration :: GHC.DefaultDecl GHC.GhcPs -> DefaultDeclaration
mkDefaultDeclaration :: DefaultDecl GhcPs -> DefaultDeclaration
mkDefaultDeclaration (GHC.DefaultDecl XCDefaultDecl GhcPs
_ [LHsType GhcPs]
xs) = [LHsType GhcPs] -> DefaultDeclaration
DefaultDeclaration [LHsType GhcPs]
xs