Question

以下函数是Yesod REST服务器的一部分，它通过电子邮件地址在MongoDB数据库中搜索现有用户并返回Maybe User：

{-# LANGUAGE DeriveGeneric #-}

module Model.User where

import           Database.MongoDB (Action, findOne, select, (=:))
import qualified Database.MongoDB as M
import           GHC.Generics     (Generic)
import           Import

data User = User
  { userEmail     :: Text
  , userFirstName :: Text
  , userLastName  :: Text
  } deriving (Generic, Show)

collection :: Text
collection = "users"

instance FromJSON User
instance ToJSON User

findForEmail :: Text -> Action IO (Maybe User)
findForEmail email = do
  maybeDocument <- findOne (select [ "email" =: email ] collection)
  case maybeDocument of
    Just document -> do
      email' <- M.lookup "email" document
      firstName <- M.lookup "firstName" document
      lastName <- M.lookup "lastName" document
      return $ Just $ User email' firstName lastName
    Nothing       -> return Nothing

涉及两个＆＃34;嵌套＆＃34;的部分monads（maybeDocument <-）感觉非常啰嗦＆＃34;。 findOne返回Maybe Document，lookup返回Maybe v。

这可以缩短，也许可以使用申请人吗？

更新

我把它简化为：

maybeDocument <- findOne (select [ "email" =: email ] collection)
case maybeDocument of
  Just document ->
    return $ User <$> M.lookup "email" document
                  <*> M.lookup "firstName" document
                  <*> M.lookup "lastName" document
  Nothing       -> return Nothing

但它仍然感觉很沉重。有没有办法将maybeDocument <- monad和lookup s组合在一起？

Answer 1

case上的{p> Maybe，Just映射到另一个Maybe，Nothing立即映射到Nothing，与使用一个return相同monadic bind。（当然你需要保持

   maybeDocument <- findOne (select [ "email" =: email ] collection)
   return $ maybeDocument >>= \document ->
             User <$> M.lookup "email" document
                  <*> M.lookup "firstName" document
                  <*> M.lookup "lastName" document

，这里的行为是错误的monad。）

maybeDocument

此外，return变量有点尴尬，我们可以消除这一点：请注意，因为结果只是Action IO加入do monad，所以你不要这样做。真的需要一个Functor块：你只是fmap (>>= \document -> User <$> M.lookup "email" document <*> M.lookup "firstName" document <*> M.lookup "lastName" document ) $ findOne (select [ "email" =: email ] collection) - 映射结果！这可以很好地完成无点：

      findOne (select [ "email" =: email ] collection)  <&>  (>>=
         \document -> User <$> M.lookup "email" document
                           <*> M.lookup "firstName" document
                           <*> M.lookup "lastName" document  )

如果我们能够保留原始的评估顺序，你可能会认为这看起来会更好一些。我们可以使用（非标准）reverse apply operator

{{1}}

当然，这使得很难掌握每个操作员正在做什么，但我认为IMO在这种简洁的代码中非常清楚。

改进冗长的Haskell Monadic代码

1 个答案: