在较大的应用程序中，通常有多层IO缓存（Hibernate L1和L2、Spring缓存等），这些缓存通常是抽象的，因此调用方不需要意识到特定的实现会执行IO。有了一些注意事项（范围、事务），它允许组件之间更简单的接口。
例如，若组件A需要查询数据库，它不需要知道结果是否已经缓存。它可能是由A一无所知的B或C检索的，但他们通常会参与一些会话或事务——通常是隐含的。
框架倾向于使这种调用与使用AOP等技术的简单对象方法调用无法区分。
Haskell应用程序有可能从中受益吗？客户端的界面会是什么样子？
在Haskell中，有许多方法可以从表示其各自职责的组件组成计算。这可以通过数据类型和函数在数据级别完成(http://www.haskellforall.com/2012/05/scrap-your-type-classes.html)或者使用类型类。在Haskell中，您可以将每个数据类型、类型、函数、签名、类等视为一个接口；只要你有其他相同类型的东西，你就可以用兼容的东西替换一个组件。
当我们想在Haskell中推理计算时，我们经常使用Monad的抽象。Monad是用于构建计算的接口。基本计算可以用return构造，并且这些可以与用>>=产生其他计算的函数一起构成。当我们想将多个职责添加到由monad表示的计算中时，我们会制作monad转换器。在下面的代码中，有四个不同的monad转换器，它们捕获分层系统的不同方面：
CCD_ 5添加具有类型为s的模式的数据库。它通过在数据库中存储数据或从数据库中检索数据来处理数据Operation。CacheT s截取模式s的数据Operations，并从内存中检索数据（如果可用的话）。OpperationLoggerT将Operation记录到标准输出ResultLoggerT将Operation s的结果记录到标准输出
这四个组件使用一个名为MonadOperation s的类型类（接口）进行通信，这要求实现它的组件提供一种方法，即perform和Operation，并返回其结果。
这个相同类型的类描述了使用MonadOperation s系统所需的内容。它要求使用接口的人提供数据库和缓存所依赖的类型类的实现。还有两种数据类型是该接口的一部分，Operation和CRUD。请注意，接口不需要知道任何关于域对象或数据库模式的信息，也不需要知道将实现它的不同monad转换器。monad转换器不知道任何关于模式或域对象的信息，域对象和示例代码也不知道任何关于构建系统的monad转换器的信息。
示例代码唯一知道的是，由于example :: (MonadOperation TableName m) => m ()的类型，它将可以访问MonadOperation s。
程序main在两个不同的上下文中运行该示例两次。第一次，该程序与数据库对话，其Operations和响应被记录到标准输出。
Running example program once with an empty database
Operation Articles (Create (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."}))
ArticleId 0
Operation Articles (Read (ArticleId 0))
Just (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."})
Operation Articles (Read (ArticleId 0))
Just (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."})
第二次运行记录程序接收到的响应，通过缓存传递Operation s，并在请求到达数据库之前记录请求。由于新的缓存对程序是透明的，读取文章的请求从未发生，但程序仍然收到响应：
Running example program once with an empty cache and an empty database
Operation Articles (Create (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."}))
ArticleId 0
Just (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."})
Just (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."})
这是整个源代码。您应该将其视为四段独立的代码：一个为我们的域编写的程序，从example开始。一个应用程序，它是程序、话语领域和构建它的各种工具的完整集合，从main开始。接下来的两个部分，以模式TableName结尾，描述博客文章的域；它们的唯一目的是说明其他组件是如何结合在一起的，而不是作为如何在Haskell中设计数据结构的示例。下一节描述了一个小接口，组件可以通过该接口进行数据通信；它不一定是一个好的界面。最后，源代码的其余部分实现了记录器、数据库和缓存，它们组合在一起形成了应用程序。为了将工具和接口与域解耦，这里有一些关于可类型化和动态的可怕技巧，这也不是为了展示处理类型转换和泛型的好方法。
{-# LANGUAGE StandaloneDeriving, GADTs, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, KindSignatures, FunctionalDependencies, UndecidableInstances #-}
module Main (
main
) where
import Data.Typeable
import qualified Data.Map as Map
import Control.Monad.State
import Control.Monad.State.Class
import Control.Monad.Trans
import Data.Dynamic
-- Example
example :: (MonadOperation TableName m) => m ()
example =
do
id <- perform $ Operation Articles $ Create $ Article {
title = "My first article",
author = "Cirdec",
contents = "Lorem ipsum dolor sit amet."
}
perform $ Operation Articles $ Read id
perform $ Operation Articles $ Read id
cid <- perform $ Operation Comments $ Create $ Comment {
article = id,
user = "Cirdec",
comment = "Commenting on my own article!"
}
perform $ Operation Equality $ Create False
perform $ Operation Equality $ Create True
perform $ Operation Inequality $ Create True
perform $ Operation Inequality $ Create False
perform $ Operation Articles $ List
perform $ Operation Comments $ List
perform $ Operation Equality $ List
perform $ Operation Inequality $ List
return ()
-- Run the example twice, changing the cache transparently to the code
main :: IO ()
main = do
putStrLn "Running example program once with an empty database"
runDatabaseT (runOpperationLoggerT (runResultLoggerT example)) Types { types = Map.empty }
putStrLn "nRunning example program once with an empty cache and an empty database"
runDatabaseT (runOpperationLoggerT (runCacheT (runResultLoggerT example) Types { types = Map.empty })) Types { types = Map.empty }
return ()
-- Domain objects
data Article = Article {
title :: String,
author :: String,
contents :: String
}
deriving instance Eq Article
deriving instance Ord Article
deriving instance Show Article
deriving instance Typeable Article
newtype ArticleId = ArticleId Int
deriving instance Eq ArticleId
deriving instance Ord ArticleId
deriving instance Show ArticleId
deriving instance Typeable ArticleId
deriving instance Enum ArticleId
data Comment = Comment {
article :: ArticleId,
user :: String,
comment :: String
}
deriving instance Eq Comment
deriving instance Ord Comment
deriving instance Show Comment
deriving instance Typeable Comment
newtype CommentId = CommentId Int
deriving instance Eq CommentId
deriving instance Ord CommentId
deriving instance Show CommentId
deriving instance Typeable CommentId
deriving instance Enum CommentId
-- Database Schema
data TableName k v where
Articles :: TableName ArticleId Article
Comments :: TableName CommentId Comment
Equality :: TableName Bool Bool
Inequality :: TableName Bool Bool
deriving instance Eq (TableName k v)
deriving instance Ord (TableName k v)
deriving instance Show (TableName k v)
deriving instance Typeable2 TableName
-- Data interface (Persistance library types)
data CRUD k v r where
Create :: v -> CRUD k v k
Read :: k -> CRUD k v (Maybe v)
List :: CRUD k v [(k,v)]
Update :: k -> v -> CRUD k v (Maybe ())
Delete :: k -> CRUD k v (Maybe ())
deriving instance (Eq k, Eq v) => Eq (CRUD k v r)
deriving instance (Ord k, Ord v) => Ord (CRUD k v r)
deriving instance (Show k, Show v) => Show (CRUD k v r)
data Operation s t k v r where
Operation :: t ~ s k v => t -> CRUD k v r -> Operation s t k v r
deriving instance (Eq (s k v), Eq k, Eq v) => Eq (Operation s t k v r)
deriving instance (Ord (s k v), Ord k, Ord v) => Ord (Operation s t k v r)
deriving instance (Show (s k v), Show k, Show v) => Show (Operation s t k v r)
class (Monad m) => MonadOperation s m | m -> s where
perform :: (Typeable2 s, Typeable k, Typeable v, t ~ s k v, Show t, Ord v, Ord k, Enum k, Show k, Show v, Show r) => Operation s t k v r -> m r
-- Database implementation
data Tables t k v = Tables {
tables :: Map.Map String (Map.Map k v)
}
deriving instance Typeable3 Tables
emptyTablesFor :: Operation s t k v r -> Tables t k v
emptyTablesFor _ = Tables {tables = Map.empty}
data Types = Types {
types :: Map.Map TypeRep Dynamic
}
-- Database emulator
mapOperation :: (Enum k, Ord k, MonadState (Map.Map k v) m) => (CRUD k v r) -> m r
mapOperation (Create value) = do
current <- get
let id = case Map.null current of
True -> toEnum 0
_ -> succ maxId where
(maxId, _) = Map.findMax current
put (Map.insert id value current)
return id
mapOperation (Read key) = do
current <- get
return (Map.lookup key current)
mapOperation List = do
current <- get
return (Map.toList current)
mapOperation (Update key value) = do
current <- get
case (Map.member key current) of
True -> do
put (Map.update (_ -> Just value) key current)
return (Just ())
_ -> return Nothing
mapOperation (Delete key) = do
current <- get
case (Map.member key current) of
True -> do
put (Map.delete key current)
return (Just ())
_ -> return Nothing
tableOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, MonadState (Tables t k v) m) => Operation s t k v r -> m r
tableOperation (Operation tableName op) = do
current <- get
let currentTables = tables current
let tableKey = show tableName
let table = Map.findWithDefault (Map.empty) tableKey currentTables
let (result,newState) = runState (mapOperation op) table
put Tables { tables = Map.insert tableKey newState currentTables }
return result
typeOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, Typeable2 s, Typeable k, Typeable v, MonadState Types m) => Operation s t k v r -> m r
typeOperation op = do
current <- get
let currentTypes = types current
let empty = emptyTablesFor op
let typeKey = typeOf (empty)
let typeMap = fromDyn (Map.findWithDefault (toDyn empty) typeKey currentTypes) empty
let (result, newState) = runState (tableOperation op) typeMap
put Types { types = Map.insert typeKey (toDyn newState) currentTypes }
return result
-- Database monad transformer (clone of StateT)
newtype DatabaseT (s :: * -> * -> *) m a = DatabaseT {
databaseStateT :: StateT Types m a
}
runDatabaseT :: DatabaseT s m a -> Types -> m (a, Types)
runDatabaseT = runStateT . databaseStateT
instance (Monad m) => Monad (DatabaseT s m) where
return = DatabaseT . return
(DatabaseT m) >>= k = DatabaseT (m >>= x -> databaseStateT (k x))
instance MonadTrans (DatabaseT s) where
lift = DatabaseT . lift
instance (MonadIO m) => MonadIO (DatabaseT s m) where
liftIO = DatabaseT . liftIO
instance (Monad m) => MonadOperation s (DatabaseT s m) where
perform = DatabaseT . typeOperation
-- State monad transformer can preserve operations
instance (MonadOperation s m) => MonadOperation s (StateT state m) where
perform = lift . perform
-- Cache implementation (very similar to emulated database)
cacheMapOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, Show k, Show v, Typeable2 s, Typeable k, Typeable v, MonadState (Map.Map k v) m, MonadOperation s m) => Operation s t k v r -> m r
cacheMapOperation op@(Operation _ (Create value)) = do
key <- perform op
modify (Map.insert key value)
return key
cacheMapOperation op@(Operation _ (Read key)) = do
current <- get
case (Map.lookup key current) of
Just value -> return (Just value)
_ -> do
value <- perform op
modify (Map.update (_ -> value) key)
return value
cacheMapOperation op@(Operation _ (List)) = do
values <- perform op
modify (Map.union (Map.fromList values))
current <- get
return (Map.toList current)
cacheMapOperation op@(Operation _ (Update key value)) = do
successful <- perform op
modify (Map.update (_ -> (successful >>= (_ -> Just value))) key)
return successful
cacheMapOperation op@(Operation _ (Delete key)) = do
result <- perform op
modify (Map.delete key)
return result
cacheTableOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, Show k, Show v, Typeable2 s, Typeable k, Typeable v, MonadState (Tables t k v) m, MonadOperation s m) => Operation s t k v r -> m r
cacheTableOperation op@(Operation tableName _) = do
current <- get
let currentTables = tables current
let tableKey = show tableName
let table = Map.findWithDefault (Map.empty) tableKey currentTables
(result,newState) <- runStateT (cacheMapOperation op) table
put Tables { tables = Map.insert tableKey newState currentTables }
return result
cacheTypeOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, Show k, Show v, Typeable2 s, Typeable k, Typeable v, MonadState Types m, MonadOperation s m) => Operation s t k v r -> m r
cacheTypeOperation op = do
current <- get
let currentTypes = types current
let empty = emptyTablesFor op
let typeKey = typeOf (empty)
let typeMap = fromDyn (Map.findWithDefault (toDyn empty) typeKey currentTypes) empty
(result, newState) <- runStateT (cacheTableOperation op) typeMap
put Types { types = Map.insert typeKey (toDyn newState) currentTypes }
return result
-- Cache monad transformer
newtype CacheT (s :: * -> * -> *) m a = CacheT {
cacheStateT :: StateT Types m a
}
runCacheT :: CacheT s m a -> Types -> m (a, Types)
runCacheT = runStateT . cacheStateT
instance (Monad m) => Monad (CacheT s m) where
return = CacheT . return
(CacheT m) >>= k = CacheT (m >>= x -> cacheStateT (k x))
instance MonadTrans (CacheT s) where
lift = CacheT . lift
instance (MonadIO m) => MonadIO (CacheT s m) where
liftIO = CacheT . liftIO
instance (Monad m, MonadOperation s m) => MonadOperation s (CacheT s m) where
perform = CacheT . cacheTypeOperation
-- Logger monad transform
newtype OpperationLoggerT m a = OpperationLoggerT {
runOpperationLoggerT :: m a
}
instance (Monad m) => Monad (OpperationLoggerT m) where
return = OpperationLoggerT . return
(OpperationLoggerT m) >>= k = OpperationLoggerT (m >>= x -> runOpperationLoggerT (k x))
instance MonadTrans (OpperationLoggerT) where
lift = OpperationLoggerT
instance (MonadIO m) => MonadIO (OpperationLoggerT m) where
liftIO = OpperationLoggerT . liftIO
instance (MonadOperation s m, MonadIO m) => MonadOperation s (OpperationLoggerT m) where
perform op = do
liftIO $ putStrLn $ show op
lift (perform op)
-- Result logger
newtype ResultLoggerT m a = ResultLoggerT {
runResultLoggerT :: m a
}
instance (Monad m) => Monad (ResultLoggerT m) where
return = ResultLoggerT . return
(ResultLoggerT m) >>= k = ResultLoggerT (m >>= x -> runResultLoggerT (k x))
instance MonadTrans (ResultLoggerT) where
lift = ResultLoggerT
instance (MonadIO m) => MonadIO (ResultLoggerT m) where
liftIO = ResultLoggerT . liftIO
instance (MonadOperation s m, MonadIO m) => MonadOperation s (ResultLoggerT m) where
perform op = do
result <- lift (perform op)
liftIO $ putStrLn $ "t" ++ (show result)
return result
要构建此示例，您需要mtl和containers库。
在Haskell中，您do需要（并且希望！）了解任何执行IO的操作。
这是它的优点之一。
您可以使用MonadIO类型类来编写在任何允许执行IO操作的monad中工作的函数：
myFunctionUsingIO :: (MonadIO m) => ... -> m someReturntype
myFunctionUsingIO = do
-- some code
liftIO $ ... -- some IO code
-- some other code
由于Haskell中的许多编程接口都是通过monad表达的，所以像这样的函数可能在更多的上下文中工作。
您也可以使用unsafePerformIO从纯代码中秘密运行IO操作，但这在几乎所有情况下都是不可取的。纯粹可以让你立即看到是否使用了副作用。
IO缓存是一个副作用，如果你的类型反映了这一点，你就会很富裕。