2012-04-22 2 views
3

通常、Happstackを使用するときに、ハンドラに使用する自分のサーバーのモナドを作成しています。私は最近、happstack-clientsession -Packageを発見しました。これは大きな助けとなり、私自身の解決策を書くのを妨げています。MonadReader/MonadErrorインスタンスをTransformer型に追加する

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 
     } 

私は取得していますエラーは明白です:MonadErrorMonadReaderから導出は動作しません。しかし、私はそれらを必要とするでしょう、そうでなければ全体のパフォーマンスは役に立たないです。

これはどのように行われたのか分かりませんでしたので(derivingに依存しています)、この特定の問題をカバーする回答をお願いしたいと思います。

答えて

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

私はおそらくいくつかのマイナーな変更で、それを解放し、一日か二日でのコメントます。

0

導出機構は、ClientSessionTが望ましいタイプのクラスのインスタンスを持つことを前提としています。 ClientSessionTMonadErrorまたはMonadReaderのインスタンスがある場所にリンクしたhaddockのドキュメントには表示されません。型クラス制約(例えば、Happstackの場合)を追跡すると、MonadErrorまたは `MonadReader 'のインスタンスも表示されません。

一般的なメカニズムはsection 7.5 of the GHC User's Guideに記載されています。アイデアは、型クラスCanBarkとデータ型Dog(即ちinstance CanBark Dog where ...)のために、例えばDog周りのnewtypeラッパーDomesticDogを自動的に検索と置換DomesticDogDogをすることによってCanBark Dogへのアクセスを有することができることです。理論的には

+0

私はこのエラーが発生する理由について知っています、私は私の質問でそう言いました。私の実際の質問は、この特定のモナドタイプのインスタンスを追加する方法です。 – Lanbo

関連する問題