{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Data.Record.Field
  ( RecordField
  , mkRecordField
  ) where

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 RecordField = RecordField
  { RecordField -> [LFieldOcc GhcPs]
names :: [GHC.LFieldOcc GHC.GhcPs]
  , RecordField -> LBangType GhcPs
ty :: GHC.LBangType GHC.GhcPs
  }

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

instance Pretty RecordField where
  pretty' :: RecordField -> Printer ()
pretty' RecordField {[LFieldOcc GhcPs]
LBangType GhcPs
names :: RecordField -> [LFieldOcc GhcPs]
ty :: RecordField -> LBangType GhcPs
names :: [LFieldOcc GhcPs]
ty :: LBangType GhcPs
..} =
    [Printer ()] -> Printer ()
spaced [[Printer ()] -> Printer ()
hCommaSep ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (FieldOcc GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LFieldOcc GhcPs]
[GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
names, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LBangType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty]

mkRecordField :: GHC.ConDeclField GHC.GhcPs -> RecordField
mkRecordField :: ConDeclField GhcPs -> RecordField
mkRecordField GHC.ConDeclField {[LFieldOcc GhcPs]
Maybe (LHsDoc GhcPs)
XConDeclField GhcPs
LBangType GhcPs
cd_fld_ext :: XConDeclField GhcPs
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_type :: LBangType GhcPs
cd_fld_doc :: Maybe (LHsDoc GhcPs)
cd_fld_doc :: forall pass. ConDeclField pass -> Maybe (LHsDoc pass)
cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_ext :: forall pass. ConDeclField pass -> XConDeclField pass
..} = RecordField {[LFieldOcc GhcPs]
[GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
LBangType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
names :: [LFieldOcc GhcPs]
ty :: LBangType GhcPs
names :: [GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
ty :: GenLocated SrcSpanAnnA (HsType GhcPs)
..}
  where
    names :: [LFieldOcc GhcPs]
names = [LFieldOcc GhcPs]
cd_fld_names
    ty :: LBangType GhcPs
ty = LBangType GhcPs
cd_fld_type