{-# LANGUAGE ForeignFunctionInterface #-}
module MhsEval (
    MhsContext,
    withMhsContext,
    createMhsContext,
    closeMhsContext,
    eval,
    run,
    MhsError(..),
    compiledWithGhc
) where

import Foreign
import Foreign.C.String
import Foreign.C.Types
import Control.Exception
import Control.Monad (unless)

-- | Opaque context type
newtype MhsContext = MhsContext (Ptr ())

-- | Custom error type for MicroHs evaluation
data MhsError = 
    MhsInitError String
  | MhsEvalError String
  deriving (Show)

instance Exception MhsError

-- | This type represents the object code generated by the MicroHs compiler as typically written to out.comb.
type MhsCombCode = String

compiledWithGhc :: Bool
compiledWithGhc = True

-- Foreign imports for functions in mhseval.h
foreign import ccall "mhs_init_context"
  c_mhs_init_context :: IO (Ptr ())

foreign import ccall "mhs_free_context"
  c_mhs_free_context :: Ptr () -> IO ()

foreign import ccall "mhs_eval_string"
  c_mhs_eval_string :: Ptr () -> CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt

foreign import ccall "mhs_run_string"
  c_mhs_run_string :: Ptr () -> CString -> CSize -> IO CInt

foreign import ccall "mhs_free_result"
  c_mhs_free_result :: CString -> IO ()

foreign import ccall "mhs_get_error"
  c_mhs_get_error :: Ptr () -> IO CString

-- |  Initializes a MicroHs context
-- This function allocates resources needed for evaluation.
-- It should be called once before any evaluation and cleaned up with 'closeMhsContext'.
createMhsContext :: IO MhsContext
createMhsContext = do
  ctx_ptr <- c_mhs_init_context
  if ctx_ptr == nullPtr
      then throwIO $ MhsInitError "Failed to initialize MicroHs context"
      else return (MhsContext ctx_ptr)

-- | Cleans up the MicroHs context
-- This function releases resources allocated by 'createMhsContext'.
-- It should be called after all evaluations are done.
closeMhsContext :: MhsContext -> IO ()
closeMhsContext (MhsContext ctx_ptr) = do
  unless (ctx_ptr == nullPtr) $ do
      c_mhs_free_context ctx_ptr        

-- | Runs an action with a MicroHs context
-- This function initializes a context, runs the action, and cleans up afterwards.
-- It is useful for one-off evaluations without needing to manage the context manually.
withMhsContext :: (MhsContext -> IO a) -> IO a
withMhsContext action = do
  ctx_ptr <- c_mhs_init_context
  if ctx_ptr == nullPtr
    then throwIO $ MhsInitError "Failed to initialize MicroHs context"
    else action (MhsContext ctx_ptr) `finally` c_mhs_free_context ctx_ptr

-- | Evaluates a MicroHs combinator code program from a string
-- This function takes a string containing MicroHs combinator code, evaluates it, and returns the result as a string.
-- If evaluation fails, it throws an 'MhsEvalError'.
eval :: MhsContext -> MhsCombCode -> IO String
eval (MhsContext ctx) expr = do
  withCStringLen expr $ \(expr_ptr, expr_len) -> do
    alloca $ \result_ptr -> do
      alloca $ \result_len_ptr -> do
        ret <- c_mhs_eval_string ctx expr_ptr (fromIntegral expr_len) result_ptr result_len_ptr
        if ret == 0
          then do
            result_cstr <- peek result_ptr
            result_len <- peek result_len_ptr
            result <- peekCStringLen (result_cstr, fromIntegral result_len)
            c_mhs_free_result result_cstr
            return result
          else do
            err_ptr <- c_mhs_get_error ctx
            err_msg <- peekCString err_ptr
            throwIO $ MhsEvalError err_msg

-- | Runs a MicroHs combinator code program from a string
-- This function takes a string containing MicroHs combinator code, and runs it.
run :: MhsContext -> MhsCombCode -> IO ()
run (MhsContext ctx) expr = do
  withCStringLen expr $ \(expr_ptr, expr_len) -> do
    ret <- c_mhs_run_string ctx expr_ptr (fromIntegral expr_len)
    if ret == 0
      then return ()
      else do
        err_ptr <- c_mhs_get_error ctx
        err_msg <- peekCString err_ptr
        throwIO $ MhsEvalError err_msg