forked from haskell-servant/servant
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Introduce SourceT, which is simple variant of "correct `ListT`". There are another variants possible (like in `streaming`), but I'm not sure there's much real difference. - Introduce `Codensity`. There's a flag if people don't want to depend on `kan-extensions`. - `StreamGenerator` and `ResultStream` are both `SourceT`. `Stream` combinator in `servant-client` uses `Codensity` for CPS. - Add servant-machines, servant-conduit, servant-pipes - Add streaming cookbook: just code, no explanations. - Add a script to run streaming 'benchmarks'
- Loading branch information
Showing
53 changed files
with
2,203 additions
and
401 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,126 @@ | ||
# Streaming out-of-the-box | ||
|
||
In other words, without streaming libraries. | ||
|
||
## Introduction | ||
|
||
- Servant supports streaming | ||
- Some basic usage doesn't require usage of streaming libraries, | ||
like `conduit`, `pipes`, `machines` or `streaming`. | ||
We have bindings for them though. | ||
- This is similar example file, which is bundled with each of the packages (TODO: links) | ||
- `SourceT` doesn't have *Prelude* with handy combinators, so we have to write | ||
things ourselves. (Note to self: `mapM` and `foldM` would be handy to have). | ||
|
||
## Code | ||
|
||
```haskell | ||
{-# LANGUAGE BangPatterns #-} | ||
{-# LANGUAGE DataKinds #-} | ||
{-# LANGUAGE DeriveGeneric #-} | ||
{-# LANGUAGE TypeOperators #-} | ||
module Main (main) where | ||
import Control.Concurrent | ||
(threadDelay) | ||
import Control.Monad.IO.Class | ||
(MonadIO (..)) | ||
import qualified Data.ByteString as BS | ||
import Data.Maybe | ||
(fromMaybe) | ||
import Network.HTTP.Client | ||
(defaultManagerSettings, newManager) | ||
import Network.Wai | ||
(Application) | ||
import System.Environment | ||
(getArgs, lookupEnv) | ||
import Text.Read | ||
(readMaybe) | ||
import Servant | ||
import Servant.Client | ||
import qualified Servant.Types.SourceT as S | ||
import qualified Network.Wai.Handler.Warp as Warp | ||
type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int) | ||
|
||
type API = FastAPI | ||
:<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int) | ||
-- monad can be ResourceT IO too. | ||
:<|> "readme" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString) | ||
-- we can have streaming request body | ||
:<|> "proxy" | ||
:> StreamBody NoFraming OctetStream (SourceIO BS.ByteString) | ||
:> StreamPost NoFraming OctetStream (SourceIO BS.ByteString) | ||
|
||
api :: Proxy API | ||
api = Proxy | ||
|
||
server :: Server API | ||
server = fast :<|> slow :<|> readme :<|> proxy where | ||
fast n = liftIO $ do | ||
putStrLn $ "/get/" ++ show n | ||
return $ fastSource n | ||
slow n = liftIO $ do | ||
putStrLn $ "/slow/" ++ show n | ||
return $ slowSource n | ||
|
||
readme = liftIO $ do | ||
putStrLn "/proxy" | ||
return (S.readFile "README.md") | ||
proxy c = liftIO $ do | ||
putStrLn "/proxy" | ||
return c | ||
|
||
-- for some reason unfold leaks? | ||
fastSource = S.fromStepT . mk where | ||
mk m | ||
| m < 0 = S.Stop | ||
| otherwise = S.Yield m (mk (m - 1)) | ||
|
||
slowSource m = S.mapStepT delay (fastSource m) where | ||
delay S.Stop = S.Stop | ||
delay (S.Error err) = S.Error err | ||
delay (S.Skip s) = S.Skip (delay s) | ||
delay (S.Effect ms) = S.Effect (fmap delay ms) | ||
delay (S.Yield x s) = S.Effect $ | ||
S.Yield x (delay s) <$ threadDelay 1000000 | ||
|
||
app :: Application | ||
app = serve api server | ||
|
||
cli :: Client ClientM FastAPI | ||
cli :<|> _ :<|> _ :<|> _ = client api | ||
|
||
main :: IO () | ||
main = do | ||
args <- getArgs | ||
case args of | ||
("server":_) -> do | ||
putStrLn "Starting cookbook-basic-streaming at http://localhost:8000" | ||
port <- fromMaybe 8000 . (>>= readMaybe) <$> lookupEnv "PORT" | ||
Warp.run port app | ||
("client":ns:_) -> do | ||
n <- maybe (fail $ "not a number: " ++ ns) pure $ readMaybe ns | ||
mgr <- newManager defaultManagerSettings | ||
burl <- parseBaseUrl "http://localhost:8000/" | ||
withClientM (cli n) (mkClientEnv mgr burl) $ \me -> case me of | ||
Left err -> print err | ||
Right src -> do | ||
x <- S.unSourceT src (go (0 :: Int)) | ||
print x | ||
where | ||
go !acc S.Stop = return acc | ||
go !acc (S.Error err) = print err >> return acc | ||
go !acc (S.Skip s) = go acc s | ||
go !acc (S.Effect ms) = ms >>= go acc | ||
go !acc (S.Yield _ s) = go (acc + 1) s | ||
_ -> do | ||
putStrLn "Try:" | ||
putStrLn "cabal new-run cookbook-basic-streaming server" | ||
putStrLn "cabal new-run cookbook-basic-streaming client 10" | ||
putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5" | ||
``` |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,28 @@ | ||
name: cookbook-basic-streaming | ||
version: 2.1 | ||
synopsis: Streaming in servant without streaming libs | ||
homepage: http://haskell-servant.readthedocs.org/ | ||
license: BSD3 | ||
license-file: ../../../servant/LICENSE | ||
author: Servant Contributors | ||
maintainer: [email protected] | ||
build-type: Simple | ||
cabal-version: >=1.10 | ||
tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.1 | ||
|
||
executable cookbook-basic-streaming | ||
main-is: Streaming.lhs | ||
build-tool-depends: markdown-unlit:markdown-unlit | ||
default-language: Haskell2010 | ||
ghc-options: -Wall -pgmL markdown-unlit -threaded -rtsopts | ||
|
||
hs-source-dirs: . | ||
build-depends: base >= 4.8 && <4.13 | ||
, aeson | ||
, bytestring | ||
, servant | ||
, servant-server | ||
, servant-client | ||
, http-client | ||
, wai | ||
, warp |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.