I18N changes; ToHandler
This commit is contained in:
parent
7b37439325
commit
ffec788bf7
@ -22,6 +22,7 @@ module Web.Restful.Handler
|
|||||||
, Handler
|
, Handler
|
||||||
, runHandler
|
, runHandler
|
||||||
, liftIO
|
, liftIO
|
||||||
|
, ToHandler (..)
|
||||||
-- * Special handlers
|
-- * Special handlers
|
||||||
, redirect
|
, redirect
|
||||||
, notFound
|
, notFound
|
||||||
@ -49,6 +50,15 @@ newtype HandlerT m a =
|
|||||||
type HandlerIO = HandlerT IO
|
type HandlerIO = HandlerT IO
|
||||||
type Handler = HandlerIO Reps
|
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)
|
runHandler :: (ErrorResult -> Reps)
|
||||||
-> (ContentType -> B.ByteString -> IO B.ByteString)
|
-> (ContentType -> B.ByteString -> IO B.ByteString)
|
||||||
-> [ContentType]
|
-> [ContentType]
|
||||||
|
|||||||
@ -19,7 +19,8 @@ module Web.Restful.I18N
|
|||||||
( Language
|
( Language
|
||||||
, Translator
|
, Translator
|
||||||
, I18N (..)
|
, I18N (..)
|
||||||
, toTranslator
|
, translateBS
|
||||||
|
, NoI18N (..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as B
|
import qualified Data.ByteString.Lazy as B
|
||||||
@ -31,8 +32,6 @@ type Translator = [Language] -> B.ByteString
|
|||||||
|
|
||||||
class I18N a where
|
class I18N a where
|
||||||
translate :: a -> Translator
|
translate :: a -> Translator
|
||||||
|
|
||||||
instance I18NString a => I18N a where
|
|
||||||
translate a langs = toLazyByteString $ helper langs where
|
translate a langs = toLazyByteString $ helper langs where
|
||||||
helper [] = defTrans a
|
helper [] = defTrans a
|
||||||
helper (l:ls) =
|
helper (l:ls) =
|
||||||
@ -40,19 +39,24 @@ instance I18NString a => I18N a where
|
|||||||
Nothing -> helper ls
|
Nothing -> helper ls
|
||||||
Just s -> s
|
Just s -> s
|
||||||
|
|
||||||
class I18NString a where
|
|
||||||
defTrans :: a -> String
|
defTrans :: a -> String
|
||||||
tryTranslate :: a -> Language -> Maybe String
|
tryTranslate :: a -> Language -> Maybe String
|
||||||
|
|
||||||
toTranslator :: LazyByteString lbs => lbs -> Translator
|
instance I18N String where
|
||||||
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
|
defTrans = id
|
||||||
tryTranslate = const . Just
|
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
|
, module Web.Restful.I18N
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.ByteString.Class
|
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Object hiding (testSuite)
|
import Data.Object hiding (testSuite)
|
||||||
import Data.Object.Instances
|
import Data.Object.Instances
|
||||||
@ -105,14 +104,14 @@ response :: (Monad m, HasReps reps) => reps -> m Reps
|
|||||||
response = return . reps
|
response = return . reps
|
||||||
|
|
||||||
-- | Return a response with an arbitrary content type.
|
-- | Return a response with an arbitrary content type.
|
||||||
genResponse :: (Monad m, LazyByteString lbs)
|
genResponse :: (Monad m, NoI18N lbs)
|
||||||
=> ContentType
|
=> ContentType
|
||||||
-> lbs
|
-> lbs
|
||||||
-> m Reps
|
-> 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.
|
-- | 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"
|
htmlResponse = genResponse "text/html"
|
||||||
|
|
||||||
-- | Return a response from an Object.
|
-- | Return a response from an Object.
|
||||||
@ -124,9 +123,9 @@ instance HasReps () where
|
|||||||
reps _ = [("text/plain", translate "")]
|
reps _ = [("text/plain", translate "")]
|
||||||
instance HasReps RawObject where
|
instance HasReps RawObject where
|
||||||
reps o =
|
reps o =
|
||||||
[ ("text/html", translate $ unHtml $ safeFromObject o)
|
[ ("text/html", noTranslate $ unHtml $ safeFromObject o)
|
||||||
, ("application/json", translate $ unJson $ safeFromObject o)
|
, ("application/json", noTranslate $ unJson $ safeFromObject o)
|
||||||
, ("text/yaml", translate $ unYaml $ safeFromObject o)
|
, ("text/yaml", noTranslate $ unYaml $ safeFromObject o)
|
||||||
]
|
]
|
||||||
|
|
||||||
instance HasReps Reps where
|
instance HasReps Reps where
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user