{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Ormolu.Printer.Meat.Declaration.Foreign
( p_foreignDecl,
)
where
import BasicTypes
import Control.Monad
import Data.Text
import ForeignCall
import GHC
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import Ormolu.Printer.Meat.Declaration.Signature
p_foreignDecl :: ForeignDecl GhcPs -> R ()
p_foreignDecl :: ForeignDecl GhcPs -> R ()
p_foreignDecl = \case
fd :: ForeignDecl GhcPs
fd@ForeignImport {ForeignImport
fd_fi :: forall pass. ForeignDecl pass -> ForeignImport
fd_fi :: ForeignImport
fd_fi} -> do
ForeignImport -> R ()
p_foreignImport ForeignImport
fd_fi
ForeignDecl GhcPs -> R ()
p_foreignTypeSig ForeignDecl GhcPs
fd
fd :: ForeignDecl GhcPs
fd@ForeignExport {ForeignExport
fd_fe :: forall pass. ForeignDecl pass -> ForeignExport
fd_fe :: ForeignExport
fd_fe} -> do
ForeignExport -> R ()
p_foreignExport ForeignExport
fd_fe
ForeignDecl GhcPs -> R ()
p_foreignTypeSig ForeignDecl GhcPs
fd
XForeignDecl XXForeignDecl GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXForeignDecl GhcPs
x
p_foreignTypeSig :: ForeignDecl GhcPs -> R ()
p_foreignTypeSig :: ForeignDecl GhcPs -> R ()
p_foreignTypeSig ForeignDecl GhcPs
fd = do
R ()
breakpoint
R () -> R ()
inci
(R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout
[ Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (ForeignDecl GhcPs -> Located (IdP GhcPs)
forall pass. ForeignDecl pass -> Located (IdP pass)
fd_name ForeignDecl GhcPs
fd),
(LHsType GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LHsType GhcPs -> SrcSpan)
-> (ForeignDecl GhcPs -> LHsType GhcPs)
-> ForeignDecl GhcPs
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsImplicitBndrs GhcPs (LHsType GhcPs) -> LHsType GhcPs
forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body (HsImplicitBndrs GhcPs (LHsType GhcPs) -> LHsType GhcPs)
-> (ForeignDecl GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs))
-> ForeignDecl GhcPs
-> LHsType GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignDecl GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs)
forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty) ForeignDecl GhcPs
fd
]
(R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName (ForeignDecl GhcPs -> Located (IdP GhcPs)
forall pass. ForeignDecl pass -> Located (IdP pass)
fd_name ForeignDecl GhcPs
fd)
LHsSigWcType GhcPs -> R ()
p_typeAscription (XHsWC GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
-> HsImplicitBndrs GhcPs (LHsType GhcPs) -> LHsSigWcType GhcPs
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC NoExtField
XHsWC GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
NoExtField (ForeignDecl GhcPs -> HsImplicitBndrs GhcPs (LHsType GhcPs)
forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty ForeignDecl GhcPs
fd))
p_foreignImport :: ForeignImport -> R ()
p_foreignImport :: ForeignImport -> R ()
p_foreignImport (CImport Located CCallConv
cCallConv Located Safety
safety Maybe Header
_ CImportSpec
_ Located SourceText
sourceText) = do
Text -> R ()
txt Text
"foreign import"
R ()
space
Located CCallConv -> (CCallConv -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located CCallConv
cCallConv CCallConv -> R ()
forall a. Outputable a => a -> R ()
atom
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SrcSpan -> Bool
isGoodSrcSpan (SrcSpan -> Bool) -> SrcSpan -> Bool
forall a b. (a -> b) -> a -> b
$ Located Safety -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Safety
safety) (R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Located Safety -> R ()
forall a. Outputable a => a -> R ()
atom Located Safety
safety)
Located SourceText -> (SourceText -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located SourceText
sourceText SourceText -> R ()
p_sourceText
p_foreignExport :: ForeignExport -> R ()
p_foreignExport :: ForeignExport -> R ()
p_foreignExport (CExport (L SrcSpan
loc (CExportStatic SourceText
_ CLabelString
_ CCallConv
cCallConv)) Located SourceText
sourceText) = do
Text -> R ()
txt Text
"foreign export"
R ()
space
Located CCallConv -> (CCallConv -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located (SrcSpan -> CCallConv -> Located CCallConv
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc CCallConv
cCallConv) CCallConv -> R ()
forall a. Outputable a => a -> R ()
atom
Located SourceText -> (SourceText -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located SourceText
sourceText SourceText -> R ()
p_sourceText
p_sourceText :: SourceText -> R ()
p_sourceText :: SourceText -> R ()
p_sourceText = \case
SourceText
NoSourceText -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
SourceText String
s -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt (String -> Text
pack String
s)