{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Foreign
  ( ForeignDeclaration
  , mkForeignDeclaration
  ) where

import Data.Maybe
import qualified GHC.Types.ForeignCall as GHC
import qualified GHC.Types.SourceText as GHC
import qualified GHC.Types.SrcLoc as GHC
import HIndent.Ast.Declaration.Foreign.CallingConvention
import HIndent.Ast.Declaration.Foreign.Safety
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
#if MIN_VERSION_ghc_lib_parser(9, 8, 0)
import qualified GHC.Data.FastString as GHC
#endif
data ForeignDeclaration
  = ForeignImport
      { ForeignDeclaration -> CallingConvention
convention :: CallingConvention
      , ForeignDeclaration -> Safety
safety :: Safety
      , ForeignDeclaration -> Maybe String
srcIdent :: Maybe String
      , ForeignDeclaration -> WithComments PrefixName
dstIdent :: WithComments PrefixName
      , ForeignDeclaration -> LHsSigType GhcPs
signature :: GHC.LHsSigType GHC.GhcPs
      }
  | ForeignExport
      { convention :: CallingConvention
      , srcIdent :: Maybe String
      , dstIdent :: WithComments PrefixName
      , signature :: GHC.LHsSigType GHC.GhcPs
      }

instance CommentExtraction ForeignDeclaration where
  nodeComments :: ForeignDeclaration -> NodeComments
nodeComments ForeignImport {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments ForeignExport {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty ForeignDeclaration where
  pretty' :: ForeignDeclaration -> Printer ()
pretty' ForeignImport {Maybe String
LHsSigType GhcPs
WithComments PrefixName
Safety
CallingConvention
convention :: ForeignDeclaration -> CallingConvention
safety :: ForeignDeclaration -> Safety
srcIdent :: ForeignDeclaration -> Maybe String
dstIdent :: ForeignDeclaration -> WithComments PrefixName
signature :: ForeignDeclaration -> LHsSigType GhcPs
convention :: CallingConvention
safety :: Safety
srcIdent :: Maybe String
dstIdent :: WithComments PrefixName
signature :: LHsSigType GhcPs
..} =
    [Printer ()] -> Printer ()
spaced
      ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"foreign import", CallingConvention -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty CallingConvention
convention, Safety -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Safety
safety]
          [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ Maybe (Printer ()) -> [Printer ()]
forall a. Maybe a -> [a]
maybeToList ((String -> Printer ()) -> Maybe String -> Maybe (Printer ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => String -> Printer ()
String -> Printer ()
string Maybe String
srcIdent)
          [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
dstIdent, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
signature]
  pretty' ForeignExport {Maybe String
LHsSigType GhcPs
WithComments PrefixName
CallingConvention
convention :: ForeignDeclaration -> CallingConvention
srcIdent :: ForeignDeclaration -> Maybe String
dstIdent :: ForeignDeclaration -> WithComments PrefixName
signature :: ForeignDeclaration -> LHsSigType GhcPs
convention :: CallingConvention
srcIdent :: Maybe String
dstIdent :: WithComments PrefixName
signature :: LHsSigType GhcPs
..} =
    [Printer ()] -> Printer ()
spaced
      ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ [HasCallStack => String -> Printer ()
String -> Printer ()
string String
"foreign export", CallingConvention -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty CallingConvention
convention]
          [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ Maybe (Printer ()) -> [Printer ()]
forall a. Maybe a -> [a]
maybeToList ((String -> Printer ()) -> Maybe String -> Maybe (Printer ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => String -> Printer ()
String -> Printer ()
string Maybe String
srcIdent)
          [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
dstIdent, HasCallStack => String -> Printer ()
String -> Printer ()
string String
"::", GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
signature]

mkForeignDeclaration :: GHC.ForeignDecl GHC.GhcPs -> ForeignDeclaration
#if MIN_VERSION_ghc_lib_parser(9, 8, 0)
mkForeignDeclaration :: ForeignDecl GhcPs -> ForeignDeclaration
mkForeignDeclaration GHC.ForeignImport { fd_fi :: forall pass. ForeignDecl pass -> ForeignImport pass
fd_fi = (GHC.CImport (GHC.L EpaLocation
_ SourceText
src) (GHC.L EpaLocation
_ CCallConv
conv) (GHC.L EpaLocation
_ Safety
sfty) Maybe Header
_ CImportSpec
_)
                                       , XForeignImport GhcPs
LIdP GhcPs
LHsSigType GhcPs
fd_i_ext :: XForeignImport GhcPs
fd_name :: LIdP GhcPs
fd_sig_ty :: LHsSigType GhcPs
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_i_ext :: forall pass. ForeignDecl pass -> XForeignImport pass
..
                                       } = ForeignImport {Maybe String
LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
WithComments PrefixName
Safety
CallingConvention
convention :: CallingConvention
safety :: Safety
srcIdent :: Maybe String
dstIdent :: WithComments PrefixName
signature :: LHsSigType GhcPs
convention :: CallingConvention
safety :: Safety
srcIdent :: Maybe String
dstIdent :: WithComments PrefixName
signature :: GenLocated SrcSpanAnnA (HsSigType GhcPs)
..}
  where
    convention :: CallingConvention
convention = CCallConv -> CallingConvention
mkCallingConvention CCallConv
conv
    safety :: Safety
safety = Safety -> Safety
mkSafety Safety
sfty
    srcIdent :: Maybe String
srcIdent =
      case SourceText
src of
        GHC.SourceText FastString
s -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FastString -> String
GHC.unpackFS FastString
s
        SourceText
_ -> Maybe String
forall a. Maybe a
Nothing
    dstIdent :: WithComments PrefixName
dstIdent = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fd_name
    signature :: LHsSigType GhcPs
signature = LHsSigType GhcPs
fd_sig_ty
mkForeignDeclaration GHC.ForeignExport { fd_fe :: forall pass. ForeignDecl pass -> ForeignExport pass
fd_fe = (GHC.CExport (GHC.L EpaLocation
_ SourceText
src) (GHC.L EpaLocation
_ (GHC.CExportStatic SourceText
_ FastString
_ CCallConv
conv)))
                                       , XForeignExport GhcPs
LIdP GhcPs
LHsSigType GhcPs
fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_e_ext :: XForeignExport GhcPs
fd_name :: LIdP GhcPs
fd_sig_ty :: LHsSigType GhcPs
fd_e_ext :: forall pass. ForeignDecl pass -> XForeignExport pass
..
                                       } = ForeignExport {Maybe String
LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
WithComments PrefixName
CallingConvention
convention :: CallingConvention
srcIdent :: Maybe String
dstIdent :: WithComments PrefixName
signature :: LHsSigType GhcPs
convention :: CallingConvention
srcIdent :: Maybe String
dstIdent :: WithComments PrefixName
signature :: GenLocated SrcSpanAnnA (HsSigType GhcPs)
..}
  where
    convention :: CallingConvention
convention = CCallConv -> CallingConvention
mkCallingConvention CCallConv
conv
    srcIdent :: Maybe String
srcIdent =
      case SourceText
src of
        GHC.SourceText FastString
s -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FastString -> String
GHC.unpackFS FastString
s
        SourceText
_ -> Maybe String
forall a. Maybe a
Nothing
    dstIdent :: WithComments PrefixName
dstIdent = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fd_name
    signature :: LHsSigType GhcPs
signature = LHsSigType GhcPs
fd_sig_ty
#elif MIN_VERSION_ghc_lib_parser(9, 6, 0)
mkForeignDeclaration GHC.ForeignImport { fd_fi = (GHC.CImport (GHC.L _ src) (GHC.L _ conv) (GHC.L _ sfty) _ _)
                                       , ..
                                       } = ForeignImport {..}
  where
    convention = mkCallingConvention conv
    safety = mkSafety sfty
    srcIdent =
      case src of
        GHC.SourceText s -> Just s
        _ -> Nothing
    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name
    signature = fd_sig_ty
mkForeignDeclaration GHC.ForeignExport { fd_fe = (GHC.CExport (GHC.L _ src) (GHC.L _ (GHC.CExportStatic _ _ conv)))
                                       , ..
                                       } = ForeignExport {..}
  where
    convention = mkCallingConvention conv
    srcIdent =
      case src of
        GHC.SourceText s -> Just s
        _ -> Nothing
    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name
    signature = fd_sig_ty
#else
mkForeignDeclaration GHC.ForeignImport { fd_fi = (GHC.CImport (GHC.L _ conv) (GHC.L _ sfty) _ _ (GHC.L _ src))
                                       , ..
                                       } = ForeignImport {..}
  where
    convention = mkCallingConvention conv
    safety = mkSafety sfty
    srcIdent =
      case src of
        GHC.SourceText s -> Just s
        _ -> Nothing
    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name
    signature = fd_sig_ty
mkForeignDeclaration GHC.ForeignExport { fd_fe = (GHC.CExport (GHC.L _ (GHC.CExportStatic _ _ conv)) (GHC.L _ src))
                                       , ..
                                       } = ForeignExport {..}
  where
    convention = mkCallingConvention conv
    srcIdent =
      case src of
        GHC.SourceText s -> Just s
        _ -> Nothing
    dstIdent = fromGenLocated $ fmap mkPrefixName fd_name
    signature = fd_sig_ty
#endif