Rum*_*mca 6 io aop caching haskell
在更大的应用程序中,通常有多层IO缓存(Hibernate L1和L2,Spring缓存等),这些层通常是抽象的,因此调用者不需要知道特定的实现是否有IO.通过一些警告(范围,事务),它允许组件之间更简单的接口.
例如,如果组件A需要查询数据库,则无需知道结果是否已缓存.它可能是由B或C检索的,A对此一无所知,但他们通常会参与某些会话或交易 - 通常是隐含的.
框架倾向于使用像AOP这样的技术使这个调用与简单的对象方法调用无法区分.
Haskell应用程序可以像这样受益吗？客户端的界面如何？
在Haskell中,有许多方法可以从代表其各自职责的组件组成计算.这可以在数据级别使用数据类型和函数(http://www.haskellforall.com/2012/05/scrap-your-type-classes.html)或使用类型类来完成.在Haskell中,您可以将每种数据类型,类型,函数,签名,类等视为一个接口; 只要你有其他相同类型的东西,你就可以用兼容的东西替换一个组件.
当我们想要推理Haskell中的计算时,我们经常使用a的抽象Monad.A Monad是用于构造计算的接口.可以构造基本计算,return并且这些可以与产生其他计算的函数一起组成>>=.当我们想要将多个职责添加到由monad表示的计算时,我们制作monad变换器.在下面的代码中,有四种不同的monad变换器可以捕获分层系统的不同方面:
DatabaseT s添加具有类型模式的数据库s.它Operation通过将数据存储在数据库中或从数据库中检索数据来处理数据.
CacheT s拦截Operation模式的s数据并从内存中检索数据(如果可用).
OpperationLoggerT将Operations ResultLoggerT的结果记录到标准输出
日志Operation到标准输出
这四种组分通信使用被称为一个类类型(接口)一起MonadOperation s,这需要实现它的组件,以提供一种方法perform的Operation,并返回其结果.
这个类型类描述了使用该MonadOperation s系统所需的内容.它要求使用该接口的人提供数据库和缓存将依赖的类型类的实现.此接口中还有两种数据类型,Operation和CRUD.请注意,接口不需要知道有关域对象或数据库模式的任何信息,也不需要知道将实现它的不同monad变换器.monad变换器对模式或域对象一无所知,域对象和示例代码对构建系统的monad变换器一无所知.
示例代码唯一知道的是它可以访问MonadOperation s由于其类型example :: (MonadOperation TableName m) => m ().
该程序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缓存,并在请求到达数据库之前记录请求.由于对程序透明的新缓存,读取文章的请求永远不会发生,但程序仍会收到响应:
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库.
| 归档时间： |
|
| 查看次数： |
668 次 |
| 最近记录： |