feat(bindings/haskell): support logging layer

.github/workflows/bindings_haskell.yml

@@ -43,10 +43,11 @@ jobs:
     runs-on: ubuntu-latest
     steps:
       - uses: actions/checkout@v3
-      - name: Setup Haskell toolchain
+      - name: Setup Haskell toolchain (ghc-9.2.8)
         run: |
-          sudo apt-get update
-          sudo apt-get install -y ghc cabal-install
+          curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
+          ghcup install ghc 9.2.8 --set
+          ghcup install cabal --set
           cabal update
       - name: Setup Rust toolchain
         uses: ./.github/actions/setup

.github/workflows/docs.yml

@@ -190,10 +190,11 @@ jobs:
     steps:
       - uses: actions/checkout@v3
 
-      - name: Setup Haskell toolchain
+      - name: Setup Haskell toolchain (ghc-9.2.8)
         run: |
-          sudo apt-get update
-          sudo apt-get install -y ghc cabal-install
+          curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
+          ghcup install ghc 9.2.8 --set
+          ghcup install cabal --set
           cabal update
 
       - name: Setup Rust toolchain

bindings/haskell/Cargo.toml

@@ -32,4 +32,5 @@ doc = false
 
 [dependencies]
 chrono = "0.4"
+log = { version = "0.4", features = ["std"] }
 opendal.workspace = true

bindings/haskell/README.md

@@ -4,20 +4,33 @@
 
 ## Example
 
+Basic usage
+
 ```haskell
 import OpenDAL
-import qualified Data.HashMap.Strict as HashMap
 
 main :: IO ()
 main = do
-  Right op <- operator "memory" HashMap.empty
+  Right op <- newOperator "memory"
   runOp op operation
- where
-  operation = do
-    writeOp op "key1" "value1"
-    writeOp op "key2" "value2"
-    value1 <- readOp op "key1"
-    value2 <- readOp op "key2"
+  where
+    operation = do
+      writeOp op "key1" "value1"
+      writeOp op "key2" "value2"
+      value1 <- readOp op "key1"
+      value2 <- readOp op "key2"
+```
+
+Use logger
+
+```haskell
+import OpenDAL
+import Colog (simpleMessageAction)
+
+main :: IO ()
+main = do
+  Right op <- newOperator "memory" {ocLogAction = Just simpleMessageAction}
+  return ()
 ```
 
 ## Build

bindings/haskell/haskell-src/OpenDAL.hs

