c460bfa · ormolu · git.iko.soy

git.iko.soy/ormolu

on master help sign in

[#53] Implement rendering for foreign declarations

c460bfaRupert Horlick7 years ago

data/examples/declaration/foreign/foreign-export-out.hsnew file+8

compare with master

unifiedsplit

@@ -0,0 +1,8 @@

1+foreign export ccall foo :: Int -> IO Int

3+-- | 'foreignTomFun' is a very important thing

4+foreign export ccall "tomography"

5+ foreignTomFun :: StablePtr Storage -> TomForegin {- Storage is bad -}

7+foreign export {- We can't use capi here -} ccall "dynamic"

8+ export_nullaryMeth :: (IO HRESULT) -> IO (Ptr ())

data/examples/declaration/foreign/foreign-export.hsnew file+8

@@ -0,0 +1,8 @@

1+foreign export ccall foo :: Int -> IO Int

3+-- | 'foreignTomFun' is a very important thing

4+foreign export ccall "tomography" foreignTomFun

5+ :: StablePtr Storage {- Storage is bad -} -> TomForegin

7+foreign export {- We can't use capi here -} ccall "dynamic"

8+ export_nullaryMeth :: (IO HRESULT) -> IO (Ptr ())

data/examples/declaration/foreign/foreign-import-out.hsnew file+24

@@ -0,0 +1,24 @@

1+{-# LANGUAGE CApiFFI #-}

2+foreign import ccall safe foo :: Int -> IO Int

4+-- | 'bar' is a very important thing

5+foreign import stdcall "baz" bar :: String -> Int -> IO String

7+foreign import stdcall unsafe "boo"

8+ -- Here is a comment about my foreign function

9+ boo :: Int -> Text -> IO Array

10+

11+foreign import javascript

12+ baz

13+ :: String

14+ -> Int

15+ -> IO Foo

16+

17+foreign import {- We use capi here -} capi "pi.h value pi" c_pi :: CDouble

18+

19+foreign import stdcall "dynamic" {- This is a bad place for a comment -}

20+ dyn_gluBeginSurface

21+ :: FunPtr (Ptr GLUnurbs -> IO ())

22+ -- ^ This 'FunPtr' is extremely dangerous, beware

23+ -> Ptr GLUnurbs

24+ -> IO ()

data/examples/declaration/foreign/foreign-import.hsnew file+20

@@ -0,0 +1,20 @@

1+{-# LANGUAGE CApiFFI #-}

3+foreign import ccall safe foo :: Int -> IO Int

5+-- | 'bar' is a very important thing

6+foreign import stdcall "baz" bar :: String -> Int -> IO String

8+foreign import stdcall unsafe "boo"

9+ -- Here is a comment about my foreign function

10+ boo :: Int -> Text -> IO Array

11+

12+foreign import javascript baz :: String

13+ -> Int -> IO Foo

14+

15+foreign import {- We use capi here -} capi "pi.h value pi" c_pi :: CDouble

16+

17+foreign import stdcall {- This is a bad place for a comment -} "dynamic" dyn_gluBeginSurface

18+ :: FunPtr (Ptr GLUnurbs -> IO ())

19+ -- ^ This 'FunPtr' is extremely dangerous, beware

20+ -> Ptr GLUnurbs -> IO ()

ormolu.cabal+1

@@ -64,6 +64,7 @@ library

64 , Ormolu.Printer.Meat.Declaration.Class

65 , Ormolu.Printer.Meat.Declaration.Data

66 , Ormolu.Printer.Meat.Declaration.Default

67+ , Ormolu.Printer.Meat.Declaration.Foreign

67 , Ormolu.Printer.Meat.Declaration.Instance

68 , Ormolu.Printer.Meat.Declaration.Instance

68 , Ormolu.Printer.Meat.Declaration.RoleAnnotation

69 , Ormolu.Printer.Meat.Declaration.RoleAnnotation

69 , Ormolu.Printer.Meat.Declaration.Signature

70 , Ormolu.Printer.Meat.Declaration.Signature

src/Ormolu/Printer/Meat/Declaration.hs+2−1

@@ -16,6 +16,7 @@ import Ormolu.Printer.Meat.Declaration.Class

16import Ormolu.Printer.Meat.Declaration.Data

17import Ormolu.Printer.Meat.Declaration.Default

18import Ormolu.Printer.Meat.Declaration.Instance

19+import Ormolu.Printer.Meat.Declaration.Foreign

19import Ormolu.Printer.Meat.Declaration.RoleAnnotation

20import Ormolu.Printer.Meat.Declaration.RoleAnnotation

20import Ormolu.Printer.Meat.Declaration.Signature

21import Ormolu.Printer.Meat.Declaration.Signature

21import Ormolu.Printer.Meat.Declaration.Type

22import Ormolu.Printer.Meat.Declaration.Type

@@ -32,7 +33,7 @@ p_hsDecl = \case

32 InstD NoExt x -> p_instDecl x

33 InstD NoExt x -> p_instDecl x

33 DerivD NoExt x -> p_derivDecl x

34 DerivD NoExt x -> p_derivDecl x

34 DefD NoExt x -> p_defaultDecl x

35 DefD NoExt x -> p_defaultDecl x

35− ForD _ _ -> notImplemented "ForD"

36+ ForD NoExt x -> p_foreignDecl x

36 WarningD _ _ -> notImplemented "WarningD"

37 WarningD _ _ -> notImplemented "WarningD"

37 AnnD NoExt x -> p_annDecl x

38 AnnD NoExt x -> p_annDecl x

38 RuleD _ _ -> notImplemented "RuleD"

39 RuleD _ _ -> notImplemented "RuleD"

src/Ormolu/Printer/Meat/Declaration/Foreign.hsnew file+72

@@ -0,0 +1,72 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE NamedFieldPuns #-}

3+{-# LANGUAGE OverloadedStrings #-}

5+module Ormolu.Printer.Meat.Declaration.Foreign

6+ ( p_foreignDecl

7+ )

8+where

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)