diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,10 @@ -# 0.15.0 +# 0.15.2 +* you can set status and response headers anywhere. +* deprecate lbs. +* add bytes, lazyBytes(~ lbs), text, lazyText, showing, string, char request body functions. these functions **append** request body. +* add reset function to reset request body to empty. + +# 0.15.1 * enhance performance(especially parsing parameter). # 0.15.0 diff --git a/apiary.cabal b/apiary.cabal --- a/apiary.cabal +++ b/apiary.cabal @@ -1,5 +1,5 @@ name: apiary -version: 0.15.1 +version: 0.15.2 synopsis: Simple and type safe web framework that can be automatically generate API documentation. description: Simple and type safe web framework that can be automatically generate API documentation. @@ -17,7 +17,7 @@ [capture|/:Int|] . ("name" =: pLazyByteString) . method GET . action $ \\age name -> do guard (age >= 18) contentType "text/html" - lbs . L.concat $ ["<h1>Hello, ", name, "!</h1>\\n"] + mapM_ lazyBytes ["<h1>Hello, ", name, "!</h1>\\n"] @ . @ @@ -31,15 +31,15 @@ 404 Page Notfound. @ . - * high performance(benchmark: ). + * High performance(benchmark: ). . * Nestable route handling(Apiary Monad; capture, method and more.). . - * type safe route filter. + * Type safe route filter. . - * auto generate API documentation(example: , ). + * Auto generate API documentation(example: , ). . - more examples: + more examples: license: MIT license-file: LICENSE diff --git a/src/Control/Monad/Apiary/Action.hs b/src/Control/Monad/Apiary/Action.hs --- a/src/Control/Monad/Apiary/Action.hs +++ b/src/Control/Monad/Apiary/Action.hs @@ -22,10 +22,14 @@ , ContentType , contentType -- *** response body + , reset , file , file' , builder - , lbs + , bytes, lazyBytes + , text, lazyText + , showing + , string, char , stream , rawResponse @@ -37,7 +41,7 @@ , redirectWith -- * deprecated - , redirectFound, redirectSeeOther, source + , redirectFound, redirectSeeOther, source, lbs ) where import Control.Monad.Apiary.Action.Internal diff --git a/src/Control/Monad/Apiary/Action/Internal.hs b/src/Control/Monad/Apiary/Action/Internal.hs --- a/src/Control/Monad/Apiary/Action/Internal.hs +++ b/src/Control/Monad/Apiary/Action/Internal.hs @@ -28,6 +28,7 @@ import Network.Wai import qualified Network.Wai.Parse as P +import Data.Monoid import Data.Apiary.Param import Data.Apiary.Document import Data.Apiary.Document.Html @@ -35,10 +36,13 @@ import Blaze.ByteString.Builder import Text.Blaze.Html.Renderer.Utf8 +import qualified Blaze.ByteString.Builder as B +import qualified Blaze.ByteString.Builder.Char.Utf8 as B import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.Text as T +import qualified Data.Text.Lazy as TL #ifndef WAI3 import Data.Conduit @@ -85,8 +89,33 @@ -------------------------------------------------------------------------------- +data ResponseBody + = ResponseFile FilePath (Maybe FilePart) + | ResponseBuilder Builder + | ResponseStream StreamingBody + | ResponseRaw (IO S.ByteString -> (S.ByteString -> IO ()) -> IO ()) Response + | ResponseFunc (Status -> ResponseHeaders -> Response) + +instance Monoid ResponseBody where + mempty = ResponseBuilder mempty + ResponseBuilder a `mappend` ResponseBuilder b = ResponseBuilder $ a <> b + _ `mappend` b = b + + +toResponse :: ActionState -> Response +toResponse ActionState{..} = case actionResponse of + ResponseFile f p -> responseFile actionStatus actionHeaders f p + ResponseBuilder b -> responseBuilder actionStatus actionHeaders b +#ifdef WAI3 + ResponseStream s -> responseStream actionStatus actionHeaders s +#else + ResponseStream s -> responseSource actionStatus actionHeaders s +#endif + ResponseRaw f r -> responseRaw f r + ResponseFunc f -> f actionStatus actionHeaders + data ActionState = ActionState - { actionResponse :: Response + { actionResponse :: ResponseBody , actionStatus :: Status , actionHeaders :: ResponseHeaders , actionReqBody :: Maybe ([Param], [File]) @@ -95,7 +124,7 @@ initialState :: ApiaryConfig -> ActionState initialState conf = ActionState - { actionResponse = responseLBS (defaultStatus conf) (defaultHeaders conf) "" + { actionResponse = ResponseBuilder mempty , actionStatus = defaultStatus conf , actionHeaders = defaultHeaders conf , actionReqBody = Nothing @@ -158,7 +187,7 @@ Pass -> notFound config request #endif Stop s -> send s - Continue r _ -> send $ actionResponse r + Continue r _ -> send $ toResponse r -------------------------------------------------------------------------------- @@ -316,7 +345,7 @@ -- | stop handler and send current state. since 0.3.3.0. stop :: Monad m => ActionT m a -stop = ActionT $ \_ s _ -> return $ Stop (actionResponse s) +stop = ActionT $ \_ s _ -> return $ Stop (toResponse s) -- | stop with response. since 0.4.2.0. stopWith :: Monad m => Response -> ActionT m a @@ -374,7 +403,7 @@ then redirectWith temporaryRedirect307 to else redirectWith status302 to --- | Raw response constructor. since 0.10. +-- | set raw response constructor. since 0.10. -- -- example(use pipes-wai) -- @@ -384,11 +413,15 @@ -- @ -- rawResponse :: Monad m => (Status -> ResponseHeaders -> Response) -> ActionT m () -rawResponse f = modifyState (\s -> s { actionResponse = f (actionStatus s) (actionHeaders s)} ) +rawResponse f = modifyState (\s -> s { actionResponse = ResponseFunc f } ) +-- | reset response body to no response. since v0.15.2. +reset :: Monad m => ActionT m () +reset = modifyState (\s -> s { actionResponse = mempty } ) + -- | set response body file content, without set Content-Type. since 0.1.0.0. file' :: Monad m => FilePath -> Maybe FilePart -> ActionT m () -file' f p = rawResponse (\s h -> responseFile s h f p) +file' f p = modifyState (\s -> s { actionResponse = ResponseFile f p } ) -- | set response body file content and detect Content-Type by extension. since 0.1.0.0. file :: Monad m => FilePath -> Maybe FilePart -> ActionT m () @@ -397,21 +430,41 @@ contentType (mime f) file' f p --- | set response body builder. since 0.1.0.0. +-- | append response body from builder. since 0.1.0.0. builder :: Monad m => Builder -> ActionT m () -builder b = rawResponse (\s h -> responseBuilder s h b) +builder b = modifyState (\s -> s { actionResponse = actionResponse s <> ResponseBuilder b } ) --- | set response body lazy bytestring. since 0.1.0.0. -lbs :: Monad m => L.ByteString -> ActionT m () -lbs l = rawResponse (\s h -> responseLBS s h l) +-- | append response body from strict bytestring. since 0.15.2. +bytes :: Monad m => S.ByteString -> ActionT m () +bytes = builder . B.fromByteString +-- | append response body from lazy bytestring. since 0.15.2. +lazyBytes :: Monad m => L.ByteString -> ActionT m () +lazyBytes = builder . B.fromLazyByteString + +-- | append response body from strict text. encoding UTF-8. since 0.15.2. +text :: Monad m => T.Text -> ActionT m () +text = builder . B.fromText + +-- | append response body from lazy text. encoding UTF-8. since 0.15.2. +lazyText :: Monad m => TL.Text -> ActionT m () +lazyText = builder . B.fromLazyText + +-- | append response body from show. encoding UTF-8. since 0.15.2. +showing :: (Monad m, Show a) => a -> ActionT m () +showing = builder . B.fromShow + +-- | append response body from string. encoding UTF-8. since 0.15.2. +string :: Monad m => String -> ActionT m () +string = builder . B.fromString + +-- | append response body from char. encoding UTF-8. since 0.15.2. +char :: Monad m => Char -> ActionT m () +char = builder . B.fromChar + -- | set response body source. since 0.9.0.0. stream :: Monad m => StreamingBody -> ActionT m () -#ifdef WAI3 -stream str = rawResponse (\s h -> responseStream s h str) -#else -stream str = rawResponse (\s h -> responseSource s h str) -#endif +stream str = modifyState (\s -> s { actionResponse = ResponseStream str }) {-# DEPRECATED source "use stream" #-} source :: Monad m => StreamingBody -> ActionT m () @@ -425,3 +478,8 @@ -- | redirect with 303 See Other. since 0.3.3.0. redirectSeeOther :: Monad m => S.ByteString -> ActionT m () redirectSeeOther = redirectWith seeOther303 + +{-# DEPRECATED lbs "use lazyBytes" #-} +-- | append response body from lazy bytestring. since 0.1.0.0. +lbs :: Monad m => L.ByteString -> ActionT m () +lbs = lazyBytes diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -53,7 +53,7 @@ helloWorldApp :: Application helloWorldApp = runApiary def $ action $ do contentType "text/plain" - lbs "hello" + bytes "hello" helloWorldAllTest :: Test helloWorldAllTest = testGroup "helloWorld" @@ -66,8 +66,8 @@ methodFilterApp :: Application methodFilterApp = runApiary def $ do - method "GET" . action $ contentType "text/plain" >> lbs "GET" - method POST . action $ contentType "text/plain" >> lbs "POST" + method "GET" . action $ contentType "text/plain" >> bytes "GET" + method POST . action $ contentType "text/plain" >> bytes "POST" methodFilterTest :: Test methodFilterTest = testGroup "methodFilter" @@ -81,9 +81,9 @@ httpVersionApp :: Application httpVersionApp = runApiary def $ do - http09 . action $ contentType "text/plain" >> lbs "09" - http10 . action $ contentType "text/plain" >> lbs "10" - http11 . action $ contentType "text/plain" >> lbs "11" + http09 . action $ contentType "text/plain" >> bytes "09" + http10 . action $ contentType "text/plain" >> bytes "10" + http11 . action $ contentType "text/plain" >> bytes "11" httpVersionTest :: Test httpVersionTest = testGroup "httpVersionFilter" @@ -97,7 +97,7 @@ rootFilterApp :: Application rootFilterApp = runApiary def . root . action $ do contentType "text/html" - lbs "root" + bytes "root" rootFilterTest :: Test rootFilterTest = testGroup "rootFilter" @@ -111,7 +111,7 @@ anyFilterApp :: Application anyFilterApp = runApiary def $ [capture|/test|] . anyPath . action $ do contentType "text/plain" - lbs "hello" + bytes "hello" anyFilterTest :: Test anyFilterTest = testGroup "anyPath" @@ -124,11 +124,11 @@ captureApp :: Application captureApp = runApiary def $ do - [capture|/foo|] . action $ contentType "text/plain" >> lbs "foo" - [capture|/:Int|] . method GET . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["Int", L.pack $ show i]) - [capture|/:Double|] . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["Double", L.pack $ show i]) - [capture|/bar/:L.ByteString/:Int|] . action $ \s i -> contentType "text/plain" >> lbs (L.unwords [s, L.pack $ show i]) - [capture|/:L.ByteString|] . action $ \s -> contentType "text/plain" >> lbs (L.unwords ["fall", s]) + [capture|/foo|] . action $ contentType "text/plain" >> bytes "foo" + [capture|/:Int|] . method GET . action $ \i -> contentType "text/plain" >> bytes "Int " >> showing i + [capture|/:Double|] . action $ \i -> contentType "text/plain" >> bytes "Double " >> showing i + [capture|/bar/:L.ByteString/:Int|] . action $ \s i -> contentType "text/plain" >> lazyBytes s >> char ' ' >> showing i + [capture|/:L.ByteString|] . action $ \s -> contentType "text/plain" >> bytes "fall " >> lazyBytes s captureTest :: Test captureTest = testGroup "capture" @@ -145,15 +145,15 @@ -------------------------------------------------------------------------------- queryApp f g h = runApiary def $ do - _ <- (f "foo" pInt) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "Int", L.pack $ show i]) - _ <- (g "foo" pString) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "String", L.pack $ show i]) - (h "foo" (pMaybe pString)) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "Maybe String", L.pack $ show i]) + _ <- (f "foo" pInt) . action $ \i -> contentType "text/plain" >> bytes "foo Int " >> showing i + _ <- (g "foo" pString) . action $ \i -> contentType "text/plain" >> bytes "foo String " >> showing i + (h "foo" (pMaybe pString)) . action $ \i -> contentType "text/plain" >> bytes "foo Maybe String " >> showing i queryCheckApp :: Application queryCheckApp = runApiary def $ do - ("foo" ?: pInt) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "Int"]) - ("foo" ?: pString) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "String"]) - ("foo" ?: pMaybe pString) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "Maybe String"]) + ("foo" ?: pInt) . action $ contentType "text/plain" >> bytes "foo Int" + ("foo" ?: pString) . action $ contentType "text/plain" >> bytes "foo String" + ("foo" ?: pMaybe pString) . action $ contentType "text/plain" >> bytes "foo Maybe String" queryFirstTest :: Test queryFirstTest = testGroup "First" @@ -243,10 +243,10 @@ multipleFilter1App :: Application multipleFilter1App = runApiary def $ do root $ do - method GET . action $ contentType "text/plain" >> lbs "GET /" - method POST . action $ contentType "text/html" >> lbs "POST /" + method GET . action $ contentType "text/plain" >> bytes "GET /" + method POST . action $ contentType "text/html" >> bytes "POST /" - method DELETE . action $ contentType "text/plain" >> lbs "DELETE ANY" + method DELETE . action $ contentType "text/plain" >> bytes "DELETE ANY" multipleFilter1Test :: Test multipleFilter1Test = testGroup "multiple test1: root, method"