servant-pipes (empty) → 0.15
raw patch · 6 files changed
+285/−0 lines, 6 filesdep +basedep +base-compatdep +bytestringsetup-changed
Dependencies added: base, base-compat, bytestring, http-client, http-media, monad-control, mtl, pipes, pipes-bytestring, pipes-safe, servant, servant-client, servant-pipes, servant-server, wai, warp
Files
- CHANGELOG.md +4/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- example/Main.hs +107/−0
- servant-pipes.cabal +67/−0
- src/Servant/Pipes.hs +75/−0
+ CHANGELOG.md view
@@ -0,0 +1,4 @@+0.15+----++- First release with support for `servant-0.15` `Stream` refactoring.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Servant Contributors++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Servant Contributors nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Main.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+module Main (main) where++import Prelude ()+import Prelude.Compat++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 System.IO+ (IOMode (..))+import Text.Read+ (readMaybe)++import qualified Pipes as P+import Pipes.ByteString as PBS+import qualified Pipes.Prelude as P+import Pipes.Safe+ (SafeT)+import qualified Pipes.Safe.Prelude as P+import Servant+import Servant.Client.Streaming+import Servant.Pipes ()++import qualified Network.Wai.Handler.Warp as Warp++type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (P.Producer Int IO ())++-- TODO: Change IO to something with MonadError ServantUnrenderError+type API = FastAPI+ :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (P.Producer Int IO ())+ -- monad can be SafeT IO too.+ :<|> "readme" :> StreamGet NoFraming OctetStream (P.Producer BS.ByteString (SafeT IO) ())+ -- we can have streaming request body+ :<|> "proxy"+ :> StreamBody NoFraming OctetStream (P.Producer BS.ByteString IO ())+ :> StreamPost NoFraming OctetStream (P.Producer BS.ByteString IO ())++api :: Proxy API+api = Proxy++server :: Server API+server = fast :<|> slow :<|> readme :<|> proxy+ where+ fast n = liftIO $ do+ putStrLn ("/get/" ++ show n)+ return $ fastPipe n++ slow n = liftIO $ do+ putStrLn ("/slow/" ++ show n)+ return $ slowPipe n++ readme = liftIO $ do+ putStrLn "/readme"+ return $ P.withFile "README.md" ReadMode PBS.fromHandle++ proxy c = liftIO $ do+ putStrLn "/proxy"+ return c++ -- for some reason unfold leaks?+ fastPipe m+ | m < 0 = return ()+ | otherwise = P.yield m >> fastPipe (m - 1)++ slowPipe m = fastPipe m P.>-> P.mapM (<$ 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 servant-pipes:example 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 p -> do+ x <- P.fold (\c _ -> c + 1) (0 :: Int) id p+ print x+ _ -> do+ putStrLn "Try:"+ putStrLn "cabal new-run servant-pipes:example server"+ putStrLn "cabal new-run servant-pipes:example client 10"+ putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
+ servant-pipes.cabal view
@@ -0,0 +1,67 @@+name: servant-pipes+version: 0.15+cabal-version: >=1.10++synopsis: Servant Stream support for pipes+category: Servant, Web, Pipes+description: Servant Stream support for pipes.+ .+ Provides 'ToSourceIO' and 'FromSourceIO' instances for 'Proxy' and 'SafeT'.++homepage: http://haskell-servant.readthedocs.org/+bug-reports: http://github.com/haskell-servant/servant/issues+license: BSD3+license-file: LICENSE+author: Servant Contributors+maintainer: haskell-servant-maintainers@googlegroups.com+copyright: 2018 Servant Contributors+build-type: Simple+tested-with:+ GHC ==8.0.2+ || ==8.2.2+ || ==8.4.4+ || ==8.6.2++extra-source-files:+ CHANGELOG.md++source-repository head+ type: git+ location: http://github.com/haskell-servant/servant-pipes.git++library+ exposed-modules: Servant.Pipes+ build-depends:+ base >=4.9 && <5+ , bytestring >=0.10.8.1 && <0.11+ , pipes >=4.3.9 && <4.4+ , pipes-safe >=2.3.1 && <2.4+ , mtl >=2.2.2 && <2.3+ , monad-control >=1.0.2.3 && <1.1+ , servant >=0.15 && <0.16+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++test-suite example+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ example+ ghc-options: -Wall -rtsopts -threaded+ build-depends:+ base+ , base-compat+ , bytestring+ , http-media+ , servant+ , pipes + , pipes-safe+ , servant-pipes+ , pipes-bytestring >=2.1.6 && <2.2+ , servant-server >=0.15 && <0.16+ , servant-client >=0.15 && <0.16+ , wai >=3.2.1.2 && <3.3+ , warp >=3.2.25 && <3.3+ , http-client+ default-language: Haskell2010
+ src/Servant/Pipes.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}+-- | This module exports 'ToSourceIO' and 'FromSourceIO' for 'Proxy' and 'SafeT' instances.+module Servant.Pipes (+ PipesToSourceIO (..),+ ) where++import Control.Monad.IO.Class+ (MonadIO (..))+import Control.Monad.Trans.Control+ (liftBaseWith)+import Pipes+ (ListT (..))+import Pipes.Internal+ (Proxy (..), X, closed)+import Pipes.Safe+ (SafeT, runSafeT)+import Servant.API.Stream+import qualified Servant.Types.SourceT as S++-- | Helper class to implement @'ToSourceIO' 'Proxy'@ instance+-- for various monads.+class PipesToSourceIO m where+ pipesToSourceIO :: Proxy X () () b m () -> SourceIO b++instance PipesToSourceIO IO where+ pipesToSourceIO ma = S.SourceT ($ go ma) where+ go :: Proxy X () () b IO () -> S.StepT IO b+ go (Pure ()) = S.Stop+ go (M p) = S.Effect (fmap go p)+ go (Request v _) = closed v+ go (Respond b n) = S.Yield b (go (n ()))++instance m ~ IO => PipesToSourceIO (SafeT m) where+ pipesToSourceIO ma =+ S.SourceT $ \k ->+ runSafeT $ liftBaseWith $ \runSafe ->+ k (go runSafe ma)+ where+ go :: (forall x. SafeT m x -> m x)+ -> Proxy X () () b (SafeT m) ()+ -> S.StepT IO b+ go _ (Pure ()) = S.Stop+ go runSafe (M p) = S.Effect $ runSafe $ fmap (go runSafe) p+ go _ (Request v _) = closed v+ go runSafe (Respond b n) = S.Yield b (go runSafe (n ()))++instance (PipesToSourceIO m, a' ~ X, a ~ (), b' ~ (), r ~ ())+ => ToSourceIO b (Proxy a' a b' b m r)+ where+ toSourceIO = pipesToSourceIO++instance PipesToSourceIO m => ToSourceIO a (ListT m a) where+ toSourceIO = pipesToSourceIO . enumerate++instance (MonadIO m, a' ~ X, a ~ (), b' ~ (), r ~ ())+ => FromSourceIO b (Proxy a' a b' b m r)+ where+ fromSourceIO src = M $ liftIO $ S.unSourceT src (return . go) where+ go :: S.StepT IO b -> Proxy X () () b m ()+ go S.Stop = Pure ()+ go (S.Error err) = M (fail err)+ go (S.Skip s) = go s -- drives+ go (S.Effect ms) = M (liftIO (fmap go ms))+ go (S.Yield x s) = Respond x (const (go s))+ {-# SPECIALIZE INLINE fromSourceIO :: SourceIO x -> Proxy X () () x IO () #-}++instance MonadIO m => FromSourceIO a (ListT m a) where+ fromSourceIO = Select . fromSourceIO