caching - Haskellで複雑なIO処理と暗黙的なキャッシュを行うには?

Question

大規模なアプリケーションでは、IO キャッシング (Hibernate L1 および L2、Spring キャッシュなど) の複数のレイヤーが存在することが非常に多く、これらは通常抽象化されているため、特定の実装が IO を実行することを呼び出し側が認識する必要はありません。いくつかの注意事項 (スコープ、トランザクション) を使用すると、コンポーネント間のインターフェイスがより単純になります。

たとえば、コンポーネント A がデータベースにクエリを実行する必要がある場合、結果が既にキャッシュされているかどうかを知る必要はありません。A が何も知らない B または C によって取得された可能性がありますが、通常は何らかのセッションまたはトランザクションに参加します (多くの場合暗黙的に)。

フレームワークは、この呼び出しを、AOP などの手法を使用した単純なオブジェクトメソッド呼び出しと区別できないようにする傾向があります。

Haskell アプリケーションがこのような恩恵を受けることは可能ですか? クライアントのインターフェースはどのように見えますか?

score 6 · Accepted Answer

Haskell には、それぞれの責任を表すコンポーネントから計算を構成する多くの方法があります。これは、データ型と関数 ( http://www.haskellforall.com/2012/05/scrap-your-type-classes.html ) または型クラスを使用して、データレベルで実行できます。Haskell では、すべてのデータ型、型、関数、シグネチャ、クラスなどをインターフェイスとして表示できます。同じタイプのものがある限り、コンポーネントを互換性のあるものに置き換えることができます。

Haskell での計算について推論したい場合、a の抽象化を頻繁に使用しMonadます。AMonadは、計算を構築するためのインターフェイスです。基本計算はで構築できreturn、これらはで他の計算を生成する関数と一緒に構成できます>>=。モナドで表される計算に複数の責任を追加したい場合、モナド変換子を作成します。以下のコードには、階層化されたシステムのさまざまな側面を捉える 4 つの異なるモナド変換子があります。

DatabaseT sタイプのスキーマを持つデータベースを追加しますs。Operationデータベースにデータを格納したり、データベースからデータを取得したりして、データを処理します。スキーマのCacheT sdata をインターセプトし、メモリからデータを取得します (利用可能な場合)。 s を標準出力に記録しますsの結果を標準出力に記録しますOperationsOpperationLoggerTOperationResultLoggerTOperation

MonadOperation sこれら 4 つのコンポーネントは、と呼ばれる型クラス (インターフェイス) を使用して相互に通信しperformますOperation。

この同じ型クラスは、MonadOperation sシステムを使用するために必要なものを記述しています。インターフェイスを使用する誰かが、データベースとキャッシュが依存する型クラスの実装を提供する必要があります。このインターフェイスの一部である 2 つのデータ型もありOperationますCRUD。インターフェイスは、ドメインオブジェクトやデータベーススキーマについて何も知る必要がなく、それを実装するさまざまなモナドトランスフォーマーについても知る必要がないことに注意してください。モナド変換子はスキーマまたはドメインオブジェクトについて何も知らず、ドメインオブジェクトとサンプルコードはシステムを構築するモナド変換子について何も知りません。

サンプルコードが知っている唯一のことは、MonadOperation sその type によりa にアクセスできるということexample :: (MonadOperation TableName m) => m ()です。

プログラムmainは、2 つの異なるコンテキストで例を 2 回実行します。最初に、プログラムはデータベースと対話し、その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."})

2 回目の実行では、プログラムが受信した応答をログに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."})

これがソースコード全体です。これは 4 つの独立したコードと考える必要がありますexample。プログラム、談話の領域、およびそれを構築するさまざまなツールの完全なアセンブリであるアプリケーションmain。スキーマで終わる次の 2 つのセクションTableName、ブログ投稿のドメインを記述します。それらの唯一の目的は、他のコンポーネントがどのように連携するかを説明することであり、Haskell でデータ構造を設計する方法の例として役立つことではありません。次のセクションでは、コンポーネントがデータについて通信できる小さなインターフェイスについて説明します。それは必ずしも良いインターフェースではありません。最後に、ソースコードの残りの部分は、一緒に構成されてアプリケーションを形成するロガー、データベース、およびキャッシュを実装します。ツールとインターフェイスをドメインから分離するために、ここには typeable とダイナミクスに関するやや厄介なトリックがいくつかあります。

{-# 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ライブラリが必要です。

score 4 · Accepted Answer

Haskell では、IO を実行するものすべてに注意する必要があります (そして注意したいと思います!) 。

それはそれについての強いポイントの1つです。

MonadIO型クラスを使用して、IO アクションの実行が許可されている任意のモナドで機能する関数を作成できます。

myFunctionUsingIO :: (MonadIO m) => ... -> m someReturntype
myFunctionUsingIO = do
  -- some code
  liftIO $ ... -- some IO code
  -- some other code

Haskell の多くのプログラミングインターフェイスはモナドを介して表現されるため、このような関数はより多くのコンテキストで機能する可能性があります。

を使用unsafePerformIOして、純粋なコードから密かに IO アクションを実行することもできますが、ほとんどの場合、これはお勧めできません。純粋であるため、副作用が使用されているかどうかをすぐに確認できます。

IO キャッシングは副作用であり、タイプがそれを反映していれば十分です。

caching - Haskellで複雑なIO処理と暗黙的なキャッシュを行うには?

2 に答える 2

Related

Reference