feat(bindings/haskell): init haskell binding (#2463)

* feat(bindings/haskell): init haskell binding

Signed-off-by: silver-ymz <[email protected]>

* add license

Signed-off-by: silver-ymz <[email protected]>

* add safety explanation

Signed-off-by: silver-ymz <[email protected]>

* change Cargo.toml

Signed-off-by: silver-ymz <[email protected]>

* change Cargo.toml

Signed-off-by: silver-ymz <[email protected]>

---------

Signed-off-by: silver-ymz <[email protected]>

Cargo.toml

@@ -30,6 +30,7 @@ members = [
   "bindings/python",
   "bindings/ruby",
   "bindings/java",
+  "bindings/haskell",
 
   "bin/oli",
   "bin/oay",

bindings/haskell/.gitignore

@@ -0,0 +1,2 @@
+dist-newstyle
+.envrc

bindings/haskell/Cargo.toml

@@ -0,0 +1,34 @@
+# 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.
+
+[package]
+name = "opendal-hs"
+version = "0.1.0"
+
+authors.workspace = true
+edition.workspace = true
+homepage.workspace = true
+license.workspace = true
+repository.workspace = true
+rust-version.workspace = true
+
+[lib]
+crate-type = ["cdylib"]
+doc = false
+
+[dependencies]
+opendal.workspace = true

bindings/haskell/README.md

@@ -0,0 +1,34 @@
+# OpenDAL Haskell Binding (WIP)
+
+## Example
+
+```haskell
+import OpenDAL
+import qualified Data.HashMap.Strict as HashMap
+
+main :: IO ()
+main = do
+    Right op <- operator "memory" HashMap.empty
+    _ <- write op "key1" "value1"
+    _ <- write op "key2" "value2"
+    value1 <- read op "key1"
+    value2 <- read op "key2"
+    value1 @?= "value1"
+    value2 @?= "value2"
+```
+
+## Build
+
+1. Build OpenDAL Haskell Interface
+
+```bash
+cargo build --package opendal-hs
+```
+
+2. Build Haskell binding
+
+If you don't want to install `libopendal_hs`, you need to specify library path manually by `LIBRARY_PATH=${OPENDAL_ROOT}/target/debug`.
+
+```bash
+LIBRARY_PATH=... cabal build
+```

bindings/haskell/cabal.project.local

@@ -0,0 +1,18 @@
+-- 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.
+
+tests: True

bindings/haskell/haskell-src/OpenDAL.hs

@@ -0,0 +1,87 @@
+-- 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 OpenDAL (
+  Operator,
+  createOp,
+  readOp,
+  writeOp,
+) where
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import Foreign
+import Foreign.C.String
+import OpenDAL.FFI
+
+newtype Operator = Operator (Ptr RawOperator)
+
+byteSliceToByteString :: ByteSlice -> IO ByteString
+byteSliceToByteString (ByteSlice bsDataPtr len) = BS.packCStringLen (bsDataPtr, fromIntegral len)
+
+-- | Create a new Operator.
+createOp :: String -> HashMap String String -> IO (Either String Operator)
+createOp scheme hashMap = do
+  let keysAndValues = HashMap.toList hashMap
+  withCString scheme $ \cScheme ->
+    withMany withCString (map fst keysAndValues) $ \cKeys ->
+      withMany withCString (map snd keysAndValues) $ \cValues ->
+        allocaArray (length keysAndValues) $ \cKeysPtr ->
+          allocaArray (length keysAndValues) $ \cValuesPtr ->
+            alloca $ \ffiResultPtr -> do
+              pokeArray cKeysPtr cKeys
+              pokeArray cValuesPtr cValues
+              c_via_map_ffi cScheme cKeysPtr cValuesPtr (fromIntegral $ length keysAndValues) ffiResultPtr
+              ffiResult <- peek ffiResultPtr
+              if success ffiResult
+                then do
+                  let op = Operator (castPtr $ dataPtr ffiResult)
+                  return $ Right op
+                else do
+                  errMsg <- peekCString (errorMessage ffiResult)
+                  return $ Left errMsg
+
+readOp :: Operator -> String -> IO (Either String ByteString)
+readOp (Operator op) path = (flip ($)) op $ \opptr ->
+  withCString path $ \cPath ->
+    alloca $ \ffiResultPtr -> do
+      c_blocking_read opptr cPath ffiResultPtr
+      ffiResult <- peek ffiResultPtr
+      if success ffiResult
+        then do
+          byteslice <- peek (castPtr $ dataPtr ffiResult)
+          byte <- byteSliceToByteString byteslice
+          c_free_byteslice (bsData byteslice) (bsLen byteslice)
+          return $ Right byte
+        else do
+          errMsg <- peekCString (errorMessage ffiResult)
+          return $ Left errMsg
+
+writeOp :: Operator -> String -> ByteString -> IO (Either String ())
+writeOp (Operator op) path byte = (flip ($)) op $ \opptr ->
+  withCString path $ \cPath ->
+    BS.useAsCStringLen byte $ \(cByte, len) ->
+      alloca $ \ffiResultPtr -> do
+        c_blocking_write opptr cPath cByte (fromIntegral len) ffiResultPtr
+        ffiResult <- peek ffiResultPtr
+        if success ffiResult
+          then return $ Right ()
+          else do
+            errMsg <- peekCString (errorMessage ffiResult)
+            return $ Left errMsg

bindings/haskell/haskell-src/OpenDAL/FFI.hs

@@ -0,0 +1,83 @@
+-- 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.
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module OpenDAL.FFI where
+
+import Foreign
+import Foreign.C.String
+import Foreign.C.Types
+
+data RawOperator
+
+data FFIResult = FFIResult
+  { success :: Bool
+  , dataPtr :: Ptr ()
+  , errorMessage :: CString
+  }
+  deriving (Show)
+
+instance Storable FFIResult where
+  sizeOf _ = sizeOf (undefined :: CSize) + sizeOf (undefined :: Ptr ()) + sizeOf (undefined :: CString)
+  alignment _ = alignment (undefined :: CIntPtr)
+  peek ptr = do
+    s <- ((/= (0 :: CSize)) <$> peekByteOff ptr successOffset)
+    d <- peekByteOff ptr dataPtrOffset
+    errMsg <- peekByteOff ptr errorMessageOffset
+    return $ FFIResult s d errMsg
+   where
+    successOffset = 0
+    dataPtrOffset = sizeOf (undefined :: CSize)
+    errorMessageOffset = dataPtrOffset + sizeOf (undefined :: Ptr ())
+  poke ptr (FFIResult s d errMsg) = do
+    pokeByteOff ptr successOffset (fromBool s :: CSize)
+    pokeByteOff ptr dataPtrOffset d
+    pokeByteOff ptr errorMessageOffset errMsg
+   where
+    successOffset = 0
+    dataPtrOffset = sizeOf (undefined :: CSize)
+    errorMessageOffset = dataPtrOffset + sizeOf (undefined :: Ptr ())
+
+data ByteSlice = ByteSlice
+  { bsData :: Ptr CChar
+  , bsLen :: CSize
+  }
+
+instance Storable ByteSlice where
+  sizeOf _ = sizeOf (undefined :: Ptr CChar) + sizeOf (undefined :: CSize)
+  alignment _ = alignment (undefined :: Ptr CChar)
+  peek ptr = do
+    bsDataPtr <- peekByteOff ptr dataOffset
+    len <- peekByteOff ptr lenOffset
+    return $ ByteSlice bsDataPtr len
+   where
+    dataOffset = 0
+    lenOffset = sizeOf (undefined :: Ptr ())
+  poke ptr (ByteSlice bsDataPtr len) = do
+    pokeByteOff ptr dataOffset bsDataPtr
+    pokeByteOff ptr lenOffset len
+   where
+    dataOffset = 0
+    lenOffset = sizeOf (undefined :: Ptr ())
+
+foreign import ccall "via_map_ffi"
+  c_via_map_ffi ::
+    CString -> Ptr CString -> Ptr CString -> CSize -> Ptr FFIResult -> IO ()
+foreign import ccall "&free_operator" c_free_operator :: FunPtr (Ptr RawOperator -> IO ())
+foreign import ccall "free_byteslice" c_free_byteslice :: Ptr CChar -> CSize -> IO ()
+foreign import ccall "blocking_read" c_blocking_read :: Ptr RawOperator -> CString -> Ptr FFIResult -> IO ()
+foreign import ccall "blocking_write" c_blocking_write :: Ptr RawOperator -> CString -> Ptr CChar -> CSize -> Ptr FFIResult -> IO ()

bindings/haskell/opendal-hs.cabal

@@ -0,0 +1,61 @@
+cabal-version:      2.0
+
+-- 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.
+
+name:               opendal-hs
+version:            0.1.0.0
+license:            Apache-2.0
+synopsis:           OpenDAL Haskell Binding
+description:
+    OpenDAL Haskell Binding. Open Data Access Layer: Access data freely, painlessly, and efficiently
+
+category:           Storage, Binding
+build-type:         Simple
+
+source-repository head
+    type:     git
+    location: https://github.com/apache/incubator-opendal
+
+library
+    exposed-modules:
+        OpenDAL
+    other-modules:
+        OpenDAL.FFI
+    hs-source-dirs:   haskell-src
+    default-language: Haskell2010
+    extra-libraries:  opendal_hs
+    ghc-options:      -Wall
+    build-depends:    
+        base >=4.10.0.0 && <5,
+        unordered-containers >=0.2.0.0, 
+        bytestring >=0.11.0.0
+
+test-suite opendal-hs-test
+    type:             exitcode-stdio-1.0
+    main-is:          Spec.hs
+    other-modules:    BasicTest
+    hs-source-dirs:   test
+    default-language: Haskell2010
+    other-extensions: OverloadedStrings
+    ghc-options:      -Wall
+    build-depends:    
+        base,
+        unordered-containers,
+        opendal-hs,
+        tasty,
+        tasty-hunit