{-# LANGUAGE LambdaCase #-}

module Ormolu.Printer.Meat.Declaration.Splice
  ( p_spliceDecl,
  )
where

import GHC.Hs
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Declaration.Value (p_hsSplice)

p_spliceDecl :: SpliceDecl GhcPs -> R ()
p_spliceDecl :: SpliceDecl GhcPs -> R ()
p_spliceDecl = \case
  SpliceDecl NoExtField
XSpliceDecl GhcPs
NoExtField XRec GhcPs (HsSplice GhcPs)
splice SpliceExplicitFlag
_explicit -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsSplice GhcPs)
splice HsSplice GhcPs -> R ()
p_hsSplice