{-# LANGUAGE RecordWildCards, CPP #-}

module HIndent.Ast.Declaration.Instance.Family.Data
  ( DataFamilyInstance
  , mkDataFamilyInstance
  ) where

import qualified GHC.Hs as GG
import HIndent.Ast.Declaration.Data.Body
import HIndent.Ast.Declaration.Data.NewOrData
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
data DataFamilyInstance = DataFamilyInstance
  { DataFamilyInstance -> NewOrData
newOrData :: NewOrData
  , DataFamilyInstance -> WithComments PrefixName
name :: WithComments PrefixName
  , DataFamilyInstance -> HsFamEqnPats GhcPs
types :: GHC.HsFamEqnPats GHC.GhcPs
  , DataFamilyInstance -> DataBody
body :: DataBody
  }
#else
data DataFamilyInstance = DataFamilyInstance
  { newOrData :: NewOrData
  , name :: WithComments PrefixName
  , types :: GHC.HsTyPats GHC.GhcPs
  , body :: DataBody
  }
#endif
instance CommentExtraction DataFamilyInstance where
  nodeComments :: DataFamilyInstance -> NodeComments
nodeComments DataFamilyInstance {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty DataFamilyInstance where
  pretty' :: DataFamilyInstance -> Printer ()
pretty' DataFamilyInstance {HsFamEqnPats GhcPs
WithComments PrefixName
NewOrData
DataBody
newOrData :: DataFamilyInstance -> NewOrData
name :: DataFamilyInstance -> WithComments PrefixName
types :: DataFamilyInstance -> HsFamEqnPats GhcPs
body :: DataFamilyInstance -> DataBody
newOrData :: NewOrData
name :: WithComments PrefixName
types :: HsFamEqnPats GhcPs
body :: DataBody
..} = do
    [Printer ()] -> Printer ()
spaced
      ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ NewOrData -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty NewOrData
newOrData Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: HasCallStack => String -> Printer ()
String -> Printer ()
string String
"instance" Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
name Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsArg
      GhcPs
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (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 HsArg
  GhcPs
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsFamEqnPats GhcPs
[HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
types
    DataBody -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty DataBody
body

mkDataFamilyInstance ::
     GHC.FamEqn GHC.GhcPs (GHC.HsDataDefn GHC.GhcPs) -> DataFamilyInstance
mkDataFamilyInstance :: FamEqn GhcPs (HsDataDefn GhcPs) -> DataFamilyInstance
mkDataFamilyInstance GHC.FamEqn {HsFamEqnPats GhcPs
XCFamEqn GhcPs (HsDataDefn GhcPs)
LIdP GhcPs
LexicalFixity
HsOuterFamEqnTyVarBndrs GhcPs
HsDataDefn GhcPs
feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
feqn_tycon :: LIdP GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_pats :: HsFamEqnPats GhcPs
feqn_fixity :: LexicalFixity
feqn_rhs :: HsDataDefn GhcPs
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
..} = DataFamilyInstance {HsFamEqnPats GhcPs
[HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
WithComments PrefixName
NewOrData
DataBody
newOrData :: NewOrData
name :: WithComments PrefixName
types :: HsFamEqnPats GhcPs
body :: DataBody
newOrData :: NewOrData
name :: WithComments PrefixName
types :: [HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
body :: DataBody
..}
  where
    newOrData :: NewOrData
newOrData = HsDataDefn GhcPs -> NewOrData
mkNewOrData HsDataDefn GhcPs
feqn_rhs
    name :: WithComments PrefixName
name = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
feqn_tycon
    types :: HsFamEqnPats GhcPs
types = HsFamEqnPats GhcPs
feqn_pats
    body :: DataBody
body = HsDataDefn GhcPs -> DataBody
mkDataBody HsDataDefn GhcPs
feqn_rhs