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

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

p_spliceDecl :: SpliceDecl GhcPs -> R ()
p_spliceDecl :: SpliceDecl GhcPs -> R ()
p_spliceDecl (SpliceDecl NoExtField
XSpliceDecl GhcPs
NoExtField XRec GhcPs (HsUntypedSplice GhcPs)
splice SpliceDecoration
deco) =
  GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
-> (HsUntypedSplice GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsUntypedSplice GhcPs)
XRec GhcPs (HsUntypedSplice GhcPs)
splice ((HsUntypedSplice GhcPs -> R ()) -> R ())
-> (HsUntypedSplice GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
deco