{-# LANGUAGE RecordWildCards, CPP #-}

module HIndent.Ast.Declaration.Instance.Family.Type
  ( TypeFamilyInstance
  , mkTypeFamilyInstance
  ) where

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 TypeFamilyInstance = TypeFamilyInstance
  { TypeFamilyInstance -> WithComments PrefixName
name :: WithComments PrefixName
  , TypeFamilyInstance -> HsFamEqnPats GhcPs
types :: GHC.HsFamEqnPats GHC.GhcPs
  , TypeFamilyInstance -> LHsType GhcPs
bind :: GHC.LHsType GHC.GhcPs
  }
#else
data TypeFamilyInstance = TypeFamilyInstance
  { name :: WithComments PrefixName
  , types :: GHC.HsTyPats GHC.GhcPs
  , bind :: GHC.LHsType GHC.GhcPs
  }
#endif
instance CommentExtraction TypeFamilyInstance where
  nodeComments :: TypeFamilyInstance -> NodeComments
nodeComments TypeFamilyInstance {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

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

mkTypeFamilyInstance :: GHC.InstDecl GHC.GhcPs -> Maybe TypeFamilyInstance
mkTypeFamilyInstance :: InstDecl GhcPs -> Maybe TypeFamilyInstance
mkTypeFamilyInstance GHC.TyFamInstD {tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
GHC.tfid_inst = GHC.TyFamInstDecl {tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
GHC.tfid_eqn = GHC.FamEqn {HsFamEqnPats GhcPs
XCFamEqn GhcPs (LHsType GhcPs)
LIdP GhcPs
LHsType GhcPs
LexicalFixity
HsOuterFamEqnTyVarBndrs GhcPs
feqn_ext :: XCFamEqn GhcPs (LHsType GhcPs)
feqn_tycon :: LIdP GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_pats :: HsFamEqnPats GhcPs
feqn_fixity :: LexicalFixity
feqn_rhs :: LHsType 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
..}}} =
  TypeFamilyInstance -> Maybe TypeFamilyInstance
forall a. a -> Maybe a
Just (TypeFamilyInstance -> Maybe TypeFamilyInstance)
-> TypeFamilyInstance -> Maybe TypeFamilyInstance
forall a b. (a -> b) -> a -> b
$ TypeFamilyInstance {HsFamEqnPats GhcPs
[HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
WithComments PrefixName
name :: WithComments PrefixName
types :: HsFamEqnPats GhcPs
bind :: LHsType GhcPs
name :: WithComments PrefixName
types :: [HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
bind :: GenLocated SrcSpanAnnA (HsType GhcPs)
..}
  where
    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
    bind :: LHsType GhcPs
bind = LHsType GhcPs
feqn_rhs
mkTypeFamilyInstance InstDecl GhcPs
_ = Maybe TypeFamilyInstance
forall a. Maybe a
Nothing