diff --git a/TODO b/TODO index e69de29b..45fb01e7 100644 --- a/TODO +++ b/TODO @@ -0,0 +1 @@ +HTML sitemap generation diff --git a/Web/Restful/Handler.hs b/Web/Restful/Handler.hs index ba0da8f7..980cfa0d 100644 --- a/Web/Restful/Handler.hs +++ b/Web/Restful/Handler.hs @@ -22,6 +22,7 @@ module Web.Restful.Handler , Handler , runHandler , liftIO + , ToHandler (..) -- * Special handlers , redirect , notFound @@ -49,6 +50,15 @@ newtype HandlerT m a = type HandlerIO = HandlerT IO type Handler = HandlerIO Reps +class ToHandler a where + toHandler :: a -> Handler + +instance (Request r, ToHandler h) => ToHandler (r -> h) where + toHandler f = parseRequest >>= toHandler . f + +instance ToHandler Handler where + toHandler = id + runHandler :: (ErrorResult -> Reps) -> (ContentType -> B.ByteString -> IO B.ByteString) -> [ContentType] diff --git a/Web/Restful/I18N.hs b/Web/Restful/I18N.hs index 945cf4d6..9743c8d1 100644 --- a/Web/Restful/I18N.hs +++ b/Web/Restful/I18N.hs @@ -19,7 +19,8 @@ module Web.Restful.I18N ( Language , Translator , I18N (..) - , toTranslator + , translateBS + , NoI18N (..) ) where import qualified Data.ByteString.Lazy as B @@ -31,8 +32,6 @@ 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) = @@ -40,19 +39,24 @@ instance I18NString a => I18N a where 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 +instance I18N String where defTrans = id tryTranslate = const . Just + +translateBS :: I18N a => a -> Translator +translateBS a = toLazyByteString . translate a + +class NoI18N a where + noTranslate :: a -> Translator + +instance NoI18N B.ByteString where + noTranslate = const + +instance NoI18N BS.ByteString where + noTranslate = const . toLazyByteString + +instance NoI18N String where + noTranslate = const . toLazyByteString diff --git a/Web/Restful/Response.hs b/Web/Restful/Response.hs index e56f84c4..07ad806d 100644 --- a/Web/Restful/Response.hs +++ b/Web/Restful/Response.hs @@ -37,7 +37,6 @@ module Web.Restful.Response , module Web.Restful.I18N ) where -import Data.ByteString.Class import Data.Time.Clock import Data.Object hiding (testSuite) import Data.Object.Instances @@ -105,14 +104,14 @@ response :: (Monad m, HasReps reps) => reps -> m Reps response = return . reps -- | Return a response with an arbitrary content type. -genResponse :: (Monad m, LazyByteString lbs) +genResponse :: (Monad m, NoI18N lbs) => ContentType -> lbs -> m Reps -genResponse ct lbs = return [(ct, toTranslator lbs)] +genResponse ct lbs = return [(ct, noTranslate lbs)] -- | Return a response with a text/html content type. -htmlResponse :: (Monad m, LazyByteString lbs) => lbs -> m Reps +htmlResponse :: (Monad m, NoI18N lbs) => lbs -> m Reps htmlResponse = genResponse "text/html" -- | Return a response from an Object. @@ -124,9 +123,9 @@ instance HasReps () where reps _ = [("text/plain", translate "")] instance HasReps RawObject where reps o = - [ ("text/html", translate $ unHtml $ safeFromObject o) - , ("application/json", translate $ unJson $ safeFromObject o) - , ("text/yaml", translate $ unYaml $ safeFromObject o) + [ ("text/html", noTranslate $ unHtml $ safeFromObject o) + , ("application/json", noTranslate $ unJson $ safeFromObject o) + , ("text/yaml", noTranslate $ unYaml $ safeFromObject o) ] instance HasReps Reps where