在 Scala 中使用 monad reader 的程序架构

Question

我正在尝试使用 monad 阅读器在 Scala 中进行依赖注入。我最近开始学习 Scala，所以我在这里给出的代码无法编译，但我希望我的问题变得清晰。首先，假设我们的应用程序允许用户更改密码。首先，我创建一个简单的案例类 User 并在伴随对象上添加一个 changePassword 方法：

case class User (id:Int, username:String, password:String)

object User {
  def changePassword (oldPassword:String, newPassword:String, user:User) = {
    if (!user.password.equals(oldPassword)) {
      -\/("Old password incorrect")
    } else {
      \/-(user.copy(password = newPassword))
    }
  }
}

请注意，changePassword 方法的返回类型仍然有些具体。在 Haskell 中我会写：

data User = User {
    id       :: Int
  , username :: String
  , password :: String
} deriving (Show)

changePassword :: (MonadError String m) => String -> String -> User -> m User
changePassword old new user = 
  if password user == old
  then return $ user { password = new }
  else throwError "Old password incorrect"

这将允许在任何包含 Error monad 的 monad 转换器堆栈中使用 changePassword 函数。

现在，要创建应用程序，我们还需要另外两个组件。一个组件是知道如何检索和存储用户对象的存储库。可能存在多种实现。例如，我们可能有一个生产环境中的数据库存储库和一个用于测试目的的内存存储库。

trait UserRepository {
  def getById(id:Int):M[User]
  def save (user:User):M[Unit]
}

object DatabaseUserRepository extends UserRepository {
  def getById(id:Int):MonadReader[Connection,User]
  def save (user:User):MonadReader[Connection,Unit]
}  

object InMemoryUserRepository extends UserRepository {
  def getById(id:Int):MonadState[UserMap,User]
  def save (user:User):MonadState[UserMap,Unit]
}

两种实现都是一元的，但它们需要的一元行为可能不同。 IE。数据库存储库依赖于可以使用 reader monad 访问的连接，而内存存储库依赖于 state monad。

另一个组件是一个服务组件，它充当从 UI 到我们逻辑的入口点。

object UserService {
  def doChangePassword (id:Int, oldPassword:String, newPassword:String):MonadReader[UserRepository, Unit] 
}

此组件使用用户存储库通过给定的 id 检索用户，然后调用 changePassword 函数并使用存储库保存更新的用户对象。

我希望这能说明我试图实现的目标。但是，我仍然有点困惑如何将不同的部分连接在一起......

Answer 1

至少部分回答我自己的问题。我在 google 上搜索了这个主题，发现了 free monad 的概念：

http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html

读完之后，我想出了：

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where

import Control.Monad.Free
import Control.Monad.Error
import Control.Monad.Identity
import Control.Monad.State hiding (get) 
import qualified Control.Monad.State as MS
import Data.IntMap
import Prelude hiding (lookup)

data User = User {
    ident    :: Int
  , username :: String
  , password :: String
} deriving (Show, Eq, Ord)

changePassword' :: (MonadError String m) => String -> String -> User -> m User
changePassword' old new user = 
  if password user == old
  then return $ user { password = new }
  else throwError "Old password incorrect" 

type UserMap = IntMap User

data Interaction next = Save User next
              | Get Int (User -> next)
                      | ChangePassword String String User (User -> next)

instance Functor Interaction where
  fmap f (Save user next)                = Save user (f next)
  fmap f (Get id g)                      = Get id (f . g)
  fmap f (ChangePassword old new user g) = ChangePassword old new user (f . g)

type Program = Free Interaction

save :: User -> Program ()
save user = liftF (Save user ())

get :: Int -> Program User
get ident = liftF (Get ident id)

changePassword :: String -> String -> User -> Program User
changePassword old new user = liftF (ChangePassword old new user id)

doChangePassword :: String -> String -> Int -> Program ()
doChangePassword old new ident = get ident 
                             >>= changePassword old new 
                             >>= save

newtype ST a = ST { run :: StateT UserMap (ErrorT String Identity) a } deriving (Monad, MonadState UserMap, MonadError String)

runST :: ST a -> UserMap -> UserMap
runST (ST x) s = case runIdentity (runErrorT (execStateT x s)) of
  Left message -> error message
  Right state  -> state

interpreter :: Program r -> ST r
interpreter (Pure r) = return r
interpreter (Free (Save user next)) = do 
  modify (\map -> insert (ident user) user map)
  interpreter next
interpreter (Free (Get id g)) = do
  userMap <- MS.get
  case lookup id userMap of 
    Nothing   -> throwError "Unknown identifier"
    Just user -> interpreter (g user)
interpreter (Free (ChangePassword old new user g)) = do
  user' <- changePassword' old new user
  interpreter (g user')

main = (putStrLn . show) $ runST (interpreter p) (fromList [(1, User 1 "username" "secret")])
    where
        p = doChangePassword "secret" "new" 1

这里我们定义了一种由三个操作组成的小语言：Get、Save 和 ChangePassword。然后我们根据这 3 个操作来定义我们的函数：

doChangePassword :: String -> String -> Int -> Program ()
doChangePassword old new ident = get ident 
                             >>= changePassword old new 
                             >>= save

这个函数的结果只是一个描述我们需要执行的小程序的结构。为此，我们编写了一个小型解释器。通过提供不同的解释器来实现从数据库存储库到内存存储库的更改。

可以通过定义按点菜数据类型 (http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.101.4131&rep=rep1&type=pdf) 中所述的副产品来组合多种语言。但直到现在，我还没有时间尝试这个。