Better error handling for invalid arguments

TODO

@@ -1 +0,0 @@
-Better error handling for invalid arguments (currently 500 error)

Web/Restful/Application.hs

@@ -71,6 +71,11 @@ class ResourceName a b => RestfulApp a b | a -> b where
         HasRepsW $ toObject $ "Redirect to: " ++ url
     errorHandler _ _ (InternalError e) =
         HasRepsW $ toObject $ "Internal server error: " ++ e
+    errorHandler _ _ (InvalidArgs ia) =
+        HasRepsW $ toObject $
+            [ ("errorMsg", toObject "Invalid arguments")
+            , ("messages", toObject ia)
+            ]
 
 -- | Given a sample resource name (purely for typing reasons), generating
 -- a Hack application.

Web/Restful/Request.hs

@@ -109,7 +109,7 @@ tryReadParams:: Parameter a
 tryReadParams name params =
     case readParams params of
         Left s -> do
-            tell [name ++ ": " ++ s]
+            tell [(name, s)]
             return $
               error $
                 "Trying to evaluate nonpresent parameter " ++
@@ -185,16 +185,15 @@ requestPath = do
                 q' -> q'
     return $! Hack.pathInfo env ++ q
 
-type RequestParser a = WriterT [ParamError] (Reader RawRequest) a
+type RequestParser a = WriterT [(ParamName, ParamError)] (Reader RawRequest) a
-instance Applicative (WriterT [ParamError] (Reader RawRequest)) where
+instance Applicative (WriterT [(ParamName, ParamError)] (Reader RawRequest)) where
     pure = return
-    f <*> a = do
+    (<*>) = ap
-        f' <- f
-        a' <- a
-        return $! f' a'
 
 -- | Parse a request into either the desired 'Request' or a list of errors.
-runRequestParser :: RequestParser a -> RawRequest -> Either [ParamError] a
+runRequestParser :: RequestParser a
+                 -> RawRequest
+                 -> Either [(ParamName, ParamError)] a
 runRequestParser p req =
     let (val, errors) = (runReader (runWriterT p)) req
      in case errors of

Web/Restful/Response.hs

@@ -73,11 +73,13 @@ data ErrorResult =
     Redirect String
     | NotFound
     | InternalError String
+    | InvalidArgs [(String, String)]
 
 getStatus :: ErrorResult -> Int
 getStatus (Redirect _) = 303
 getStatus NotFound = 404
 getStatus (InternalError _) = 500
+getStatus (InvalidArgs _) = 400
 
 getHeaders :: ErrorResult -> [Header]
 getHeaders (Redirect s) = [Header "Location" s]
@@ -228,5 +230,5 @@ getRequest = ResponseT $ \rr -> return (helper rr, []) where
            -> Either ErrorResult r
     helper rr =
         case runRequestParser parseRequest rr of
-            Left errors -> Left $ InternalError $ unlines errors -- FIXME better error output
+            Left errors -> Left $ InvalidArgs errors -- FIXME better error output
             Right r -> Right r