@@ -0,0 +1,72 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE NamedFieldPuns #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+
5+module Ormolu.Printer.Meat.Declaration.Foreign
6+ ( p_foreignDecl
7+ )
8+where
9+
10+import BasicTypes
11+import Control.Monad
12+import Data.Text
13+import ForeignCall
14+import GHC
15+import Ormolu.Printer.Combinators
16+import Ormolu.Printer.Meat.Common
17+import Ormolu.Printer.Meat.Declaration.Signature
18+import Ormolu.Utils
19+
20+p_foreignDecl :: ForeignDecl GhcPs -> R ()
21+p_foreignDecl = \case
22+ fd@ForeignImport {fd_fi} -> line $ do
23+ p_foreignImport fd_fi
24+ p_foreignTypeSig fd
25+ fd@ForeignExport {fd_fe} -> line $ do
26+ p_foreignExport fd_fe
27+ p_foreignTypeSig fd
28+ XForeignDecl {} -> notImplemented "XForeignDecl"
29+
30+-- | Printer for the last part of an import\/export, which is function name
31+-- and type signature.
32+
33+p_foreignTypeSig :: ForeignDecl GhcPs -> R ()
34+p_foreignTypeSig fd = do
35+ breakpoint
36+ -- Switch into the layout of the signature, to allow us to pull name and
37+ -- signature onto a single line.
38+ inci . switchLayout (getLoc . hsib_body $ fd_sig_ty fd) $ do
39+ p_rdrName (fd_name fd)
40+ p_typeAscription (HsWC NoExt (fd_sig_ty fd))
41+
42+-- | Printer for 'ForeignImport'.
43+--
44+-- These have the form:
45+--
46+-- > foreign import callingConvention [safety] [identifier]
47+--
48+-- We need to check whether the safety has a good source, span, as it
49+-- defaults to 'PlaySafe' if you don't have anything in the source.
50+--
51+-- We also layout the identifier using the 'SourceText', because printing
52+-- with the other two fields of 'CImport' is very complicated. See the
53+-- 'Outputable' instance of 'ForeignImport' for details.
54+
55+p_foreignImport :: ForeignImport -> R ()
56+p_foreignImport (CImport cCallConv safety _ _ sourceText) = do
57+ txt "foreign import "
58+ located cCallConv atom
59+ -- Need to check for 'noLoc' for the 'safe' annotation
60+ when (isGoodSrcSpan $ getLoc safety) (space >> atom safety)
61+ located sourceText p_sourceText
62+
63+p_foreignExport :: ForeignExport -> R ()
64+p_foreignExport (CExport (L loc (CExportStatic _ _ cCallConv)) sourceText) = do
65+ txt "foreign export "
66+ located (L loc cCallConv) atom
67+ located sourceText p_sourceText
68+
69+p_sourceText :: SourceText -> R ()
70+p_sourceText = \case
71+ NoSourceText -> pure ()
72+ SourceText s -> space >> txt (pack s)