{-# LINE 1 "src/Data/Emacs/Module/Runtime.hsc" #-}
----------------------------------------------------------------------------
-- |
-- Module      :  Data.Emacs.Module.Runtime
-- Copyright   :  (c) Sergey Vinokurov 2018
-- License     :  Apache-2.0 (see LICENSE)
-- Maintainer  :  serg.foo@gmail.com
----------------------------------------------------------------------------

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Emacs.Module.Runtime
  ( Runtime(..)
  , validateRuntime
  , getEnvironment
  ) where

import Control.Monad.Base

import Foreign
import Foreign.C.Types

import Data.Emacs.Module.Env qualified as Emacs
import Data.Emacs.Module.Raw.Env.Internal (Env(..))
import Data.Emacs.Module.NonNullPtr

import Data.Emacs.Module.NonNullPtr.Internal



-- | Emacs environment, right from the 'emacs-module.h'.
newtype Runtime = Runtime { Runtime -> NonNullPtr Runtime
unRuntime :: NonNullPtr Runtime }

type GetEnvironentType = Runtime -> IO Emacs.Env

foreign import ccall unsafe "dynamic" emacs_get_environment
  :: FunPtr GetEnvironentType -> GetEnvironentType

validateRuntime :: MonadBase IO m => Ptr Runtime -> m (Maybe Runtime)
validateRuntime :: Ptr Runtime -> m (Maybe Runtime)
validateRuntime Ptr Runtime
ptr
  | Ptr Runtime
ptr Ptr Runtime -> Ptr Runtime -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Runtime
forall a. Ptr a
nullPtr = Maybe Runtime -> m (Maybe Runtime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Runtime
forall a. Maybe a
Nothing
  | Bool
otherwise      = IO (Maybe Runtime) -> m (Maybe Runtime)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Maybe Runtime) -> m (Maybe Runtime))
-> IO (Maybe Runtime) -> m (Maybe Runtime)
forall a b. (a -> b) -> a -> b
$ do
      CPtrdiff
size <- ((\Ptr Runtime
hsc_ptr -> Ptr Runtime -> Int -> IO CPtrdiff
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Runtime
hsc_ptr Int
0)) Ptr Runtime
ptr
{-# LINE 45 "src/Data/Emacs/Module/Runtime.hsc" #-}
      pure $ if expectedSize <= size then Just (Runtime (NonNullPtr ptr)) else Nothing
  where
    expectedSize :: CPtrdiff
    expectedSize :: CPtrdiff
expectedSize = ((CPtrdiff
24))
{-# LINE 49 "src/Data/Emacs/Module/Runtime.hsc" #-}

getEnvironment :: MonadBase IO m => Runtime -> m Emacs.Env
getEnvironment :: Runtime -> m Env
getEnvironment Runtime
runtime = IO Env -> m Env
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Env -> m Env) -> IO Env -> m Env
forall a b. (a -> b) -> a -> b
$ do
  (FunPtr GetEnvironentType
funPtr :: FunPtr GetEnvironentType) <- ((\Ptr Runtime
hsc_ptr -> Ptr Runtime -> Int -> IO (FunPtr GetEnvironentType)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Runtime
hsc_ptr Int
16)) (NonNullPtr Runtime -> Ptr Runtime
forall a. NonNullPtr a -> Ptr a
unNonNullPtr (NonNullPtr Runtime -> Ptr Runtime)
-> NonNullPtr Runtime -> Ptr Runtime
forall a b. (a -> b) -> a -> b
$ Runtime -> NonNullPtr Runtime
unRuntime Runtime
runtime)
{-# LINE 53 "src/Data/Emacs/Module/Runtime.hsc" #-}
  emacs_get_environment funPtr runtime