----------------------------------------------------------------------------
-- |
-- Module      :  Data.Emacs.Module.Env.Internal
-- Copyright   :  (c) Sergey Vinokurov 2018
-- License     :  Apache-2.0 (see LICENSE)
-- Maintainer  :  serg.foo@gmail.com
----------------------------------------------------------------------------

{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash                #-}
{-# LANGUAGE UnliftedFFITypes         #-}
{-# LANGUAGE UnliftedNewtypes         #-}

{-# OPTIONS_HADDOCK not-home #-}

module Data.Emacs.Module.Raw.Env.Internal
  ( Env(..)
  , Environment
  , toPtr
  , fromPtr
  , exportToEmacs
  , RawFunctionType
  , RawFunction(..)

  , freeHaskellFunPtrWrapped
  ) where

import Foreign
import Foreign.C.Types
import GHC.Exts (Addr#, Ptr(..))

import Data.Emacs.Module.Raw.Value.Internal

-- | Emacs environment, right from the 'emacs-module.h'.
newtype Env = Env { Env -> Addr#
unEnv# :: Addr# }

data Environment

{-# INLINE toPtr #-}
toPtr :: Env -> Ptr Environment
toPtr :: Env -> Ptr Environment
toPtr (Env Addr#
x) = Addr# -> Ptr Environment
forall a. Addr# -> Ptr a
Ptr Addr#
x

{-# INLINE fromPtr #-}
fromPtr :: Ptr Environment -> Env
fromPtr :: Ptr Environment -> Env
fromPtr (Ptr Addr#
x) = Addr# -> Env
Env Addr#
x

type RawFunctionType o a
  =  Ptr Environment
  -> CPtrdiff                -- Number of arguments
  -> Ptr (RawValue 'Regular) -- Actual arguments, always supplied by Emacs so never 'Pinned'.
  -> Ptr a                   -- Extra data
  -> IO (RawValue o)

-- NB This is *the* coolest point of this library: *any* Haskell
-- function (incl closures) may be exposed to C to be called later.
-- The C/C++ will never have this...

-- | Take Haskell function and return C pointer to function (which
-- ideally needs to be cleaned up later by 'freeHaskellFunPtrWrapped').
foreign import ccall "wrapper"
  exportToEmacs :: RawFunctionType o a -> IO (RawFunction o a)

-- | Pointer to a function that may later be called by by Emacs.
newtype RawFunction o a = RawFunction { forall (o :: Pinning) a.
RawFunction o a -> FunPtr (RawFunctionType o a)
unRawFunction :: FunPtr (RawFunctionType o a) }
  deriving (RawFunction o a -> RawFunction o a -> Bool
(RawFunction o a -> RawFunction o a -> Bool)
-> (RawFunction o a -> RawFunction o a -> Bool)
-> Eq (RawFunction o a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (o :: Pinning) a. RawFunction o a -> RawFunction o a -> Bool
$c== :: forall (o :: Pinning) a. RawFunction o a -> RawFunction o a -> Bool
== :: RawFunction o a -> RawFunction o a -> Bool
$c/= :: forall (o :: Pinning) a. RawFunction o a -> RawFunction o a -> Bool
/= :: RawFunction o a -> RawFunction o a -> Bool
Eq, Eq (RawFunction o a)
Eq (RawFunction o a) =>
(RawFunction o a -> RawFunction o a -> Ordering)
-> (RawFunction o a -> RawFunction o a -> Bool)
-> (RawFunction o a -> RawFunction o a -> Bool)
-> (RawFunction o a -> RawFunction o a -> Bool)
-> (RawFunction o a -> RawFunction o a -> Bool)
-> (RawFunction o a -> RawFunction o a -> RawFunction o a)
-> (RawFunction o a -> RawFunction o a -> RawFunction o a)
-> Ord (RawFunction o a)
RawFunction o a -> RawFunction o a -> Bool
RawFunction o a -> RawFunction o a -> Ordering
RawFunction o a -> RawFunction o a -> RawFunction o a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (o :: Pinning) a. Eq (RawFunction o a)
forall (o :: Pinning) a. RawFunction o a -> RawFunction o a -> Bool
forall (o :: Pinning) a.
RawFunction o a -> RawFunction o a -> Ordering
forall (o :: Pinning) a.
RawFunction o a -> RawFunction o a -> RawFunction o a
$ccompare :: forall (o :: Pinning) a.
RawFunction o a -> RawFunction o a -> Ordering
compare :: RawFunction o a -> RawFunction o a -> Ordering
$c< :: forall (o :: Pinning) a. RawFunction o a -> RawFunction o a -> Bool
< :: RawFunction o a -> RawFunction o a -> Bool
$c<= :: forall (o :: Pinning) a. RawFunction o a -> RawFunction o a -> Bool
<= :: RawFunction o a -> RawFunction o a -> Bool
$c> :: forall (o :: Pinning) a. RawFunction o a -> RawFunction o a -> Bool
> :: RawFunction o a -> RawFunction o a -> Bool
$c>= :: forall (o :: Pinning) a. RawFunction o a -> RawFunction o a -> Bool
>= :: RawFunction o a -> RawFunction o a -> Bool
$cmax :: forall (o :: Pinning) a.
RawFunction o a -> RawFunction o a -> RawFunction o a
max :: RawFunction o a -> RawFunction o a -> RawFunction o a
$cmin :: forall (o :: Pinning) a.
RawFunction o a -> RawFunction o a -> RawFunction o a
min :: RawFunction o a -> RawFunction o a -> RawFunction o a
Ord, Int -> RawFunction o a -> ShowS
[RawFunction o a] -> ShowS
RawFunction o a -> String
(Int -> RawFunction o a -> ShowS)
-> (RawFunction o a -> String)
-> ([RawFunction o a] -> ShowS)
-> Show (RawFunction o a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (o :: Pinning) a. Int -> RawFunction o a -> ShowS
forall (o :: Pinning) a. [RawFunction o a] -> ShowS
forall (o :: Pinning) a. RawFunction o a -> String
$cshowsPrec :: forall (o :: Pinning) a. Int -> RawFunction o a -> ShowS
showsPrec :: Int -> RawFunction o a -> ShowS
$cshow :: forall (o :: Pinning) a. RawFunction o a -> String
show :: RawFunction o a -> String
$cshowList :: forall (o :: Pinning) a. [RawFunction o a] -> ShowS
showList :: [RawFunction o a] -> ShowS
Show)

-- This function is defined in base. See what 'freeHaskellFunPtr' for a start.
foreign import ccall unsafe "&freeHaskellFunctionPtr"
  freeHaskellFunPtrWrapped :: FinalizerPtr a