將MonadReader/MonadError實例添加到Transformer類型

正如我在使用Happstack時通常那樣，我一直在使用自己的服務器monad用於處理程序，用於覆蓋我的數據庫和會話以及一些錯誤處理。我最近發現了happstack-clientsession-Package是一個很大的幫助，並且阻止我編寫自己的解決方案。將MonadReader/MonadError實例添加到Transformer類型

雖然在我自己的ClientSessionT monad中有一點麻煩。事實證明，它沒有MonadReader或MonadError實例，所以我不能在我的包裝monad中將它們實例化。

這裏是模塊的全碼：

{-# 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），我想要一個涵蓋這個特定問題的答案，並告訴我它是如何完成的。

來源

2012-04-22 Lanbo

從理論上講，你會寫這樣的事情，但你不能因爲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，以及更多。再加上一些其他的改變，會讓事情變得更糟糕，但是讓事情變得更好。

還有現在demo目錄：

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

我可能會釋放出來，用一些小的改動，並在一兩天更多的評論。

來源

2012-04-23 07:19:39 stepcut

newtype推導機制期望ClientSessionT具有所需類型類的實例。我沒有看到你鏈接到的012d的實例爲MonadError或MonadReader的haddock文檔中。追逐類型等級約束（例如對於Happstack）也不會顯示MonadError或MonadReader的實例。

一般機制記錄在section 7.5 of the GHC User's Guide。我們的想法是，對於一個類型的類CanBark和數據類型Dog（即instance CanBark Dog where ...）的實例，一個NEWTYPE包裝DomesticDog周圍Dog可以自動具有由訪問CanBark Dog與DomesticDog搜索和替換Dog。

來源

2012-04-22 10:57:04

我知道爲什麼會發生這種錯誤，我在我的問題中已經說過。我的實際問題是如何爲這個特定的monad類型添加這些實例。 – Lanbo 2012-04-22 11:11:15

將MonadReader/MonadError實例添加到Transformer類型

回答

相關問題