Fake conversion to monad-control
This commit is contained in:
parent
4ff6ba7726
commit
571ec80d16
@ -125,8 +125,8 @@ import Control.Failure (Failure (failure))
|
|||||||
|
|
||||||
import Text.Hamlet
|
import Text.Hamlet
|
||||||
|
|
||||||
import Control.Monad.IO.Peel (MonadPeelIO) -- FIXME monad-control
|
import Control.Monad.IO.Control (MonadControlIO)
|
||||||
import Control.Monad.Trans.Peel (MonadTransPeel (peel), liftPeel)
|
import Control.Monad.Trans.Control (MonadTransControl, liftControl, control)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.ByteString as S
|
import qualified Data.ByteString as S
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
@ -230,7 +230,7 @@ newtype GGHandler sub master m a =
|
|||||||
GHandler
|
GHandler
|
||||||
{ unGHandler :: GHInner sub master m a
|
{ unGHandler :: GHInner sub master m a
|
||||||
}
|
}
|
||||||
deriving (Functor, Applicative, Monad, MonadIO, MonadPeelIO)
|
deriving (Functor, Applicative, Monad, MonadIO, MonadControlIO)
|
||||||
|
|
||||||
instance MonadTrans (GGHandler s m) where
|
instance MonadTrans (GGHandler s m) where
|
||||||
lift = GHandler . lift . lift . lift . lift
|
lift = GHandler . lift . lift . lift . lift
|
||||||
@ -243,7 +243,7 @@ data GHState = GHState
|
|||||||
, ghsIdent :: Int
|
, ghsIdent :: Int
|
||||||
}
|
}
|
||||||
|
|
||||||
type GHInner s m monad =
|
type GHInner s m monad = -- FIXME collapse the stack
|
||||||
ReaderT (HandlerData s m) (
|
ReaderT (HandlerData s m) (
|
||||||
ErrorT HandlerContents (
|
ErrorT HandlerContents (
|
||||||
WriterT (Endo [Header]) (
|
WriterT (Endo [Header]) (
|
||||||
@ -742,14 +742,14 @@ newIdent = GHandler $ lift $ lift $ lift $ do
|
|||||||
liftIOHandler :: MonadIO mo
|
liftIOHandler :: MonadIO mo
|
||||||
=> GGHandler sub master IO a
|
=> GGHandler sub master IO a
|
||||||
-> GGHandler sub master mo a
|
-> GGHandler sub master mo a
|
||||||
liftIOHandler x = do
|
liftIOHandler x = error "FIXME liftIOHandler" {- do
|
||||||
k <- peel
|
k <- control
|
||||||
join $ liftIO $ k x
|
join $ liftIO $ k x -}
|
||||||
|
|
||||||
instance MonadTransPeel (GGHandler s m) where
|
instance MonadTransControl (GGHandler s m) where
|
||||||
peel = GHandler $ do
|
liftControl = error "FIXME liftControl for GGHandler" {-GHandler $ do
|
||||||
k <- liftPeel $ liftPeel $ liftPeel peel
|
k <- liftControl $ liftControl $ liftControl control
|
||||||
return $ liftM GHandler . k . unGHandler
|
return $ liftM GHandler . k . unGHandler -}
|
||||||
|
|
||||||
-- | Redirect to a POST resource.
|
-- | Redirect to a POST resource.
|
||||||
--
|
--
|
||||||
|
|||||||
@ -50,13 +50,13 @@ import Yesod.Internal
|
|||||||
import Control.Monad (liftM)
|
import Control.Monad (liftM)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
|
||||||
import Control.Monad.IO.Peel (MonadPeelIO)
|
import Control.Monad.IO.Control (MonadControlIO)
|
||||||
|
|
||||||
-- | A generic widget, allowing specification of both the subsite and master
|
-- | A generic widget, allowing specification of both the subsite and master
|
||||||
-- site datatypes. This is basically a large 'WriterT' stack keeping track of
|
-- site datatypes. This is basically a large 'WriterT' stack keeping track of
|
||||||
-- dependencies along with a 'StateT' to track unique identifiers.
|
-- dependencies along with a 'StateT' to track unique identifiers.
|
||||||
newtype GGWidget s m monad a = GWidget { unGWidget :: GWInner m monad a } -- FIXME remove s
|
newtype GGWidget s m monad a = GWidget { unGWidget :: GWInner m monad a } -- FIXME remove s
|
||||||
deriving (Functor, Applicative, Monad, MonadIO, MonadPeelIO)
|
deriving (Functor, Applicative, Monad, MonadIO, MonadControlIO)
|
||||||
|
|
||||||
instance MonadTrans (GGWidget s m) where
|
instance MonadTrans (GGWidget s m) where
|
||||||
lift = GWidget . lift
|
lift = GWidget . lift
|
||||||
|
|||||||
@ -43,7 +43,7 @@ library
|
|||||||
, old-locale >= 1.0.0.2 && < 1.1
|
, old-locale >= 1.0.0.2 && < 1.1
|
||||||
, failure >= 0.1 && < 0.2
|
, failure >= 0.1 && < 0.2
|
||||||
, containers >= 0.2 && < 0.5
|
, containers >= 0.2 && < 0.5
|
||||||
, monad-peel >= 0.1 && < 0.2
|
, monad-control >= 0.2 && < 0.3
|
||||||
, enumerator >= 0.4.7 && < 0.5
|
, enumerator >= 0.4.7 && < 0.5
|
||||||
, cookie >= 0.2 && < 0.3
|
, cookie >= 0.2 && < 0.3
|
||||||
, blaze-html >= 0.4 && < 0.5
|
, blaze-html >= 0.4 && < 0.5
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user