Content is now strict to fix memory bug
This commit is contained in:
parent
decdd8c9e2
commit
0a0e7e8f8a
2
.gitignore
vendored
2
.gitignore
vendored
@ -1,4 +1,2 @@
|
|||||||
dist
|
dist
|
||||||
*.swp
|
*.swp
|
||||||
*.hi
|
|
||||||
*.o
|
|
||||||
|
|||||||
@ -20,6 +20,7 @@ module Web.Restful
|
|||||||
, module Web.Restful.Definitions
|
, module Web.Restful.Definitions
|
||||||
, module Web.Restful.Handler
|
, module Web.Restful.Handler
|
||||||
, module Web.Restful.Resource
|
, module Web.Restful.Resource
|
||||||
|
, Application
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Object
|
import Data.Object
|
||||||
@ -29,3 +30,4 @@ import Web.Restful.Application
|
|||||||
import Web.Restful.Definitions
|
import Web.Restful.Definitions
|
||||||
import Web.Restful.Handler
|
import Web.Restful.Handler
|
||||||
import Web.Restful.Resource
|
import Web.Restful.Resource
|
||||||
|
import Hack (Application)
|
||||||
|
|||||||
@ -53,8 +53,8 @@ import Data.Object.Translate
|
|||||||
import Data.Object.Instances
|
import Data.Object.Instances
|
||||||
import qualified Data.ByteString as SBS
|
import qualified Data.ByteString as SBS
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
|
import qualified Data.Text as ST
|
||||||
import qualified Data.Text.Lazy as LT
|
import qualified Data.Text.Lazy as LT
|
||||||
import qualified Data.Text.Lazy.Encoding as LTE
|
|
||||||
|
|
||||||
import Web.Encodings (formatW3)
|
import Web.Encodings (formatW3)
|
||||||
|
|
||||||
@ -73,29 +73,30 @@ data Response = Response Int [Header] ContentType Content
|
|||||||
|
|
||||||
type ContentType = String
|
type ContentType = String
|
||||||
|
|
||||||
data Content = ByteString LBS.ByteString
|
-- | FIXME: Lazy in theory is better, but kills actual programs
|
||||||
| Text LT.Text
|
data Content = ByteString SBS.ByteString
|
||||||
| TransText ([Language] -> LT.Text)
|
| Text ST.Text
|
||||||
|
| TransText ([Language] -> ST.Text)
|
||||||
|
|
||||||
runContent :: [Language] -> Content -> LBS.ByteString
|
runContent :: [Language] -> Content -> LBS.ByteString
|
||||||
runContent _ (ByteString lbs) = lbs
|
runContent _ (ByteString sbs) = convertSuccess sbs
|
||||||
runContent _ (Text lt) = LTE.encodeUtf8 lt
|
runContent _ (Text lt) = convertSuccess lt
|
||||||
runContent ls (TransText t) = LTE.encodeUtf8 $ t ls
|
runContent ls (TransText t) = convertSuccess $ t ls
|
||||||
|
|
||||||
class ToContent a where
|
class ToContent a where
|
||||||
toContent :: a -> Content
|
toContent :: a -> Content
|
||||||
instance ToContent SBS.ByteString where
|
instance ToContent SBS.ByteString where
|
||||||
toContent = ByteString . convertSuccess
|
|
||||||
instance ToContent LBS.ByteString where
|
|
||||||
toContent = ByteString
|
toContent = ByteString
|
||||||
|
instance ToContent LBS.ByteString where
|
||||||
|
toContent = ByteString . convertSuccess
|
||||||
instance ToContent String where
|
instance ToContent String where
|
||||||
toContent = Text . LT.pack
|
toContent = Text . convertSuccess
|
||||||
instance ToContent Text where
|
instance ToContent Text where
|
||||||
toContent = Text
|
toContent = Text . convertSuccess
|
||||||
instance ToContent ([Language] -> String) where
|
instance ToContent ([Language] -> String) where
|
||||||
toContent f = TransText $ LT.pack . f
|
toContent f = TransText $ convertSuccess . f
|
||||||
instance ToContent Translator where
|
instance ToContent Translator where
|
||||||
toContent = TransText
|
toContent f = TransText $ convertSuccess . f
|
||||||
|
|
||||||
translateContent :: CanTranslate t => t -> Content
|
translateContent :: CanTranslate t => t -> Content
|
||||||
translateContent t = toContent $ translate t
|
translateContent t = toContent $ translate t
|
||||||
@ -167,14 +168,14 @@ toPair (Header key value) = return (key, value)
|
|||||||
------ Generic responses
|
------ Generic responses
|
||||||
-- FIXME move these to Handler?
|
-- FIXME move these to Handler?
|
||||||
-- | Return a response with an arbitrary content type.
|
-- | Return a response with an arbitrary content type.
|
||||||
genResponse :: (Monad m, ConvertSuccess t Text)
|
genResponse :: (Monad m, ToContent t)
|
||||||
=> ContentType
|
=> ContentType
|
||||||
-> t
|
-> t
|
||||||
-> [RepT m]
|
-> [RepT m]
|
||||||
genResponse ct t = [(ct, return $ Text $ convertSuccess t)]
|
genResponse ct t = [(ct, return $ toContent t)]
|
||||||
|
|
||||||
-- | Return a response with a text/html content type.
|
-- | Return a response with a text/html content type.
|
||||||
htmlResponse :: (Monad m, ConvertSuccess t Text) => t -> [RepT m]
|
htmlResponse :: (Monad m, ToContent t) => t -> [RepT m]
|
||||||
htmlResponse = genResponse "text/html"
|
htmlResponse = genResponse "text/html"
|
||||||
|
|
||||||
-- | Return a response from an Object.
|
-- | Return a response from an Object.
|
||||||
|
|||||||
@ -1,5 +1,5 @@
|
|||||||
name: restful
|
name: restful
|
||||||
version: 0.1.10
|
version: 0.1.11
|
||||||
license: BSD3
|
license: BSD3
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Michael Snoyman <michael@snoyman.com>
|
author: Michael Snoyman <michael@snoyman.com>
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user