使用Scala中的monad阅读器的程序体系结构

时间:2014-03-28 12:06:06

标签: scala dependency-injection monads monad-transformers

我正在尝试使用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"

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

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

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]
}

两种实现都是monadic,但它们所需的monadic行为可能有所不同。即数据库存储库依赖于它可以使用reader monad访问的连接,而内存存储库依赖于状态monad。

另一个组件是一个服务组件,它充当UI的逻辑入口点。

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

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

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

1 个答案:

答案 0 :(得分:1)

至少部分地回答我自己的问题。我在谷歌搜索了这个主题,并发现了一个免费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)中所述,可以编写多种语言。但直到现在,我还没有时间尝试这一点。