{-# LANGUAGE ForeignFunctionInterface, TypeSynonymInstances, ScopedTypeVariables #-}
{-# INCLUDE "p5embed.h" #-}

module Language.Perl5
    ( Context(..)
    , ToSV(..)
    , FromSV(..)
    , withPerl5
    , eval
    ) where
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Control.Exception (bracket)

data Context = Void | Item | List

enumContext :: (Num a) => Context -> a
enumContext Void = 128
enumContext Item = 0
enumContext List = 1

type Interpreter = Ptr ()
type SV = Ptr ()

-- | Run a computation within the context of a Perl 5 interpreter. 
withPerl5 :: IO a -> IO a
withPerl5 f = do
    withCString "-e" $ \prog -> withCString "" $ \cstr -> do
        withArray [prog, prog, cstr] $ \argv -> do
            bracket (perl5_init 3 argv) (\interp -> do
                perl_destruct interp
                perl_free interp) (const f)

-- | Evaluate a snippet of Perl 5 code.
eval :: forall a. FromSV a => String -> IO a
eval str = withCString str $ \cstr -> do
    sv <- perl5_eval cstr (enumContext $ contextOf (undefined :: a))
    fromSV sv

-- | Data types that can be casted into a Perl 5 value (SV).
class ToSV a where
    toSV :: a -> IO SV

-- | Data types that can be casted from a Perl 5 value (SV).
class FromSV a where
    fromSV :: SV -> IO a
    contextOf :: a -> Context
    contextOf _ = Item

instance ToSV () where
    toSV _ = perl5_sv_undef
instance FromSV () where
    fromSV x = seq x (return ())
    contextOf _ = Void

instance ToSV String where
    toSV str = withCStringLen str $ \(cstr, len) -> do
        perl5_newSVpvn cstr (toEnum len)
instance FromSV String where
    fromSV sv = do
        cstr <- perl5_SvPV sv
        peekCString cstr

foreign import ccall "perl5_init"
    perl5_init :: CInt -> Ptr CString -> IO Interpreter
foreign import ccall "perl5_sv_undef"
    perl5_sv_undef :: IO SV
foreign import ccall "perl5_eval"
    perl5_eval :: CString -> CInt -> IO SV
foreign import ccall "perl5_newSVpvn"
    perl5_newSVpvn :: CString -> CInt -> IO SV
foreign import ccall "perl5_SvPV"
    perl5_SvPV :: SV -> IO CString
foreign import ccall "perl_destruct"
    perl_destruct :: Interpreter -> IO CInt
foreign import ccall "perl_free"
    perl_free :: Interpreter -> IO ()