3

Happstackで作業するときはいつものように、ハンドラーに使用する独自のサーバーモナドを作成し、DBとセッション、およびいくつかのエラー処理をカバーしています。私は最近happstack-clientsession、大きな助けになり、自分のソリューションを書くのを妨げる-Packageを発見しました。

ClientSessionTモナドで自分自身に配線するのに少し問題がありますが。結局のところ、そのためのインスタンスはMonadReaderないMonadErrorので、ラッパーモナドでインスタンス化することはできません。

モジュールの完全なコードは次のとおりです。

{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, DeriveDataTypeable, EmptyDataDecls, TemplateHaskell #-}
module Server where

import Control.Monad
import Control.Monad.Error
import Control.Monad.Reader
import Control.Monad.Trans
import Data.Data (Data, Typeable)
import Data.SafeCopy (base, deriveSafeCopy)
import Database.MongoDB as M
import Happstack.Server
import Happstack.Server.Error
import Happstack.Server.ClientSession
import System.IO.Pool
import System.IO.Error
import Web.ClientSession (getDefaultKey)

type MongoPool e = Pool e Pipe

data PonySession = PonySession -- TODO: Fill in User type when available
    deriving (Ord, Read,Show, Eq, Typeable, Data)
$(deriveSafeCopy 0 'base ''PonySession)

instance ClientSession PonySession where
    empty = PonySession

newtype PonyServerPartT e m a = PonyServerPart (ClientSessionT PonySession (ReaderT (MongoPool IOError) (ServerPartT (ErrorT e m))) a)
    deriving (Monad, MonadIO, MonadReader (MongoPool e), MonadError e, ServerMonad, MonadPlus)

type PonyServerPart = PonyServerPartT IOError IO

runServerT s = mapServerPartT' (spUnwrapErrorT errorHandler) $ do
    key <- liftIO getDefaultKey
    let sessConf = (mkSessionConf key) { sessionCookieLife = MaxAge $ 60 * 60 * 24 * 7 }
    pool <- liftIO mongoPool
    runReaderT (runClientSessionT s sessConf) pool
    where errorHandler = simpleErrorHandler . show

mongoPool :: IO (MongoPool IOError)
mongoPool = newPool fac 10
    where fac = Factory {
            newResource = connect $ M.host "127.0.0.1",
            killResource = close,
            isExpired = isClosed
        }

私が得ているエラーは明らかです：からの派生MonadErrorとMonadReaderは機能しません。しかし、私はそれらが必要です。さもなければ、全体のパフォーマンスはちょっと役に立たないです。

私はこれらがどのように行われるのか（そしてそれに依存するのかderiving）を理解することができなかったので、この特定の問題をカバーし、それが一般的にどのように行われるのかを教えてくれる答えが欲しいです。

4

2 に答える 2

3

ClientSessionT理論的には、コンストラクターと 'unClientSessionT` 関数がエクスポートされていないためできないことを除いて、次のように記述します。

instance (Monad m, MonadError e m) => MonadError e (ClientSessionT st m) where
    throwError = ClientSessionT . throwError
    catchError (ClientSessionT m) f =
        ClientSessionT $ ReaderT $ \r -> StateT $ \s ->
          (runStateT (runReaderT m r) s) `catchError` (\e -> runStateT (runReaderT (unClientSessionT (f e)) r) s)

instance (Functor m, Monad m, MonadReader r m) => MonadReader r (ClientSessionT st m) where
    ask = ClientSessionT $ lift $ lift ask
    local f (ClientSessionT m) = ClientSessionT $ mapReaderT (mapStateT (local f)) m

これらのタイプのインスタンスを手動で記述するのはかなり機械的です。繰り返し発生するパターンがあります。（これが、ほとんどの場合、コンパイラが自動的にそれを行う方法を理解できる理由です）。

この場合、最善の解決策は、作成者に欠落しているインスタンスについて不平を言うことです。

darcs バージョンにはMonadError、 、MonadReader、およびさらに多くのものが含まれるようになりました。さらに、物事を少し壊す他のいくつかの変更がありますが、全体的に物事を改善します。

現在、デモ ディレクトリもあります。

http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-clientsession

私はおそらくそれをリリースし、いくつかのマイナーな変更と追加のコメントを 1 日か 2 日で行います。

于 2012-04-23T07:19:39.440 に答える
0

newtype派生メカニズムは、ClientSessionTが目的の型クラスのインスタンスを持つことを想定しています。またはClientSessionTのインスタンスがある場所にリンクしたハドックのドキュメントには表示されません。型クラスの制約 (たとえば for ) を追跡しても、 forまたは `MonadReaderのインスタンスは明らかになりません。MonadErrorMonadReaderHappstackMonadError

一般的なメカニズムはGHC User's Guide のセクション 7.5 に記載されています。アイデアは、型クラスとデータ型(つまり)CanBarkのインスタンスに対して、 newtype ラッパーがを検索して置換することにより、 に自動的にアクセスできるというものです。Doginstance CanBark Dog where ...DomesticDogDogCanBark DogDogDomesticDog

于 2012-04-22T10:57:04.230 に答える