This is an automated email from the ASF dual-hosted git repository.
xuanwo pushed a commit to branch main
in repository https://gitbox.apache.org/repos/asf/opendal.git
The following commit(s) were added to refs/heads/main by this push:
new c2e3a873f feat(bindings/haskell): add more api (#6264)
c2e3a873f is described below
commit c2e3a873f84b795fdebc6f4965fb89c50b194956
Author: Asuka Minato <[email protected]>
AuthorDate: Tue Jun 10 18:56:11 2025 +0900
feat(bindings/haskell): add more api (#6264)
* add more api
* fix clippy
* try fix putStrLn
* rm example
* try fix
* fix test
* fix unsupported op
* Implement WriterOption for flexible file writing in OpenDAL
- Introduced `WriterOption` data type to specify write behavior (overwrite
or append).
- Updated `writerOpRaw` function to accept `WriterOption` for creating
writers.
- Replaced instances of `newWriter` and `newWriterAppend` with
`writerOpRaw` in tests to utilize the new options.
- Added default and append writer options for easier usage.
* Remove append operation from OpenDAL API and replace with writer API
usage in tests. Updated tests to demonstrate writing to files using the new
writer functionality, ensuring compatibility with existing operations.
* Add parseString function to OpenDAL for CString handling
- Introduced `parseString` function to convert `CString` to `String`,
improving memory management by freeing the original `CString`.
- Updated `operatorInfoRaw` to utilize `parseString` instead of
`peekCString`.
* Update bindings/haskell/haskell-src/OpenDAL/FFI.hs
* Remove blocking_append function from Haskell bindings in OpenDAL.
---
bindings/haskell/haskell-src/OpenDAL.hs | 137 ++++++++++++++-
bindings/haskell/haskell-src/OpenDAL/FFI.hs | 19 ++-
bindings/haskell/opendal.cabal | 2 +-
bindings/haskell/src/lib.rs | 255 ++++++++++++++++++++++++++++
bindings/haskell/test/BasicTest.hs | 142 +++++++++++++++-
bindings/haskell/test/ErrorTest.hs | 116 +++++++++++++
bindings/haskell/test/PerformanceTest.hs | 151 ++++++++++++++++
bindings/haskell/test/Spec.hs | 9 +-
bindings/haskell/test/WriterTest.hs | 153 +++++++++++++++++
9 files changed, 973 insertions(+), 11 deletions(-)
diff --git a/bindings/haskell/haskell-src/OpenDAL.hs
b/bindings/haskell/haskell-src/OpenDAL.hs
index 8d869a85d..5daa40da9 100644
--- a/bindings/haskell/haskell-src/OpenDAL.hs
+++ b/bindings/haskell/haskell-src/OpenDAL.hs
@@ -32,6 +32,8 @@ module OpenDAL
OperatorConfig (..),
Operator,
Lister,
+ Writer,
+ WriterOption (..),
OpenDALError (..),
ErrorCode (..),
EntryMode (..),
@@ -43,9 +45,18 @@ module OpenDAL
runOp,
newOperator,
+ -- * Writer Option Functions
+ defaultWriterOption,
+ appendWriterOption,
+
-- * Lister APIs
nextLister,
+ -- * Writer APIs
+ writerOpRaw,
+ writerWrite,
+ writerClose,
+
-- * Operator Raw APIs
-- $raw-operations
readOpRaw,
@@ -58,6 +69,8 @@ module OpenDAL
statOpRaw,
listOpRaw,
scanOpRaw,
+ operatorInfoRaw,
+ removeAllOpRaw,
)
where
@@ -120,6 +133,16 @@ newtype Operator = Operator (ForeignPtr RawOperator)
-- Users can construct Lister by `listOp` or `scanOp`.
newtype Lister = Lister (ForeignPtr RawLister)
+-- | `Writer` is designed to write bytes into given path.
+newtype Writer = Writer (ForeignPtr RawWriter)
+
+-- | Options for creating a Writer.
+data WriterOption = WriterOption
+ { -- | Whether to append to the file instead of overwriting it.
+ woAppend :: Bool
+ }
+ deriving (Eq, Show)
+
-- | Represents the possible error codes that can be returned by OpenDAL.
data ErrorCode
= -- | An error occurred in the FFI layer.
@@ -210,19 +233,22 @@ class (Monad m) => MonadOperation m where
-- | Delete given path.
deleteOp :: String -> m ()
- -- | Get given path’s metadata without cache directly.
+ -- | Get given path's metadata without cache directly.
statOp :: String -> m Metadata
-- | List current dir path.
-- This function will create a new handle to list entries.
- -- An error will be returned if path doesn’t end with /.
+ -- An error will be returned if path doesn't end with /.
listOp :: String -> m Lister
-- | List dir in flat way.
-- Also, this function can be used to list a prefix.
- -- An error will be returned if given path doesn’t end with /.
+ -- An error will be returned if given path doesn't end with /.
scanOp :: String -> m Lister
+ -- | Remove all files and directories recursively.
+ removeAllOp :: String -> m ()
+
instance (MonadIO m) => MonadOperation (OperatorT m) where
readOp path = do
op <- ask
@@ -264,6 +290,10 @@ instance (MonadIO m) => MonadOperation (OperatorT m) where
op <- ask
result <- liftIO $ scanOpRaw op path
either throwError return result
+ removeAllOp path = do
+ op <- ask
+ result <- liftIO $ removeAllOpRaw op path
+ either throwError return result
-- helper functions
@@ -296,6 +326,12 @@ parseCString value = do
free value
return $ Just value'
+parseString :: CString -> IO String
+parseString value = do
+ value' <- peekCString value
+ free value
+ return value'
+
parseTime :: String -> Maybe UTCTime
parseTime time = zonedTimeToUTC <$> parseTimeM True defaultTimeLocale
"%Y-%m-%dT%H:%M:%S%Q%z" time
@@ -323,6 +359,14 @@ parseFFIMetadata (FFIMetadata mode cacheControl
contentDisposition contentLength
-- Exported functions
+-- | Default WriterOption for writing (overwriting).
+defaultWriterOption :: WriterOption
+defaultWriterOption = WriterOption {woAppend = False}
+
+-- | WriterOption for appending to a file.
+appendWriterOption :: WriterOption
+appendWriterOption = WriterOption {woAppend = True}
+
-- | Runner for 'OperatorT' monad.
-- This function will run given 'OperatorT' monad with given 'Operator'.
--
@@ -489,7 +533,7 @@ deleteOpRaw (Operator op) path = withForeignPtr op $ \opptr
->
errMsg <- peekCString (errorMessage ffiResult)
return $ Left $ OpenDALError code errMsg
--- | Get given path’s metadata without cache directly.
+-- | Get given path's metadata without cache directly.
statOpRaw :: Operator -> String -> IO (Either OpenDALError Metadata)
statOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
withCString path $ \cPath ->
@@ -508,7 +552,7 @@ statOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
-- | List current dir path.
-- This function will create a new handle to list entries.
--- An error will be returned if path doesn’t end with /.
+-- An error will be returned if path doesn't end with /.
listOpRaw :: Operator -> String -> IO (Either OpenDALError Lister)
listOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
withCString path $ \cPath ->
@@ -527,7 +571,7 @@ listOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
-- | List dir in flat way.
-- Also, this function can be used to list a prefix.
--- An error will be returned if given path doesn’t end with /.
+-- An error will be returned if given path doesn't end with /.
scanOpRaw :: Operator -> String -> IO (Either OpenDALError Lister)
scanOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
withCString path $ \cPath ->
@@ -544,6 +588,21 @@ scanOpRaw (Operator op) path = withForeignPtr op $ \opptr
->
errMsg <- peekCString (errorMessage ffiResult)
return $ Left $ OpenDALError code errMsg
+-- | Get operator info (scheme).
+operatorInfoRaw :: Operator -> IO (Either OpenDALError String)
+operatorInfoRaw (Operator op) = withForeignPtr op $ \opptr ->
+ alloca $ \ffiResultPtr -> do
+ c_operator_info opptr ffiResultPtr
+ ffiResult <- peek ffiResultPtr
+ if ffiCode ffiResult == 0
+ then do
+ val <- peek $ dataPtr ffiResult
+ Right <$> parseString val
+ else do
+ let code = parseErrorCode $ fromIntegral $ ffiCode ffiResult
+ errMsg <- peekCString (errorMessage ffiResult)
+ return $ Left $ OpenDALError code errMsg
+
-- | Get next entry path from `Lister`.
nextLister :: Lister -> IO (Either OpenDALError (Maybe String))
nextLister (Lister lister) = withForeignPtr lister $ \listerptr ->
@@ -558,3 +617,69 @@ nextLister (Lister lister) = withForeignPtr lister $
\listerptr ->
let code = parseErrorCode $ fromIntegral $ ffiCode ffiResult
errMsg <- peekCString (errorMessage ffiResult)
return $ Left $ OpenDALError code errMsg
+
+
+-- | Writes bytes into given writer.
+writerWrite :: Writer -> ByteString -> IO (Either OpenDALError ())
+writerWrite (Writer writer) byte = withForeignPtr writer $ \writerptr ->
+ BS.useAsCStringLen byte $ \(cByte, len) ->
+ alloca $ \ffiResultPtr -> do
+ c_writer_write writerptr cByte (fromIntegral len) ffiResultPtr
+ ffiResult <- peek ffiResultPtr
+ if ffiCode ffiResult == 0
+ then return $ Right ()
+ else do
+ let code = parseErrorCode $ fromIntegral $ ffiCode ffiResult
+ errMsg <- peekCString (errorMessage ffiResult)
+ return $ Left $ OpenDALError code errMsg
+
+-- | Closes given writer.
+writerClose :: Writer -> IO (Either OpenDALError Metadata)
+writerClose (Writer writer) = withForeignPtr writer $ \writerptr ->
+ alloca $ \ffiResultPtr -> do
+ c_writer_close writerptr ffiResultPtr
+ ffiResult <- peek ffiResultPtr
+ if ffiCode ffiResult == 0
+ then do
+ ffimatadata <- peek $ dataPtr ffiResult
+ metadata <- parseFFIMetadata ffimatadata
+ return $ Right metadata
+ else do
+ let code = parseErrorCode $ fromIntegral $ ffiCode ffiResult
+ errMsg <- peekCString (errorMessage ffiResult)
+ return $ Left $ OpenDALError code errMsg
+
+-- | Create a new writer for given path with specified options.
+writerOpRaw :: Operator -> String -> WriterOption -> IO (Either OpenDALError
Writer)
+writerOpRaw (Operator op) path writerOption = withForeignPtr op $ \opptr ->
+ withCString path $ \cPath ->
+ alloca $ \ffiResultPtr -> do
+ if woAppend writerOption
+ then c_blocking_writer_append opptr cPath ffiResultPtr
+ else c_blocking_writer opptr cPath ffiResultPtr
+ ffiResult <- peek ffiResultPtr
+ if ffiCode ffiResult == 0
+ then do
+ ffiwriter <- peek $ dataPtr ffiResult
+ writer <- Writer <$> newForeignPtr c_free_writer ffiwriter
+ return $ Right writer
+ else do
+ let code = parseErrorCode $ fromIntegral $ ffiCode ffiResult
+ errMsg <- peekCString (errorMessage ffiResult)
+ return $ Left $ OpenDALError code errMsg
+
+
+
+-- | Remove all files and directories recursively.
+removeAllOpRaw :: Operator -> String -> IO (Either OpenDALError ())
+removeAllOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
+ withCString path $ \cPath ->
+ alloca $ \ffiResultPtr -> do
+ c_blocking_remove_all opptr cPath ffiResultPtr
+ ffiResult <- peek ffiResultPtr
+ if ffiCode ffiResult == 0
+ then return $ Right ()
+ else do
+ let code = parseErrorCode $ fromIntegral $ ffiCode ffiResult
+ errMsg <- peekCString (errorMessage ffiResult)
+ return $ Left $ OpenDALError code errMsg
diff --git a/bindings/haskell/haskell-src/OpenDAL/FFI.hs
b/bindings/haskell/haskell-src/OpenDAL/FFI.hs
index ad28f451c..d52bf823c 100644
--- a/bindings/haskell/haskell-src/OpenDAL/FFI.hs
+++ b/bindings/haskell/haskell-src/OpenDAL/FFI.hs
@@ -25,6 +25,8 @@ data RawOperator
data RawLister
+data RawWriter
+
data FFIResult a = FFIResult
{ ffiCode :: CUInt,
dataPtr :: Ptr a,
@@ -161,4 +163,19 @@ foreign import ccall "blocking_scan" c_blocking_scan ::
Ptr RawOperator -> CStri
foreign import ccall "lister_next" c_lister_next :: Ptr RawLister -> Ptr
(FFIResult CString) -> IO ()
-foreign import ccall "&free_lister" c_free_lister :: FunPtr (Ptr RawLister ->
IO ())
\ No newline at end of file
+foreign import ccall "&free_lister" c_free_lister :: FunPtr (Ptr RawLister ->
IO ())
+
+
+foreign import ccall "operator_info" c_operator_info :: Ptr RawOperator -> Ptr
(FFIResult CString) -> IO ()
+
+foreign import ccall "blocking_writer" c_blocking_writer :: Ptr RawOperator ->
CString -> Ptr (FFIResult (Ptr RawWriter)) -> IO ()
+
+foreign import ccall "blocking_writer_append" c_blocking_writer_append :: Ptr
RawOperator -> CString -> Ptr (FFIResult (Ptr RawWriter)) -> IO ()
+
+foreign import ccall "writer_write" c_writer_write :: Ptr RawWriter -> Ptr
CChar -> CSize -> Ptr (FFIResult ()) -> IO ()
+
+foreign import ccall "writer_close" c_writer_close :: Ptr RawWriter -> Ptr
(FFIResult FFIMetadata) -> IO ()
+
+foreign import ccall "&free_writer" c_free_writer :: FunPtr (Ptr RawWriter ->
IO ())
+
+foreign import ccall "blocking_remove_all" c_blocking_remove_all :: Ptr
RawOperator -> CString -> Ptr (FFIResult ()) -> IO ()
\ No newline at end of file
diff --git a/bindings/haskell/opendal.cabal b/bindings/haskell/opendal.cabal
index 36736b188..56d136a15 100644
--- a/bindings/haskell/opendal.cabal
+++ b/bindings/haskell/opendal.cabal
@@ -75,7 +75,7 @@ test-suite opendal-test
import: base
type: exitcode-stdio-1.0
main-is: Spec.hs
- other-modules: BasicTest
+ other-modules: BasicTest, WriterTest, ErrorTest, PerformanceTest
hs-source-dirs: test
build-depends:
opendal,
diff --git a/bindings/haskell/src/lib.rs b/bindings/haskell/src/lib.rs
index b4ada218e..30d305f5f 100644
--- a/bindings/haskell/src/lib.rs
+++ b/bindings/haskell/src/lib.rs
@@ -21,6 +21,7 @@ mod types;
use std::collections::HashMap;
use std::ffi::CStr;
+use std::ffi::CString;
use std::mem;
use std::os::raw::c_char;
use std::str::FromStr;
@@ -612,3 +613,257 @@ pub unsafe extern "C" fn free_lister(lister: *mut
blocking::Lister) {
drop(Box::from_raw(lister));
}
}
+
+/// Get operator info (scheme)
+///
+/// # Safety
+///
+/// * `op` is a valid pointer to a `blocking::Operator`.
+/// * `result` is a valid pointer, and has available memory to write to
+///
+/// # Panics
+///
+/// * If `op` is not a valid pointer.
+/// * If `result` is not a valid pointer, or does not have available memory to
write to.
+#[no_mangle]
+pub unsafe extern "C" fn operator_info(
+ op: *mut od::blocking::Operator,
+ result: *mut FFIResult<*const c_char>,
+) {
+ let op = if op.is_null() {
+ *result = FFIResult::err("Operator is null");
+ return;
+ } else {
+ &mut *op
+ };
+
+ let info = op.info();
+ let scheme_str = info.scheme().to_string();
+
+ let res = match CString::new(scheme_str) {
+ Ok(c_string) => {
+ let ptr = c_string.into_raw() as *const c_char;
+ FFIResult::ok(ptr)
+ }
+ Err(_) => FFIResult::err("Failed to convert scheme to C string"),
+ };
+
+ *result = res;
+}
+
+/// Remove all files and directories recursively
+///
+/// # Safety
+///
+/// * `op` is a valid pointer to a `blocking::Operator`.
+/// * `path` is a valid pointer to a nul terminated string.
+/// * `result` is a valid pointer, and has available memory to write to
+///
+/// # Panics
+///
+/// * If `op` is not a valid pointer.
+/// * If `result` is not a valid pointer, or does not have available memory to
write to.
+#[no_mangle]
+pub unsafe extern "C" fn blocking_remove_all(
+ op: *mut od::blocking::Operator,
+ path: *const c_char,
+ result: *mut FFIResult<()>,
+) {
+ let op = if op.is_null() {
+ *result = FFIResult::err("Operator is null");
+ return;
+ } else {
+ &mut *op
+ };
+
+ let path_str = match CStr::from_ptr(path).to_str() {
+ Ok(s) => s,
+ Err(_) => {
+ *result = FFIResult::err("Failed to convert path to string");
+ return;
+ }
+ };
+
+ let res = match op.remove_all(path_str) {
+ Ok(()) => FFIResult::ok(()),
+ Err(e) => FFIResult::err_with_source("Failed to remove all", e),
+ };
+
+ *result = res;
+}
+
+/// Creates a blocking writer for the given path
+///
+/// # Safety
+///
+/// * `op` is a valid pointer to a `blocking::Operator`.
+/// * `path` is a valid pointer to a nul terminated string.
+/// * `result` is a valid pointer, and has available memory to write to
+///
+/// # Panics
+///
+/// * If `op` is not a valid pointer.
+/// * If `result` is not a valid pointer, or does not have available memory to
write to.
+#[no_mangle]
+pub unsafe extern "C" fn blocking_writer(
+ op: *mut od::blocking::Operator,
+ path: *const c_char,
+ result: *mut FFIResult<*mut blocking::Writer>,
+) {
+ let op = if op.is_null() {
+ *result = FFIResult::err("Operator is null");
+ return;
+ } else {
+ &mut *op
+ };
+
+ let path_str = match CStr::from_ptr(path).to_str() {
+ Ok(s) => s,
+ Err(_) => {
+ *result = FFIResult::err("Failed to convert path to string");
+ return;
+ }
+ };
+
+ let res = match op.writer(path_str) {
+ Ok(writer) => FFIResult::ok(Box::into_raw(Box::new(writer))),
+ Err(e) => FFIResult::err_with_source("Failed to create writer", e),
+ };
+
+ *result = res;
+}
+
+/// Creates a blocking writer for the given path with append mode
+///
+/// # Safety
+///
+/// * `op` is a valid pointer to a `blocking::Operator`.
+/// * `path` is a valid pointer to a nul terminated string.
+/// * `result` is a valid pointer, and has available memory to write to
+///
+/// # Panics
+///
+/// * If `op` is not a valid pointer.
+/// * If `result` is not a valid pointer, or does not have available memory to
write to.
+#[no_mangle]
+pub unsafe extern "C" fn blocking_writer_append(
+ op: *mut od::blocking::Operator,
+ path: *const c_char,
+ result: *mut FFIResult<*mut blocking::Writer>,
+) {
+ let op = if op.is_null() {
+ *result = FFIResult::err("Operator is null");
+ return;
+ } else {
+ &mut *op
+ };
+
+ let path_str = match CStr::from_ptr(path).to_str() {
+ Ok(s) => s,
+ Err(_) => {
+ *result = FFIResult::err("Failed to convert path to string");
+ return;
+ }
+ };
+
+ // Create writer with append option
+ let opts = od::options::WriteOptions {
+ append: true,
+ ..Default::default()
+ };
+
+ let res = match op.writer_options(path_str, opts) {
+ Ok(writer) => FFIResult::ok(Box::into_raw(Box::new(writer))),
+ Err(e) => FFIResult::err_with_source("Failed to create append writer",
e),
+ };
+
+ *result = res;
+}
+
+/// Write data using a blocking writer
+///
+/// # Safety
+///
+/// * `writer` is a valid pointer to a `blocking::Writer`.
+/// * `bytes` is a valid pointer to a byte array.
+/// * `len` is the length of `bytes`.
+/// * `result` is a valid pointer, and has available memory to write to
+///
+/// # Panics
+///
+/// * If `writer` is not a valid pointer.
+/// * If `bytes` is not a valid pointer, or `len` is more than the length of
`bytes`.
+/// * If `result` is not a valid pointer, or does not have available memory to
write to.
+#[no_mangle]
+pub unsafe extern "C" fn writer_write(
+ writer: *mut blocking::Writer,
+ bytes: *const c_char,
+ len: usize,
+ result: *mut FFIResult<()>,
+) {
+ let writer = if writer.is_null() {
+ *result = FFIResult::err("Writer is null");
+ return;
+ } else {
+ &mut *writer
+ };
+
+ let bytes = Vec::from_raw_parts(bytes as *mut u8, len, len);
+
+ let res = match writer.write(bytes.clone()) {
+ Ok(_) => FFIResult::ok(()),
+ Err(e) => FFIResult::err_with_source("Failed to write with writer", e),
+ };
+
+ *result = res;
+
+ // bytes memory is controlled by Haskell, we can't drop it here
+ mem::forget(bytes);
+}
+
+/// Close a blocking writer
+///
+/// # Safety
+///
+/// * `writer` is a valid pointer to a `blocking::Writer`.
+/// * `result` is a valid pointer, and has available memory to write to
+///
+/// # Panics
+///
+/// * If `writer` is not a valid pointer.
+/// * If `result` is not a valid pointer, or does not have available memory to
write to.
+#[no_mangle]
+pub unsafe extern "C" fn writer_close(
+ writer: *mut blocking::Writer,
+ result: *mut FFIResult<Metadata>,
+) {
+ let writer = if writer.is_null() {
+ *result = FFIResult::err("Writer is null");
+ return;
+ } else {
+ &mut *writer
+ };
+
+ let res = match writer.close() {
+ Ok(meta) => FFIResult::ok(meta.into()),
+ Err(e) => FFIResult::err_with_source("Failed to close writer", e),
+ };
+
+ *result = res;
+}
+
+/// Free a blocking writer
+///
+/// # Safety
+///
+/// * `writer` is a valid pointer to a `blocking::Writer`.
+///
+/// # Panics
+///
+/// * If `writer` is not a valid pointer.
+#[no_mangle]
+pub unsafe extern "C" fn free_writer(writer: *mut blocking::Writer) {
+ if !writer.is_null() {
+ drop(Box::from_raw(writer));
+ }
+}
diff --git a/bindings/haskell/test/BasicTest.hs
b/bindings/haskell/test/BasicTest.hs
index 6e0075f52..507577c6d 100644
--- a/bindings/haskell/test/BasicTest.hs
+++ b/bindings/haskell/test/BasicTest.hs
@@ -28,7 +28,14 @@ basicTests =
"Basic Tests"
[ testCase "testBasicOperation" testRawOperation,
testCase "testMonad" testMonad,
- testCase "testError" testError
+ testCase "testError" testError,
+ testCase "testWriter" testWriter,
+ testCase "testWriterAppend" testWriterAppend,
+ testCase "testAppendOperation" testAppendOperation,
+ testCase "testLister" testLister,
+ testCase "testCopyRename" testCopyRename,
+ testCase "testRemoveAll" testRemoveAll,
+ testCase "testOperatorInfo" testOperatorInfo
]
testRawOperation :: Assertion
@@ -98,6 +105,139 @@ testError = do
where
operation = readOp "non-exist-path"
+testWriter :: Assertion
+testWriter = do
+ Right op <- newOperator "memory"
+ Right writer <- writerOpRaw op "test-writer-file" defaultWriterOption
+ writerWrite writer "Hello" ?= Right ()
+ writerWrite writer " " ?= Right ()
+ writerWrite writer "World!" ?= Right ()
+ writerClose writer >>= \case
+ Right meta -> mContentLength meta @?= 12
+ Left err -> assertFailure $ "Failed to close writer: " ++ show err
+ readOpRaw op "test-writer-file" ?= Right "Hello World!"
+
+testWriterAppend :: Assertion
+testWriterAppend = do
+ Right op <- newOperator "memory"
+ -- First write some initial content
+ writeOpRaw op "append-file" "Initial content" ?= Right ()
+ -- Create append writer and add more content
+ result <- writerOpRaw op "append-file" appendWriterOption
+ case result of
+ Right writer -> do
+ writerWrite writer " appended" ?= Right ()
+ writerClose writer >>= \case
+ Right meta -> mContentLength meta @?= 24
+ Left err -> assertFailure $ "Failed to close append writer: " ++ show
err
+ readOpRaw op "append-file" ?= Right "Initial content appended"
+ Left err -> case errorCode err of
+ Unsupported -> putStrLn "Append writer not supported by memory backend -
skipping"
+ _ -> assertFailure $ "Failed to create append writer: " ++ show err
+
+testAppendOperation :: Assertion
+testAppendOperation = do
+ Right op <- newOperator "memory"
+ -- Write initial content
+ writeOpRaw op "append-test" "Hello" ?= Right ()
+ -- Demonstrate append using writer API
+ result <- writerOpRaw op "append-test" appendWriterOption
+ case result of
+ Right writer -> do
+ writerWrite writer " World" ?= Right ()
+ writerClose writer >>= \case
+ Right _ -> readOpRaw op "append-test" ?= Right "Hello World"
+ Left err -> assertFailure $ "Failed to close append writer: " ++ show
err
+ Left err -> case errorCode err of
+ Unsupported -> do
+ putStrLn "Append writer not supported by memory backend -
demonstrating manual append"
+ -- Manual append: read existing content, append new content, write back
+ Right existingContent <- readOpRaw op "append-test"
+ let newContent = existingContent <> " World"
+ writeOpRaw op "append-test" newContent ?= Right ()
+ readOpRaw op "append-test" ?= Right "Hello World"
+ _ -> assertFailure $ "Failed to create append writer: " ++ show err
+
+testLister :: Assertion
+testLister = do
+ Right op <- newOperator "memory"
+ -- Create some test files and directories
+ writeOpRaw op "dir1/file1.txt" "content1" ?= Right ()
+ writeOpRaw op "dir1/file2.txt" "content2" ?= Right ()
+ writeOpRaw op "dir1/subdir/file3.txt" "content3" ?= Right ()
+ createDirOpRaw op "dir1/empty-dir/" ?= Right ()
+
+ -- Test listing
+ Right lister <- listOpRaw op "dir1/"
+ files <- collectListerItems lister
+ length files @?= 4 -- file1.txt, file2.txt, subdir/, empty-dir/
+
+ -- Test scanning (recursive)
+ Right scanner <- scanOpRaw op "dir1/"
+ allFiles <- collectListerItems scanner
+ length allFiles @?= 4 -- All files including nested ones
+
+testCopyRename :: Assertion
+testCopyRename = do
+ Right op <- newOperator "memory"
+ -- Create source file
+ writeOpRaw op "source.txt" "test content" ?= Right ()
+ -- Test copy - handle case where operation is not supported
+ copyResult <- copyOpRaw op "source.txt" "copy.txt"
+ case copyResult of
+ Right () -> do
+ readOpRaw op "copy.txt" ?= Right "test content"
+ isExistOpRaw op "source.txt" ?= Right True
+ Left err -> case errorCode err of
+ Unsupported -> putStrLn "Copy operation not supported by memory backend
- skipping"
+ _ -> assertFailure $ "Unexpected error in copy: " ++ show err
+
+ -- Test rename - handle case where operation is not supported
+ renameResult <- renameOpRaw op "source.txt" "renamed.txt"
+ case renameResult of
+ Right () -> do
+ readOpRaw op "renamed.txt" ?= Right "test content"
+ isExistOpRaw op "source.txt" ?= Right False
+ Left err -> case errorCode err of
+ Unsupported -> putStrLn "Rename operation not supported by memory
backend - skipping"
+ _ -> assertFailure $ "Unexpected error in rename: " ++ show err
+
+testRemoveAll :: Assertion
+testRemoveAll = do
+ Right op <- newOperator "memory"
+ -- Create directory structure
+ writeOpRaw op "remove-test/file1.txt" "content1" ?= Right ()
+ writeOpRaw op "remove-test/subdir/file2.txt" "content2" ?= Right ()
+ createDirOpRaw op "remove-test/empty/" ?= Right ()
+
+ -- Verify structure exists
+ isExistOpRaw op "remove-test/file1.txt" ?= Right True
+ isExistOpRaw op "remove-test/subdir/file2.txt" ?= Right True
+
+ -- Remove all
+ removeAllOpRaw op "remove-test/" ?= Right ()
+
+ -- Verify everything is gone
+ isExistOpRaw op "remove-test/file1.txt" ?= Right False
+ isExistOpRaw op "remove-test/subdir/file2.txt" ?= Right False
+ isExistOpRaw op "remove-test/" ?= Right False
+
+testOperatorInfo :: Assertion
+testOperatorInfo = do
+ Right op <- newOperator "memory"
+ operatorInfoRaw op ?= Right "memory"
+
+-- Helper function to collect all items from a lister
+collectListerItems :: Lister -> IO [String]
+collectListerItems lister = go []
+ where
+ go acc = do
+ result <- nextLister lister
+ case result of
+ Right (Just item) -> go (item : acc)
+ Right Nothing -> return $ reverse acc
+ Left err -> assertFailure $ "Lister error: " ++ show err
+
-- helper function
(?=) :: (MonadIO m, Eq a, Show a) => m a -> a -> m ()
diff --git a/bindings/haskell/test/ErrorTest.hs
b/bindings/haskell/test/ErrorTest.hs
new file mode 100644
index 000000000..428b32c1a
--- /dev/null
+++ b/bindings/haskell/test/ErrorTest.hs
@@ -0,0 +1,116 @@
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+
+module ErrorTest (errorTests) where
+
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import OpenDAL
+import Test.Tasty
+import Test.Tasty.HUnit
+
+errorTests :: TestTree
+errorTests =
+ testGroup
+ "Error Handling Tests"
+ [ testCase "testReadNonExistentFile" testReadNonExistentFile,
+ testCase "testStatNonExistentFile" testStatNonExistentFile,
+ testCase "testDeleteNonExistentFile" testDeleteNonExistentFile,
+ testCase "testCopyNonExistentFile" testCopyNonExistentFile,
+ testCase "testRenameNonExistentFile" testRenameNonExistentFile,
+ testCase "testListNonExistentDir" testListNonExistentDir,
+ testCase "testInvalidOperatorConfig" testInvalidOperatorConfig,
+ testCase "testMonadErrorPropagation" testMonadErrorPropagation
+ ]
+
+testReadNonExistentFile :: Assertion
+testReadNonExistentFile = do
+ Right op <- newOperator "memory"
+ readOpRaw op "nonexistent-file.txt" >>= \case
+ Left err -> errorCode err @?= NotFound
+ Right _ -> assertFailure "Expected NotFound error"
+
+testStatNonExistentFile :: Assertion
+testStatNonExistentFile = do
+ Right op <- newOperator "memory"
+ statOpRaw op "nonexistent-file.txt" >>= \case
+ Left err -> errorCode err @?= NotFound
+ Right _ -> assertFailure "Expected NotFound error"
+
+testDeleteNonExistentFile :: Assertion
+testDeleteNonExistentFile = do
+ Right op <- newOperator "memory"
+ -- Deleting non-existent file should succeed (idempotent)
+ deleteOpRaw op "nonexistent-file.txt" ?= Right ()
+
+testCopyNonExistentFile :: Assertion
+testCopyNonExistentFile = do
+ Right op <- newOperator "memory"
+ copyOpRaw op "nonexistent-source.txt" "destination.txt" >>= \case
+ Left err -> case errorCode err of
+ NotFound -> return () -- Expected behavior
+ Unsupported -> putStrLn "Copy operation not supported by memory backend
- this is acceptable"
+ _ -> assertFailure $ "Expected NotFound or Unsupported error, got: " ++
show err
+ Right _ -> assertFailure "Expected error for copying non-existent file"
+
+testRenameNonExistentFile :: Assertion
+testRenameNonExistentFile = do
+ Right op <- newOperator "memory"
+ renameOpRaw op "nonexistent-source.txt" "destination.txt" >>= \case
+ Left err -> case errorCode err of
+ NotFound -> return () -- Expected behavior
+ Unsupported -> putStrLn "Rename operation not supported by memory
backend - this is acceptable"
+ _ -> assertFailure $ "Expected NotFound or Unsupported error, got: " ++
show err
+ Right _ -> assertFailure "Expected error for renaming non-existent file"
+
+testListNonExistentDir :: Assertion
+testListNonExistentDir = do
+ Right op <- newOperator "memory"
+ listOpRaw op "nonexistent-dir/" >>= \case
+ Left err -> case errorCode err of
+ NotFound -> return () -- Expected behavior
+ _ -> assertFailure $ "Expected NotFound error, got: " ++ show err
+ Right _ -> putStrLn "Listing non-existent directory succeeded (empty
result) - this is acceptable for memory backend"
+
+testInvalidOperatorConfig :: Assertion
+testInvalidOperatorConfig = do
+ -- Test with invalid scheme
+ newOperator "invalid-scheme-that-does-not-exist" >>= \case
+ Left err -> case errorCode err of
+ ConfigInvalid -> return () -- Expected behavior
+ Unsupported -> putStrLn "Invalid scheme returned Unsupported instead of
ConfigInvalid - this is acceptable"
+ _ -> assertFailure $ "Expected ConfigInvalid or Unsupported error, got:
" ++ show err
+ Right _ -> assertFailure "Expected error for invalid scheme"
+
+testMonadErrorPropagation :: Assertion
+testMonadErrorPropagation = do
+ Right op <- newOperator "memory"
+
+ -- Test error propagation in monad
+ runOp op errorOperation >>= \case
+ Left err -> errorCode err @?= NotFound
+ Right _ -> assertFailure "Expected error to propagate"
+
+ where
+ errorOperation = do
+ writeOp "test-file" "content"
+ _ <- readOp "nonexistent-file" -- This should fail
+ writeOp "should-not-reach" "content"
+
+-- helper function
+
+(?=) :: (MonadIO m, Eq a, Show a) => m a -> a -> m ()
+result ?= except = result >>= liftIO . (@?= except)
\ No newline at end of file
diff --git a/bindings/haskell/test/PerformanceTest.hs
b/bindings/haskell/test/PerformanceTest.hs
new file mode 100644
index 000000000..38ff59879
--- /dev/null
+++ b/bindings/haskell/test/PerformanceTest.hs
@@ -0,0 +1,151 @@
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+
+module PerformanceTest (performanceTests) where
+
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import qualified Data.ByteString.Char8 as BS8
+import Data.Time
+import OpenDAL
+import Test.Tasty
+import Test.Tasty.HUnit
+
+performanceTests :: TestTree
+performanceTests =
+ testGroup
+ "Performance Tests"
+ [ testCase "testBulkOperations" testBulkOperations,
+ testCase "testWriterVsDirectWrite" testWriterVsDirectWrite,
+ testCase "testLargeFileOperations" testLargeFileOperations,
+ testCase "testConcurrentOperations" testConcurrentOperations
+ ]
+
+testBulkOperations :: Assertion
+testBulkOperations = do
+ Right op <- newOperator "memory"
+
+ -- Test bulk write operations
+ start <- getCurrentTime
+ mapM_ (\i -> writeOpRaw op ("bulk-file-" ++ show i) (BS8.pack ("content-" ++
show i)) ?= Right ()) [1..100 :: Int]
+ writeEnd <- getCurrentTime
+
+ -- Test bulk read operations
+ mapM_ (\i -> readOpRaw op ("bulk-file-" ++ show i) ?= Right (BS8.pack
("content-" ++ show i))) [1..100 :: Int]
+ readEnd <- getCurrentTime
+
+ let writeTime = diffUTCTime writeEnd start
+ readTime = diffUTCTime readEnd writeEnd
+
+ -- Just verify operations completed (performance checks are informational)
+ putStrLn $ "Bulk write time: " ++ show writeTime
+ putStrLn $ "Bulk read time: " ++ show readTime
+
+ -- Verify correctness
+ readOpRaw op "bulk-file-50" ?= Right (BS8.pack "content-50")
+
+testWriterVsDirectWrite :: Assertion
+testWriterVsDirectWrite = do
+ Right op <- newOperator "memory"
+
+
+
+ -- Test writer approach
+ start1 <- getCurrentTime
+ Right writer <- writerOpRaw op "writer-test" defaultWriterOption
+ mapM_ (\_ -> writerWrite writer "chunk" ?= Right ()) [1..100 :: Int]
+ Right _ <- writerClose writer
+ end1 <- getCurrentTime
+
+ -- Test direct write approach
+ start2 <- getCurrentTime
+ let combinedData = BS8.concat $ Prelude.replicate 100 (BS8.pack "chunk")
+ writeOpRaw op "direct-test" combinedData ?= Right ()
+ end2 <- getCurrentTime
+
+ let writerTime = diffUTCTime end1 start1
+ directTime = diffUTCTime end2 start2
+
+ putStrLn $ "Writer approach time: " ++ show writerTime
+ putStrLn $ "Direct write time: " ++ show directTime
+
+ -- Verify both approaches produce same result
+ Right writerContent <- readOpRaw op "writer-test"
+ Right directContent <- readOpRaw op "direct-test"
+ writerContent @?= directContent
+
+testLargeFileOperations :: Assertion
+testLargeFileOperations = do
+ Right op <- newOperator "memory"
+
+ -- Create a 1MB file using writer
+ let chunkSize = 1024 -- 1KB chunks
+ numChunks = 1024 -- 1024 chunks = 1MB
+ chunk = BS8.replicate chunkSize 'X'
+
+ start <- getCurrentTime
+ Right writer <- writerOpRaw op "large-file" defaultWriterOption
+ mapM_ (\_ -> writerWrite writer chunk ?= Right ()) [1..numChunks]
+ Right meta <- writerClose writer
+ end <- getCurrentTime
+
+ let writeTime = diffUTCTime end start
+ putStrLn $ "Large file (1MB) write time: " ++ show writeTime
+
+ -- Verify file size
+ mContentLength meta @?= fromIntegral (chunkSize * numChunks)
+
+ -- Test reading the large file
+ start2 <- getCurrentTime
+ Right content <- readOpRaw op "large-file"
+ end2 <- getCurrentTime
+
+ let readTime = diffUTCTime end2 start2
+ putStrLn $ "Large file (1MB) read time: " ++ show readTime
+
+ -- Verify content correctness (just check size and first/last bytes)
+ BS8.length content @?= chunkSize * numChunks
+ BS8.head content @?= 'X'
+ BS8.last content @?= 'X'
+
+testConcurrentOperations :: Assertion
+testConcurrentOperations = do
+ Right op <- newOperator "memory"
+
+ -- Simulate concurrent operations by interleaving writes and reads
+ start <- getCurrentTime
+
+ -- Write some files
+ mapM_ (\i -> writeOpRaw op ("concurrent-" ++ show i) (BS8.pack ("data-" ++
show i)) ?= Right ()) [1..50 :: Int]
+
+ -- Read while writing more
+ mapM_ (\i -> do
+ writeOpRaw op ("concurrent-extra-" ++ show i) (BS8.pack ("extra-" ++ show
i)) ?= Right ()
+ readOpRaw op ("concurrent-" ++ show i) ?= Right (BS8.pack ("data-" ++ show
i))
+ ) [1..25 :: Int]
+
+ end <- getCurrentTime
+ let totalTime = diffUTCTime end start
+ putStrLn $ "Concurrent operations time: " ++ show totalTime
+
+ -- Verify some operations completed correctly
+ readOpRaw op "concurrent-10" ?= Right (BS8.pack "data-10")
+ readOpRaw op "concurrent-extra-10" ?= Right (BS8.pack "extra-10")
+
+-- helper function
+
+(?=) :: (MonadIO m, Eq a, Show a) => m a -> a -> m ()
+result ?= except = result >>= liftIO . (@?= except)
\ No newline at end of file
diff --git a/bindings/haskell/test/Spec.hs b/bindings/haskell/test/Spec.hs
index 763151e03..9e1f00c2f 100644
--- a/bindings/haskell/test/Spec.hs
+++ b/bindings/haskell/test/Spec.hs
@@ -16,6 +16,9 @@
-- under the License.
import BasicTest
+import WriterTest
+import ErrorTest
+import PerformanceTest
import Test.Tasty
import Test.Tasty.Ingredients.Basic (consoleTestReporter)
@@ -25,6 +28,8 @@ main =
[consoleTestReporter]
$ testGroup
"All Tests"
- [ basicTests
- -- Add other test groups here as needed
+ [ basicTests,
+ writerTests,
+ errorTests,
+ performanceTests
]
\ No newline at end of file
diff --git a/bindings/haskell/test/WriterTest.hs
b/bindings/haskell/test/WriterTest.hs
new file mode 100644
index 000000000..7df32b052
--- /dev/null
+++ b/bindings/haskell/test/WriterTest.hs
@@ -0,0 +1,153 @@
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+
+module WriterTest (writerTests) where
+
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.ByteString.Char8 as BS8
+import OpenDAL
+import Test.Tasty
+import Test.Tasty.HUnit
+
+writerTests :: TestTree
+writerTests =
+ testGroup
+ "Writer Tests"
+ [ testCase "testWriterSequentialWrites" testWriterSequentialWrites,
+ testCase "testWriterLargeData" testWriterLargeData,
+ testCase "testWriterEmptyData" testWriterEmptyData,
+ testCase "testWriterBinaryData" testWriterBinaryData,
+ testCase "testAppendToNonExistent" testAppendToNonExistent,
+ testCase "testAppendMultipleTimes" testAppendMultipleTimes,
+ testCase "testWriterErrorHandling" testWriterErrorHandling
+ ]
+
+testWriterSequentialWrites :: Assertion
+testWriterSequentialWrites = do
+ Right op <- newOperator "memory"
+ Right writer <- writerOpRaw op "sequential-test" defaultWriterOption
+
+ -- Write in multiple chunks
+ writerWrite writer "Line 1\n" ?= Right ()
+ writerWrite writer "Line 2\n" ?= Right ()
+ writerWrite writer "Line 3\n" ?= Right ()
+
+ Right meta <- writerClose writer
+ mContentLength meta @?= 21
+
+ -- Verify content
+ readOpRaw op "sequential-test" ?= Right "Line 1\nLine 2\nLine 3\n"
+
+testWriterLargeData :: Assertion
+testWriterLargeData = do
+ Right op <- newOperator "memory"
+ Right writer <- writerOpRaw op "large-data-test" defaultWriterOption
+
+ -- Write 1KB of data in chunks
+ let chunk = BS8.replicate 100 'A'
+ mapM_ (\_ -> writerWrite writer chunk ?= Right ()) [1..10 :: Int]
+
+ Right meta <- writerClose writer
+ mContentLength meta @?= 1000
+
+ -- Verify first few bytes
+ Right content <- readOpRaw op "large-data-test"
+ BS8.take 10 content @?= "AAAAAAAAAA"
+ BS8.length content @?= 1000
+
+testWriterEmptyData :: Assertion
+testWriterEmptyData = do
+ Right op <- newOperator "memory"
+ Right writer <- writerOpRaw op "empty-test" defaultWriterOption
+
+ -- Write empty data
+ writerWrite writer "" ?= Right ()
+
+ Right meta <- writerClose writer
+ mContentLength meta @?= 0
+
+ -- Verify content
+ readOpRaw op "empty-test" ?= Right ""
+
+testWriterBinaryData :: Assertion
+testWriterBinaryData = do
+ Right op <- newOperator "memory"
+ Right writer <- writerOpRaw op "binary-test" defaultWriterOption
+
+ -- Write binary data (all bytes 0-255)
+ let binaryData = BS8.pack ['\0'..'\255']
+ writerWrite writer binaryData ?= Right ()
+
+ Right meta <- writerClose writer
+ mContentLength meta @?= 256
+
+ -- Verify content
+ Right content <- readOpRaw op "binary-test"
+ content @?= binaryData
+
+testAppendToNonExistent :: Assertion
+testAppendToNonExistent = do
+ Right op <- newOperator "memory"
+
+ -- Verify file doesn't exist
+ isExistOpRaw op "new-append-file" ?= Right False
+
+ -- Write to non-existent file using writer API (should create it)
+ Right writer <- writerOpRaw op "new-append-file" defaultWriterOption
+ writerWrite writer "First content" ?= Right ()
+ writerClose writer >>= \case
+ Right _ -> return ()
+ Left err -> assertFailure $ "Failed to close writer: " ++ show err
+
+ -- Verify file was created
+ isExistOpRaw op "new-append-file" ?= Right True
+ readOpRaw op "new-append-file" ?= Right "First content"
+
+testAppendMultipleTimes :: Assertion
+testAppendMultipleTimes = do
+ Right op <- newOperator "memory"
+
+ -- Multiple write operations using writer API
+ Right writer <- writerOpRaw op "multi-append" defaultWriterOption
+ writerWrite writer "Hello" ?= Right ()
+ writerWrite writer " " ?= Right ()
+ writerWrite writer "World" ?= Right ()
+ writerWrite writer "!" ?= Right ()
+ writerClose writer >>= \case
+ Right _ -> return ()
+ Left err -> assertFailure $ "Failed to close writer: " ++ show err
+
+ -- Verify final content
+ readOpRaw op "multi-append" ?= Right "Hello World!"
+
+testWriterErrorHandling :: Assertion
+testWriterErrorHandling = do
+ Right op <- newOperator "memory"
+
+ -- Test writing to invalid path (should work with memory backend)
+ -- Memory backend is permissive, so let's test a more complex scenario
+ Right writer <- writerOpRaw op "test-file" defaultWriterOption
+ writerWrite writer "some data" ?= Right ()
+
+ -- Close writer successfully
+ Right meta <- writerClose writer
+ mContentLength meta @?= 9
+
+-- helper function
+
+(?=) :: (MonadIO m, Eq a, Show a) => m a -> a -> m ()
+result ?= except = result >>= liftIO . (@?= except)
\ No newline at end of file
