{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Ormolu.Printer.Meat.Declaration.Foreign
  ( p_foreignDecl,
  )
where

import Control.Monad
import GHC.Hs
import GHC.Types.ForeignCall
import GHC.Types.SrcLoc
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 GhcPs
fd_fi :: ForeignImport GhcPs
fd_fi :: forall pass. ForeignDecl pass -> ForeignImport pass
fd_fi} -> do
    ForeignImport GhcPs -> R ()
p_foreignImport ForeignImport GhcPs
fd_fi
    ForeignDecl GhcPs -> R ()
p_foreignTypeSig ForeignDecl GhcPs
fd
  fd :: ForeignDecl GhcPs
fd@ForeignExport {ForeignExport GhcPs
fd_fe :: ForeignExport GhcPs
fd_fe :: forall pass. ForeignDecl pass -> ForeignExport pass
fd_fe} -> do
    ForeignExport GhcPs -> R ()
p_foreignExport ForeignExport GhcPs
fd_fe
    ForeignDecl GhcPs -> R ()
p_foreignTypeSig ForeignDecl GhcPs
fd

-- | Printer for the last part of an import\/export, which is function name
-- and type signature.
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
      [ GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (ForeignDecl GhcPs -> LIdP GhcPs
forall pass. ForeignDecl pass -> LIdP pass
fd_name ForeignDecl GhcPs
fd),
        (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> SrcSpan)
-> (ForeignDecl GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> ForeignDecl GhcPs
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignDecl GhcPs -> LHsSigType GhcPs
ForeignDecl GhcPs -> GenLocated SrcSpanAnnA (HsSigType 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
      GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName (ForeignDecl GhcPs -> LIdP GhcPs
forall pass. ForeignDecl pass -> LIdP pass
fd_name ForeignDecl GhcPs
fd)
      LHsSigType GhcPs -> R ()
p_typeAscription (ForeignDecl GhcPs -> LHsSigType GhcPs
forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty ForeignDecl GhcPs
fd)

-- | Printer for 'ForeignImport'.
--
-- These have the form:
--
-- > foreign import callingConvention [safety] [identifier]
--
-- We need to check whether the safety has a good source, span, as it
-- defaults to 'PlaySafe' if you don't have anything in the source.
--
-- We also layout the identifier using the 'SourceText', because printing
-- with the other two fields of 'CImport' is very complicated. See the
-- 'Outputable' instance of 'ForeignImport' for details.
p_foreignImport :: ForeignImport GhcPs -> R ()
p_foreignImport :: ForeignImport GhcPs -> R ()
p_foreignImport (CImport XCImport GhcPs
sourceText XRec GhcPs CCallConv
cCallConv XRec GhcPs Safety
safety Maybe Header
_ CImportSpec
_) = do
  Text -> R ()
txt Text
"foreign import"
  R ()
space
  GenLocated EpaLocation CCallConv -> (CCallConv -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs CCallConv
GenLocated EpaLocation CCallConv
cCallConv CCallConv -> R ()
forall a. Outputable a => a -> R ()
atom
  -- Need to check for 'noLoc' for the 'safe' annotation
  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
$ GenLocated EpaLocation Safety -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA XRec GhcPs Safety
GenLocated EpaLocation Safety
safety) (R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated EpaLocation Safety -> R ()
forall a. Outputable a => a -> R ()
atom XRec GhcPs Safety
GenLocated EpaLocation Safety
safety)
  R ()
space
  GenLocated EpaLocation SourceText -> (SourceText -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XCImport GhcPs
GenLocated EpaLocation SourceText
sourceText SourceText -> R ()
p_sourceText

p_foreignExport :: ForeignExport GhcPs -> R ()
p_foreignExport :: ForeignExport GhcPs -> R ()
p_foreignExport (CExport XCExport GhcPs
sourceText (L EpaLocation
loc (CExportStatic SourceText
_ CLabelString
_ CCallConv
cCallConv))) = do
  Text -> R ()
txt Text
"foreign export"
  R ()
space
  GenLocated EpaLocation CCallConv -> (CCallConv -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located (EpaLocation -> CCallConv -> GenLocated EpaLocation CCallConv
forall l e. l -> e -> GenLocated l e
L EpaLocation
loc CCallConv
cCallConv) CCallConv -> R ()
forall a. Outputable a => a -> R ()
atom
  R ()
space
  GenLocated EpaLocation SourceText -> (SourceText -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XCExport GhcPs
GenLocated EpaLocation SourceText
sourceText SourceText -> R ()
p_sourceText