Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Merged
merged 5 commits into from
Jun 15, 2023
Merged
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 7 additions & 0 deletions Cargo.lock

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions Cargo.toml
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ members = [
"bindings/python",
"bindings/ruby",
"bindings/java",
"bindings/haskell",

"bin/oli",
"bin/oay",
Expand Down
2 changes: 2 additions & 0 deletions bindings/haskell/.gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
dist-newstyle
.envrc
28 changes: 28 additions & 0 deletions bindings/haskell/Cargo.toml
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
# 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"
edition = "2021"

[lib]
crate-type = ["cdylib"]
doc = false

[dependencies]
opendal = { path = "../../core" }
silver-ymz marked this conversation as resolved.
Show resolved Hide resolved
34 changes: 34 additions & 0 deletions bindings/haskell/README.md
Original file line number Diff line number Diff line change
@@ -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
```
18 changes: 18 additions & 0 deletions bindings/haskell/cabal.project.local
Original file line number Diff line number Diff line change
@@ -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
87 changes: 87 additions & 0 deletions bindings/haskell/haskell-src/OpenDAL.hs
Original file line number Diff line number Diff line change
@@ -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
Xuanwo marked this conversation as resolved.
Show resolved Hide resolved

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
83 changes: 83 additions & 0 deletions bindings/haskell/haskell-src/OpenDAL/FFI.hs
Original file line number Diff line number Diff line change
@@ -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 ()
61 changes: 61 additions & 0 deletions bindings/haskell/opendal-hs.cabal
Original file line number Diff line number Diff line change
@@ -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
Loading