-- | Foreign export stubs
{-# LANGUAGE DerivingVia #-}
module GHC.Types.ForeignStubs
   ( ForeignStubs (..)
   , CHeader(..)
   , CStub(..)
   , appendStubC
   )
where

import GHC.Utils.Outputable
import Data.Monoid
import Data.Semigroup
import Data.Coerce

newtype CStub = CStub { CStub -> SDoc
getCStub :: SDoc }

emptyCStub :: CStub
emptyCStub :: CStub
emptyCStub = SDoc -> CStub
CStub SDoc
empty

instance Monoid CStub where
  mempty :: CStub
mempty = CStub
emptyCStub
  mconcat :: [CStub] -> CStub
mconcat = ([SDoc] -> SDoc) -> [CStub] -> CStub
coerce [SDoc] -> SDoc
vcat

instance Semigroup CStub where
  <> :: CStub -> CStub -> CStub
(<>) = (SDoc -> SDoc -> SDoc) -> CStub -> CStub -> CStub
coerce SDoc -> SDoc -> SDoc
($$)

newtype CHeader = CHeader { CHeader -> SDoc
getCHeader :: SDoc }
  deriving (Semigroup CHeader
CHeader
Semigroup CHeader
-> CHeader
-> (CHeader -> CHeader -> CHeader)
-> ([CHeader] -> CHeader)
-> Monoid CHeader
[CHeader] -> CHeader
CHeader -> CHeader -> CHeader
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CHeader] -> CHeader
$cmconcat :: [CHeader] -> CHeader
mappend :: CHeader -> CHeader -> CHeader
$cmappend :: CHeader -> CHeader -> CHeader
mempty :: CHeader
$cmempty :: CHeader
Monoid, NonEmpty CHeader -> CHeader
CHeader -> CHeader -> CHeader
(CHeader -> CHeader -> CHeader)
-> (NonEmpty CHeader -> CHeader)
-> (forall b. Integral b => b -> CHeader -> CHeader)
-> Semigroup CHeader
forall b. Integral b => b -> CHeader -> CHeader
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> CHeader -> CHeader
$cstimes :: forall b. Integral b => b -> CHeader -> CHeader
sconcat :: NonEmpty CHeader -> CHeader
$csconcat :: NonEmpty CHeader -> CHeader
<> :: CHeader -> CHeader -> CHeader
$c<> :: CHeader -> CHeader -> CHeader
Semigroup) via CStub

-- | Foreign export stubs
data ForeignStubs
  = NoStubs
      -- ^ We don't have any stubs
  | ForeignStubs CHeader CStub
      -- ^ There are some stubs. Parameters:
      --
      --  1) Header file prototypes for
      --     "foreign exported" functions
      --
      --  2) C stubs to use when calling
      --     "foreign exported" functions

appendStubC :: ForeignStubs -> CStub -> ForeignStubs
appendStubC :: ForeignStubs -> CStub -> ForeignStubs
appendStubC ForeignStubs
NoStubs         CStub
c_code = CHeader -> CStub -> ForeignStubs
ForeignStubs CHeader
forall a. Monoid a => a
mempty CStub
c_code
appendStubC (ForeignStubs CHeader
h CStub
c) CStub
c_code = CHeader -> CStub -> ForeignStubs
ForeignStubs CHeader
h (CStub
c CStub -> CStub -> CStub
forall a. Monoid a => a -> a -> a
`mappend` CStub
c_code)