{-# LANGUAGE ForeignFunctionInterface #-}

module MLP.Value where
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import qualified MLP
import qualified MLP.Type 


foreign import ccall unsafe "mlp.h mlp_value_new_bool" c_new_bool :: CInt -> IO (Ptr MLP.C_value)
newBool :: Bool -> IO MLP.Value
newBool b = do
  c_val <- c_new_bool $ fromIntegral (if b then 1 else 0)
  return $ MLP.Value c_val


foreign import ccall unsafe "mlp.h mlp_value_get_bool" c_get_bool :: Ptr MLP.C_value -> IO (CInt)
getBool :: MLP.Value -> IO Bool
getBool val@(MLP.Value c_val) = do
  t <- getType val
  case t of
    MLP.BOOL -> do
      c_int <- c_get_bool c_val
      return $ if c_int == 0 then False else True


foreign import ccall unsafe "mlp.h mlp_value_new_long" c_new_long :: CLong -> IO (Ptr MLP.C_value)
newLong :: Int -> IO MLP.Value
newLong l = do
  c_val <- c_new_long $ fromIntegral l
  return $ MLP.Value c_val


foreign import ccall unsafe "mlp.h mlp_value_get_long" c_get_long :: Ptr MLP.C_value -> IO (CLong)
getLong :: MLP.Value -> IO Int
getLong val@(MLP.Value c_val) = do
  t <- getType val
  case t of
    MLP.LONG -> do
      c_long <- c_get_long c_val
      return $ fromIntegral c_long


foreign import ccall unsafe "mlp.h mlp_value_new_double" c_new_double :: CDouble -> IO (Ptr MLP.C_value)
newDouble :: Double -> IO MLP.Value
newDouble d = do
  c_val <- c_new_double $ realToFrac d
  return $ MLP.Value c_val


foreign import ccall unsafe "mlp.h mlp_value_get_double" c_get_double :: Ptr MLP.C_value -> IO (CDouble)
getDouble :: MLP.Value -> IO Double
getDouble val@(MLP.Value c_val) = do
  t <- getType val
  case t of
    MLP.DOUBLE -> do
      c_double <- c_get_double c_val
      return $ realToFrac c_double



foreign import ccall unsafe "mlp.h mlp_value_take_object" c_take_object :: Ptr MLP.C_value -> IO (Ptr MLP.C_object)
takeObject :: MLP.Value -> IO MLP.Object
takeObject val@(MLP.Value c_val) = do
  t <- getType val
  case t of
    MLP.OBJECT -> do
      c_obj <- c_take_object c_val
      return $ MLP.Object c_obj


foreign import ccall unsafe "mlp.h mlp_value_get_type" c_get_type :: Ptr MLP.C_value -> IO (CInt)
getType :: MLP.Value -> IO MLP.Type
getType val@(MLP.Value c_val) = do
  c_int <- c_get_type c_val
  return $ MLP.Type.fromCInt c_int


foreign import ccall unsafe "mlp.h mlp_value_to_string" c_to_string :: Ptr MLP.C_value -> IO (CString)
toString :: MLP.Value -> IO String
toString val@(MLP.Value c_val) = do
  c_str <- c_to_string c_val
  peekCString c_str


foreign import ccall unsafe "mlp.h mlp_value_delete" c_delete :: Ptr MLP.C_context -> Ptr MLP.C_value -> IO ()
delete :: MLP.Context -> MLP.Value -> IO ()
delete ctx @(MLP.Context c_ctx) val@(MLP.Value c_val) = do
  MLP.withFuncDebug "Value delete" $
    c_delete c_ctx c_val



{-

sub new_long {
	my $pkg = shift ;
	my $v = shift ;

	return $pkg->_new($v, MLP::Type->LONG) ;
}


sub get_long {
	my $this = shift ;

	die("Can't call get_long() on a MLP::Value of type " . $this->{type}->get_name()) 
		unless $this->{type} eq MLP::Type->LONG ;

	return $this->{v} ;
}


sub new_double {
	my $pkg = shift ;
	my $v = shift ;

	return $pkg->_new($v, MLP::Type->DOUBLE) ;
}


sub get_double {
	my $this = shift ;

	die("Can't call get_double() on a MLP::Value of type " . $this->{type}->get_name()) 
		unless $this->{type} eq MLP::Type->DOUBLE ;

	return $this->{v} ;
}


sub new_char {
	my $pkg = shift ;
	my $v = shift ;

	return $pkg->_new($v, MLP::Type->CHAR) ;
}


sub get_char {
	my $this = shift ;

	die("Can't call get_char() on a MLP::Value of type " . $this->{type}->get_name()) 
		unless $this->{type} eq MLP::Type->CHAR ;

	return $this->{v} ;
}


sub new_string {
	my $pkg = shift ;
	my $v = shift ;

	return $pkg->_new($v, MLP::Type->STRING) ;
}


sub get_string {
	my $this = shift ;

	die("Can't call get_string() on a MLP::Value of type " . $this->{type}->get_name()) 
		unless $this->{type} eq MLP::Type->STRING ;

	return $this->{v} ;
}


sub new_object {
	my $pkg = shift ;
	my $v = shift ;

	return $pkg->_new($v, MLP::Type->OBJECT) ;
}


sub get_object {
	my $this = shift ;

	die("Can't call get_object() on a MLP::Value of type " . $this->{type}->get_name()) 
		unless $this->{type} eq MLP::Type->OBJECT ;

	return $this->{v} ;
}


sub new_exception {
	my $pkg = shift ;
	my $v = shift ;

	return $pkg->_new($v, MLP::Type->EXCEPTION) ;
}


sub get_exception {
	my $this = shift ;

	die("Can't call get_exception() on a MLP::Value of type " . $this->{type}->get_name()) 
		unless $this->{type} eq MLP::Type->EXCEPTION ;

	return $this->{v} ;
}



-}