I18N and exception catching

TODO

@@ -1 +0,0 @@
-Catch exceptions and return as 500 errors

Web/Restful/Handler.hs

@@ -41,6 +41,7 @@ import Control.Applicative
 import Data.Maybe (fromJust)
 import qualified Data.ByteString.Lazy as B
 import qualified Hack
+import qualified Control.OldException
 
 ------ Handler monad
 newtype HandlerT m a =
@@ -55,7 +56,9 @@ runHandler :: (ErrorResult -> Reps)
             -> RawRequest
             -> IO Hack.Response
 runHandler eh wrapper ctypesAll (HandlerT inside) rr = do
-    (x, headers') <- inside rr
+    (x, headers') <- Control.OldException.catch
+                        (inside rr)
+                        (\e -> return (Left $ InternalError $ show e, []))
     let extraHeaders =
             case x of
                 Left r -> getHeaders r
@@ -67,14 +70,15 @@ runHandler eh wrapper ctypesAll (HandlerT inside) rr = do
                 Left r -> getStatus r
                 Right _ -> 200
     (ctype, selectedRep) <- chooseRep outReps ctypesAll
-    finalRep <- wrapper ctype selectedRep
+    let languages = [] -- FIXME
+    finalRep <- wrapper ctype $ selectedRep languages
     let headers'' = ("Content-Type", ctype) : headers
     return $! Hack.Response statusCode headers'' finalRep
 
 chooseRep :: Monad m
-          => [(ContentType, B.ByteString)]
+          => Reps
           -> [ContentType]
-          -> m (ContentType, B.ByteString)
+          -> m Rep
 chooseRep rs cs
   | null rs = fail "All reps must have at least one representation"
   | otherwise = do

Web/Restful/I18N.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+---------------------------------------------------------
+--
+-- Module        : Web.Restful.I18N
+-- Copyright     : Michael Snoyman
+-- License       : BSD3
+--
+-- Maintainer    : Michael Snoyman <michael@snoyman.com>
+-- Stability     : Stable
+-- Portability   : portable
+--
+-- Simple method for internationalization.
+--
+---------------------------------------------------------
+module Web.Restful.I18N
+    ( Language
+    , Translator
+    , I18N (..)
+    , toTranslator
+    ) where
+
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString as BS
+import Data.ByteString.Class
+
+type Language = String
+type Translator = [Language] -> B.ByteString
+
+class I18N a where
+    translate :: a -> Translator
+
+instance I18NString a => I18N a where
+    translate a langs = toLazyByteString $ helper langs where
+        helper [] = defTrans a
+        helper (l:ls) =
+            case tryTranslate a l of
+                Nothing -> helper ls
+                Just s -> s
+
+class I18NString a where
+    defTrans :: a -> String
+    tryTranslate :: a -> Language -> Maybe String
+
+toTranslator :: LazyByteString lbs => lbs -> Translator
+toTranslator = translate . toLazyByteString
+
+instance I18N B.ByteString where
+    translate = const
+
+instance I18N BS.ByteString where
+    translate bs _ = toLazyByteString bs
+
+instance I18NString String where
+    defTrans = id
+    tryTranslate = const . Just

Web/Restful/Response.hs

@@ -15,7 +15,8 @@
 ---------------------------------------------------------
 module Web.Restful.Response
     ( -- * Representations
-      Reps
+      Rep
+    , Reps
     , HasReps (..)
     , ContentType
       -- * Abnormal responses
@@ -32,21 +33,24 @@ module Web.Restful.Response
     , objectResponse
       -- * Tests
     , testSuite
+      -- * Re-export
+    , module Web.Restful.I18N
     ) where
 
 import Data.ByteString.Class
 import Data.Time.Clock
 import Data.Object hiding (testSuite)
-import qualified Data.ByteString.Lazy as B
 import Data.Object.Instances
 
 import Web.Encodings (formatW3)
+import Web.Restful.I18N
 
 import Test.Framework (testGroup, Test)
 
 type ContentType = String
 
-type Reps = [(ContentType, B.ByteString)]
+type Rep = (ContentType, Translator)
+type Reps = [Rep]
 
 -- | Something which can be represented as multiple content types.
 -- Each content type is called a representation of the data.
@@ -105,7 +109,7 @@ genResponse :: (Monad m, LazyByteString lbs)
             => ContentType
             -> lbs
             -> m Reps
-genResponse ct lbs = return [(ct, toLazyByteString lbs)]
+genResponse ct lbs = return [(ct, toTranslator lbs)]
 
 -- | Return a response with a text/html content type.
 htmlResponse :: (Monad m, LazyByteString lbs) => lbs -> m Reps
@@ -117,15 +121,15 @@ objectResponse = return . reps . toRawObject
 
 -- HasReps instances
 instance HasReps () where
-    reps _ = [("text/plain", toLazyByteString "")]
+    reps _ = [("text/plain", translate "")]
 instance HasReps RawObject where
     reps o =
-        [ ("text/html", unHtml $ safeFromObject o)
-        , ("application/json", unJson $ safeFromObject o)
-        , ("text/yaml", unYaml $ safeFromObject o)
+        [ ("text/html", translate $ unHtml $ safeFromObject o)
+        , ("application/json", translate $ unJson $ safeFromObject o)
+        , ("text/yaml", translate $ unYaml $ safeFromObject o)
         ]
 
-instance HasReps [(ContentType, B.ByteString)] where
+instance HasReps Reps where
     reps = id
 
 ----- Testing

Web/Restful/Response/AtomFeed.hs

@@ -21,7 +21,6 @@ import Web.Restful.Response
 
 import Data.Time.Clock
 import Web.Encodings
-import Data.ByteString.Class
 
 data AtomFeed = AtomFeed
     { atomTitle :: String
@@ -32,7 +31,7 @@ data AtomFeed = AtomFeed
     }
 instance HasReps AtomFeed where
     reps e =
-        [ ("application/atom+xml", toLazyByteString $ show e)
+        [ ("application/atom+xml", translate $ show e)
         ]
 
 data AtomFeedEntry = AtomFeedEntry

Web/Restful/Response/Sitemap.hs

@@ -24,7 +24,6 @@ import Web.Restful.Response
 import Web.Encodings
 import qualified Hack
 import Web.Restful.Request
-import Data.ByteString.Class
 import Data.Time (UTCTime)
 
 data SitemapLoc = AbsLoc String | RelLoc String
@@ -79,7 +78,7 @@ instance Show SitemapResponse where
 
 instance HasReps SitemapResponse where
     reps res =
-        [ ("text/xml", toLazyByteString $ show res)
+        [ ("text/xml", translate $ show res)
         ]
 
 sitemap :: IO [SitemapUrl] -> Handler

restful.cabal

@@ -1,5 +1,5 @@
 name:            restful
-version:         0.1.5
+version:         0.1.6
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -47,6 +47,7 @@ library
                      Web.Restful.Handler,
                      Web.Restful.Application,
                      Web.Restful.Resource,
+                     Web.Restful.I18N,
                      Data.Object.Instances,
                      Hack.Middleware.MethodOverride,
                      Web.Restful.Helpers.Auth,