Question

我有一个MongoDB，其中一个集合user包含email上的唯一索引：

import Data.Bson        (Value (Int32))
import Database.MongoDB (Index (..), createIndex, (=:))

createIndex $ Index "user" [ "email" =: Int32 1 ] "email" True False

我编写了一个函数，如果新用户尚未使用，则会插入新用户，如果已经使用了电子邮件地址，则会失败：

import           Data.Bson        (Value (ObjId))
import           Database.MongoDB (Action, ObjectId, (=:))
import qualified Database.MongoDB as M (insert)

data User = User
  { email     :: Text
  , firstName :: Text
  , lastName  :: Text
  } deriving Show

data MongoEntity a = MongoEntity ObjectId a

createIfNotExists :: User
                  -> Action Handler (Either Text (MongoEntity User))
createIfNotExists (user@User {..}) = do
  value <- M.insert "user" [ "email" =: email
                           , "firstName" =: firstName
                           , "lastName" =: lastName
                           ]
  case value of
    ObjId objectId -> return (Right $ MongoEntity objectId user)
    _ -> return $ Left "no document"

我想检测M.insert抛出的任何错误（例如重复键）并返回错误Text消息。

由于M.insert在Action monad中运行，我认为如果失败则设置错误状态，但我无法弄清楚如何检索它。我认为我需要像

这样的东西

error <- getErrorStatus -- or whatever it is called

在value <- M.insert ...行之后，然后在case ... of表达式中测试错误。

顺便说一句，我尝试使用createIfNotExists撰写findAndModify，但我也无法捕获失败。

Answer 1

我从未使用过此模块，但阅读文档后，我能想到的最好的是：

更改createIfNotExists

的类型

createIfNotExists :: MonadIO m =>
                     User -> Action m (Either String (MongoEntity User))

使用catchJust中的Control.Exception.Base。作者似乎不鼓励使用Control.Monad.Error.Class。

main :: IO ()
main = do
  pipe <- connect (host "127.0.0.1")
  let user = User "jd@bar.baz" "John" "Doe"
  eitherEntity <- catchJust writeFailureErrorStr
                  (access pipe master "user" $ createIfNotExists user)
                  (return . Left)
  close pipe

writeFailureErrorStr  :: Failure -> Maybe String
writeFailureErrorStr (WriteFailure _err str) = Just str
writeFailureErrorStr _other = Nothing

您可能也想检查_err代码值，因为WriteFailure可能还有其他原因。

我对文档的理解是，无法处理IO中的错误。

我对这种做法感到困惑，我想我可能错了。如果有的话，请告诉我一个更优雅的方式。

更一般地说，我认为通过尝试和失败来检查存在并不是很好。我宁愿做一个查找请求，如果没有结果也要插入。

Answer 2

来自Jean-Baptiste Potonnier的回答，在阅读Michael Snoyman撰写的两篇文章（http://www.yesodweb.com/blog/2014/06/exceptions-transformers和https://www.fpcomplete.com/user/snoyberg/general-haskell/exceptions/exceptions-and-monad-transformers）之后，我将我的代码改写如下：

import           Control.Exception.Lifted (handleJust)
import           Data.Bson                (Value (ObjId))
import qualified Data.Bson                as B (Value)
import qualified Data.Text                as T (pack)
import           Database.MongoDB         (Action, Failure (..), (=:))
import qualified Database.MongoDB         as M (insert)

createIfNotExists :: User -> Action Handler (Either Failure (MongoEntity User))
createIfNotExists user =
  handleJust writeFailureHandler (return . Left) $ do
    value <- insertUser user
    return $
      case value of
        ObjId objectId -> Right $ MongoEntity (T.pack $ show objectId) user
        _ -> error "Unexpected missing document"

  where
    writeFailureHandler :: Failure -> Maybe Failure
    writeFailureHandler writeFailure@WriteFailure{} = Just writeFailure
    writeFailureHandler _ = Nothing

insertUser :: User -> Action Handler B.Value
insertUser User{..} =
  M.insert "users" [ "email" =: email
                   , "firstName" =: firstName
                   , "lastName" =: lastName
                   ]

使用lifted-base包。

从Haskell MongoDB驱动程序检索错误状态

2 个答案: