servant-conduit (empty) → 0.15
raw patch · 6 files changed
+277/−0 lines, 6 filesdep +basedep +base-compatdep +bytestringsetup-changed
Dependencies added: base, base-compat, bytestring, conduit, http-client, http-media, mtl, resourcet, servant, servant-client, servant-conduit, servant-server, unliftio-core, wai, warp
Files
- CHANGELOG.md +4/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- example/Main.hs +103/−0
- servant-conduit.cabal +66/−0
- src/Servant/Conduit.hs +72/−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,103 @@+{-# 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 Control.Monad.Trans.Resource+ (ResourceT)+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 Data.Conduit+import qualified Data.Conduit.Combinators as C+import Servant+import Servant.Client.Streaming+import Servant.Conduit ()++import qualified Network.Wai.Handler.Warp as Warp++type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (ConduitT () Int IO ())++type API = FastAPI+ :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (ConduitT () Int IO ())+ -- monad can be ResourceT IO too.+ :<|> "readme" :> StreamGet NoFraming OctetStream (ConduitT () BS.ByteString (ResourceT IO) ())+ -- we can have streaming request body+ :<|> "proxy"+ :> StreamBody NoFraming OctetStream (ConduitT () BS.ByteString IO ())+ :> StreamPost NoFraming OctetStream (ConduitT () 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 $ fastConduit n++ slow n = liftIO $ do+ putStrLn $ "/slow/" ++ show n+ return $ slowConduit n++ readme = liftIO $ do+ putStrLn "/proxy"+ return (C.sourceFile "README.md")++ proxy c = liftIO $ do+ putStrLn "/proxy"+ return c++ -- for some reason unfold leaks?+ fastConduit = C.unfold mk where+ mk m+ | m < 0 = Nothing+ | otherwise = Just (m, pred m)++ slowConduit m = fastConduit m .| C.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-conduit: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 c -> do+ x <- connect c $ C.foldl (\p _ -> p + 1) (0 :: Int)+ print x+ _ -> do+ putStrLn "Try:"+ putStrLn "cabal new-run servant-conduit:example server"+ putStrLn "cabal new-run servant-conduit:example client 10"+ putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
+ servant-conduit.cabal view
@@ -0,0 +1,66 @@+cabal-version: >=1.10+name: servant-conduit+version: 0.15++synopsis: Servant Stream support for conduit.+category: Servant, Web, Enumerator+description: Servant Stream support for conduit.+ .+ Provides 'ToSourceIO' and 'FromSourceIO' instances for 'ConduitT'.++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-conduit.git++library+ exposed-modules: Servant.Conduit+ build-depends:+ base >=4.9 && <5+ , bytestring >=0.10.8.1 && <0.11+ , conduit >=1.3.1 && <1.4+ , mtl >=2.2.2 && <2.3+ , resourcet >=1.2.2 && <1.3+ , servant >=0.15 && <0.16+ , unliftio-core >=0.1.2.0 && <0.2+ 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+ , conduit+ , http-media+ , resourcet+ , servant+ , servant-conduit+ , 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/Conduit.hs view
@@ -0,0 +1,72 @@+{-# 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 'ConduitT' instances.+module Servant.Conduit (+ ConduitToSourceIO (..),+ ) where++import Control.Monad.IO.Class+ (MonadIO (..))+import Control.Monad.IO.Unlift+ (MonadUnliftIO (..))+import Control.Monad.Trans.Resource+ (ResourceT, runResourceT)+import Data.Conduit.Internal+ (ConduitT (..), Pipe (..))+import Servant.API.Stream+import qualified Servant.Types.SourceT as S++-- | Helper class to implement @'ToSourceIO' 'ConduitT'@ instance+-- for various monads.+class ConduitToSourceIO m where+ conduitToSourceIO :: ConduitT i o m () -> SourceIO o++instance ConduitToSourceIO IO where+ conduitToSourceIO (ConduitT con) = S.SourceT ($ go (con Done)) where+ go p0 = case p0 of+ Done () -> S.Stop+ HaveOutput p o -> S.Yield o (go p)+ NeedInput _ip up -> S.Skip (go (up ()))+ PipeM m -> S.Effect $ fmap go m+ Leftover p _l -> S.Skip (go p)++instance m ~ IO => ConduitToSourceIO (ResourceT m) where+ conduitToSourceIO (ConduitT con) =+ S.SourceT $ \k ->+ runResourceT $ withRunInIO $ \runRes ->+ k (go runRes (con Done))+ where+ go :: (forall x. ResourceT m x -> m x)+ -> Pipe i i o () (ResourceT m) ()+ -> S.StepT IO o+ go _ (Done ()) = S.Stop+ go runRes (HaveOutput p o) = S.Yield o (go runRes p)+ go runRes (NeedInput _ip up) = S.Skip (go runRes (up ()))+ go runRes (PipeM m) = S.Effect $ runRes $ fmap (go runRes) m+ go runRes (Leftover p _l) = S.Skip (go runRes p)++instance (ConduitToSourceIO m, r ~ ())+ => ToSourceIO o (ConduitT i o m r)+ where+ toSourceIO = conduitToSourceIO++instance (MonadIO m, r ~ ()) => FromSourceIO o (ConduitT i o m r) where+ fromSourceIO src =+ ConduitT $ \con ->+ PipeM $ liftIO $ S.unSourceT src $ \step ->+ loop con step+ where+ loop :: MonadIO m => (() -> Pipe i i o () m b) -> S.StepT IO o -> IO (Pipe i i o () m b)+ loop con S.Stop = return (con ())+ loop _con (S.Error err) = fail err+ loop con (S.Skip s) = loop con s+ loop con (S.Effect ms) = ms >>= loop con+ loop con (S.Yield x s) = return (HaveOutput (PipeM (liftIO $ loop con s)) x)++ {-# SPECIALIZE INLINE fromSourceIO :: SourceIO o -> ConduitT i o IO () #-}