@@ -16,61 +16,75 @@
 -- under the License.
 {-# LANGUAGE FlexibleInstances #-}
 
-{- |
-Module      : OpenDAL
-Description : Haskell bindings for OpenDAL
-Copyright   : (c) 2023 OpenDAL
-License     : Apache-2.0
-Maintainer  : OpenDAL Contributors <dev@opendal.apache.org>"
-Stability   : experimental
-Portability : non - portable (GHC extensions)
-
-This module provides Haskell bindings for OpenDAL.
--}
-module OpenDAL (
-  Operator,
-  Lister,
-  OpenDALError (..),
-  ErrorCode (..),
-  EntryMode (..),
-  Metadata (..),
-  OpMonad,
-  MonadOperation (..),
-  runOp,
-  newOp,
-  readOpRaw,
-  writeOpRaw,
-  isExistOpRaw,
-  createDirOpRaw,
-  copyOpRaw,
-  renameOpRaw,
-  deleteOpRaw,
-  statOpRaw,
-  listOpRaw,
-  scanOpRaw,
-  nextLister,
-) where
-
+-- |
+-- Module      : OpenDAL
+-- Description : Haskell bindings for OpenDAL
+-- Copyright   : (c) 2023 OpenDAL
+-- License     : Apache-2.0
+-- Maintainer  : OpenDAL Contributors <dev@opendal.apache.org>"
+-- Stability   : experimental
+-- Portability : non - portable (GHC extensions)
+--
+-- This module provides Haskell bindings for OpenDAL.
+module OpenDAL
+  ( OperatorConfig (..),
+    Operator,
+    Lister,
+    OpenDALError (..),
+    ErrorCode (..),
+    EntryMode (..),
+    Metadata (..),
+    OpMonad,
+    MonadOperation (..),
+    runOp,
+    newOperator,
+    readOpRaw,
+    writeOpRaw,
+    isExistOpRaw,
+    createDirOpRaw,
+    copyOpRaw,
+    renameOpRaw,
+    deleteOpRaw,
+    statOpRaw,
+    listOpRaw,
+    scanOpRaw,
+    nextLister,
+  )
+where
+
+import Colog (LogAction, Message, Msg (Msg), (<&))
 import Control.Monad.Except (ExceptT, runExceptT, throwError)
 import Control.Monad.Reader (ReaderT, ask, liftIO, runReaderT)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
+import Data.String (IsString (fromString))
+import Data.Text (pack)
 import Data.Time (UTCTime, parseTimeM, zonedTimeToUTC)
 import Data.Time.Format (defaultTimeLocale)
 import Foreign
 import Foreign.C.String
+import GHC.Stack (emptyCallStack)
 import OpenDAL.FFI
 
-{- | `Operator` is the entry for all public blocking APIs.
-Create an `Operator` with `newOp`.
--}
+-- | `OperatorConfig` is the configuration for an `Operator`. Currently, it contains the scheme, config and log action.
+-- Recommend using `OverloadedStrings` to construct a default config.
+data OperatorConfig = OperatorConfig
+  { ocScheme :: String,
+    ocConfig :: HashMap String String,
+    ocLogAction :: Maybe (LogAction IO Message)
+  }
+
+instance IsString OperatorConfig where
+  fromString s = OperatorConfig s HashMap.empty Nothing
+
+-- | `Operator` is the entry for all public blocking APIs.
+-- Create an `Operator` with `newOp`.
 newtype Operator = Operator (ForeignPtr RawOperator)
 
-{- | `Lister` is designed to list entries at given path in a blocking manner.
-Users can construct Lister by `listOp` or `scanOp`.
--}
+-- | `Lister` is designed to list entries at given path in a blocking manner.
+-- Users can construct Lister by `listOp` or `scanOp`.
 newtype Lister = Lister (ForeignPtr RawLister)
 
 -- | Represents the possible error codes that can be returned by OpenDAL.
@@ -101,10 +115,10 @@ data ErrorCode
 
 -- | Represents an error that can occur when using OpenDAL.
 data OpenDALError = OpenDALError
-  { errorCode :: ErrorCode
-  -- ^ The error code.
-  , message :: String
-  -- ^ The error message.
+  { -- | The error code.
+    errorCode :: ErrorCode,
+    -- | The error message.
+    message :: String
   }
   deriving (Eq, Show)
 
@@ -113,22 +127,22 @@ data EntryMode = File | Dir | Unknown deriving (Eq, Show)
 
 -- | Represents metadata for an entry in a storage system.
 data Metadata = Metadata
-  { mMode :: EntryMode
-  -- ^ The mode of the entry.
-  , mCacheControl :: Maybe String
-  -- ^ The cache control of the entry.
-  , mContentDisposition :: Maybe String
-  -- ^ The content disposition of the entry.
-  , mContentLength :: Integer
-  -- ^ The content length of the entry.
-  , mContentMD5 :: Maybe String
-  -- ^ The content MD5 of the entry.
-  , mContentType :: Maybe String
-  -- ^ The content type of the entry.
-  , mETag :: Maybe String
-  -- ^ The ETag of the entry.
-  , mLastModified :: Maybe UTCTime
-  -- ^ The last modified time of the entry.
+  { -- | The mode of the entry.
+    mMode :: EntryMode,
+    -- | The cache control of the entry.
+    mCacheControl :: Maybe String,
+    -- | The content disposition of the entry.
+    mContentDisposition :: Maybe String,
+    -- | The content length of the entry.
+    mContentLength :: Integer,
+    -- | The content MD5 of the entry.
+    mContentMD5 :: Maybe String,
+    -- | The content type of the entry.
+    mContentType :: Maybe String,
+    -- | The ETag of the entry.
+    mETag :: Maybe String,
+    -- | The last modified time of the entry.
+    mLastModified :: Maybe UTCTime
   }
   deriving (Eq, Show)
 
@@ -259,14 +273,14 @@ parseFFIMetadata (FFIMetadata mode cacheControl contentDisposition contentLength
   lastModified' <- (>>= parseTime) <$> parseCString lastModified
   return $
     Metadata
-      { mMode = mode'
-      , mCacheControl = cacheControl'
-      , mContentDisposition = contentDisposition'
-      , mContentLength = contentLength'
-      , mContentMD5 = contentMD5'
-      , mContentType = contentType'
-      , mETag = eTag'
-      , mLastModified = lastModified'
+      { mMode = mode',
+        mCacheControl = cacheControl',
+        mContentDisposition = contentDisposition',
+        mContentLength = contentLength',
+        mContentMD5 = contentMD5',
+        mContentType = contentType',
+        mETag = eTag',
+        mLastModified = lastModified'
       }
 
 -- Exported functions
@@ -276,8 +290,8 @@ runOp :: Operator -> OpMonad a -> IO (Either OpenDALError a)
 runOp operator op = runExceptT $ runReaderT op operator
 
 -- | Creates a new OpenDAL operator via `HashMap`.
-newOp :: String -> HashMap String String -> IO (Either OpenDALError Operator)
-newOp scheme hashMap = do
+newOperator :: OperatorConfig -> IO (Either OpenDALError Operator)
+newOperator (OperatorConfig scheme hashMap Nothing) = do
   let keysAndValues = HashMap.toList hashMap
   withCString scheme $ \cScheme ->
     withMany withCString (map fst keysAndValues) $ \cKeys ->
@@ -297,6 +311,31 @@ newOp scheme hashMap = do
                   let code = parseErrorCode $ fromIntegral $ ffiCode ffiResult
                   errMsg <- peekCString (errorMessage ffiResult)
                   return $ Left $ OpenDALError code errMsg
+newOperator (OperatorConfig scheme hashMap (Just logger)) = 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
+              logFnPtr <- wrapLogFn logFn
+              pokeArray cKeysPtr cKeys
+              pokeArray cValuesPtr cValues
+              c_via_map_with_logger_ffi cScheme cKeysPtr cValuesPtr (fromIntegral $ length keysAndValues) logFnPtr ffiResultPtr
+              ffiResult <- peek ffiResultPtr
+              if ffiCode ffiResult == 0
+                then do
+                  op <- Operator <$> newForeignPtr c_free_operator (dataPtr ffiResult)
+                  return $ Right op
+                else do
+                  let code = parseErrorCode $ fromIntegral $ ffiCode ffiResult
+                  errMsg <- peekCString (errorMessage ffiResult)
+                  return $ Left $ OpenDALError code errMsg
+  where
+    logFn enumSeverity cStr = do
+      str <- peekCString cStr
+      logger <& Msg (toEnum (fromIntegral enumSeverity)) emptyCallStack (pack str)
 
 -- Functions for performing raw OpenDAL operations are defined below.
 -- These functions are not meant to be used directly in most cases.
@@ -427,10 +466,9 @@ statOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
           errMsg <- peekCString (errorMessage ffiResult)
           return $ Left $ OpenDALError code errMsg
 
-{- | 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 /.
--}
+-- | 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 /.
 listOpRaw :: Operator -> String -> IO (Either OpenDALError Lister)
 listOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
   withCString path $ \cPath ->
@@ -447,10 +485,9 @@ listOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
           errMsg <- peekCString (errorMessage ffiResult)
           return $ Left $ OpenDALError code errMsg
 
-{- | 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 /.
--}
+-- | 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 /.
 scanOpRaw :: Operator -> String -> IO (Either OpenDALError Lister)
 scanOpRaw (Operator op) path = withForeignPtr op $ \opptr ->
   withCString path $ \cPath ->