Switched some code to MonadAttempt

Web/Restful/Handler.hs

@@ -36,6 +36,7 @@ import Web.Restful.Request
 import Web.Restful.Response
 
 import Control.Monad.Trans
+import Control.Monad.Attempt.Class
 import Control.Monad (liftM, ap)
 import Control.Applicative
 
@@ -131,6 +132,9 @@ instance Monad m => MonadRequestReader (HandlerT m) where
         errorResult $ InvalidArgs [(name ++ " (" ++ show ptype ++ ")", msg)]
     authRequired = errorResult PermissionDenied
 
+instance Monad m => MonadAttempt (HandlerT m) where
+    failure = errorResult . InternalError . show
+
 ------ Special handlers
 errorResult :: Monad m => ErrorResult -> HandlerT m a
 errorResult er = HandlerT (const $ return (Left er, []))

Web/Restful/Helpers/Auth.hs

@@ -31,8 +31,10 @@ import Web.Restful.Constants
 
 import Control.Applicative ((<$>), Applicative (..))
 import Control.Monad.Reader
+import Control.Monad.Attempt
 
 import Data.Maybe (fromMaybe)
+import Data.Attempt
 
 data AuthResource =
     Check
@@ -104,21 +106,21 @@ authOpenidForward = do
     let complete = "http://" ++ Hack.serverName env ++ ":" ++
                    show (Hack.serverPort env) ++
                    "/auth/openid/complete/"
-    res <- liftIO $ OpenId.getForwardUrl oid complete
+    res <- runAttemptT $ OpenId.getForwardUrl oid complete
     case res of
-        Left err -> redirect $ "/auth/openid/?message="
-                            ++ encodeUrl (err :: String)
-        Right url -> redirect url
+        Failure err -> redirect $ "/auth/openid/?message="
+                            ++ encodeUrl (show err)
+        Success url -> redirect url
 
 authOpenidComplete :: Handler
 authOpenidComplete = do
     gets' <- rawGetParams <$> askRawRequest
     dest <- cookieParam "DEST"
-    res <- liftIO $ OpenId.authenticate gets'
+    res <- runAttemptT $ OpenId.authenticate gets'
     case res of
-      Left err -> redirect $ "/auth/openid/?message="
-                          ++ encodeUrl (err :: String)
-      Right (OpenId.Identifier ident) -> do
+      Failure err -> redirect $ "/auth/openid/?message="
+                            ++ encodeUrl (show err)
+      Success (OpenId.Identifier ident) -> do
         deleteCookie "DEST"
         header authCookieName ident
         redirect $ fromMaybe "/" dest
@@ -148,7 +150,7 @@ rpxnowLogin apiKey = do
                 Just "" -> "/"
                 Just ('#':rest) -> rest
                 Just s -> s
-    ident <- join $ liftIO $ Rpxnow.authenticate apiKey token
+    ident <- Rpxnow.authenticate apiKey token
     header authCookieName $ Rpxnow.identifier ident
     redirect dest
 

Web/Restful/Request.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE OverlappingInstances #-}
 ---------------------------------------------------------
 --
@@ -50,7 +49,6 @@ module Web.Restful.Request
 
 import qualified Hack
 import Data.Function.Predicate (equals)
-import Control.Monad.Error ()
 import Web.Restful.Constants
 import Web.Restful.Utils
 import Control.Applicative (Applicative (..))
@@ -275,9 +273,17 @@ instance Parameter a => Parameter (Maybe a) where
                            " values, expecting 0 or 1"
 
 instance Parameter a => Parameter [a] where
-    readParams = mapM readParam
+    readParams = mapM' readParam where
+        mapM' f = sequence' . map f
+        sequence' :: [Either String v] -> Either String [v]
+        sequence' [] = Right []
+        sequence' (Left l:_) = Left l
+        sequence' (Right r:rest) =
+            case sequence' rest of
+                Left l -> Left l
+                Right rest' -> Right $ r : rest'
 
-instance Parameter String where
+instance Parameter [Char] where
     readParam = Right . paramValue
 
 instance Parameter Int where

restful.cabal

@@ -1,5 +1,5 @@
 name:            restful
-version:         0.1.8
+version:         0.1.9
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -22,13 +22,12 @@ library
                      hack-handler-cgi >= 0.0.2,
                      hack >= 2009.5.19,
                      split >= 0.1.1,
-                     authenticate >= 0.0.1,
+                     authenticate >= 0.2.0,
                      data-default >= 0.2,
                      predicates >= 0.1,
                      bytestring >= 0.9.1.4,
                      bytestring-class,
                      web-encodings >= 0.0.1,
-                     mtl >= 1.1.0.2,
                      data-object >= 0.2.0,
                      yaml >= 0.2.0,
                      test-framework,
@@ -37,7 +36,10 @@ library
                      HUnit,
                      QuickCheck == 1.*,
                      enumerable >= 0.0.3,
-                     directory >= 1
+                     directory >= 1,
+                     transformers >= 0.1.4.0,
+                     monads-fd >= 0.0.0.1,
+                     attempt
     exposed-modules: Web.Restful,
                      Web.Restful.Constants,
                      Web.Restful.Request,