I18N changes; ToHandler
This commit is contained in:
parent
7b37439325
commit
ffec788bf7
@ -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]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user