servant-streamly (empty) → 0.1.0.0
raw patch · 9 files changed
+334/−0 lines, 9 filesdep +basedep +bytestringdep +hspecsetup-changed
Dependencies added: base, bytestring, hspec, http-client, resourcet, servant, servant-client, servant-server, servant-streamly, streamly, streamly-bytestring, wai, warp
Files
- ChangeLog.md +4/−0
- LICENSE +30/−0
- README.md +5/−0
- Setup.hs +2/−0
- example/Main.hs +103/−0
- servant-streamly.cabal +83/−0
- src/Servant/Streamly.hs +70/−0
- test/Servant/StreamlySpec.hs +36/−0
- test/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,4 @@+# Changelog for servant-streamly++## 0.1.0+ * Introduction
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Gautier DI FOLCO (c) 2020++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 Gautier DI FOLCO 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.
+ README.md view
@@ -0,0 +1,5 @@+# servant-streamly++[Servant](https://hackage.haskell.org/package/servant/) Stream support for [streamly](https://hackage.haskell.org/package/streamly/).++Provides `ToSourceIO` and `FromSourceIO` instances for all `IsStream` instances.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Main.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeOperators #-}+module Main (main) where++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 qualified Streamly+import qualified Streamly.External.ByteString as Streamly+import qualified Streamly.FileSystem.Handle as Streamly+import qualified Streamly.Prelude as Streamly+import Servant+import Servant.Client.Streaming+import Servant.Streamly+import System.IO++import qualified Network.Wai.Handler.Warp as Warp++type FastAPI t = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (t IO Int)++type API t = FastAPI t+ :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (t IO Int)+ -- monad can be ResourceT IO too.+ :<|> "readme" :> StreamGet NoFraming OctetStream (t (ResourceT IO) BS.ByteString)+ -- we can have streaming request body+ :<|> "proxy"+ :> StreamBody NoFraming OctetStream (t IO BS.ByteString)+ :> StreamPost NoFraming OctetStream (t IO BS.ByteString)++api :: Proxy (API Streamly.SerialT)+api = Proxy++server :: Server (API Streamly.SerialT)+server = fast :<|> slow :<|> readme :<|> proxy+ where+ fast n = liftIO $ do+ putStrLn $ "/get/" ++ show n+ return $ fastS n++ slow n = liftIO $ do+ putStrLn $ "/slow/" ++ show n+ return $ slowS n++ readme = liftIO $ do+ putStrLn "/proxy"+ withFile "README.md" ReadMode $+ return . Streamly.map Streamly.fromArray . Streamly.unfold Streamly.readChunks++ proxy c = liftIO $ do+ putStrLn "/proxy"+ return c++ fastS = Streamly.unfoldr mk where+ mk m+ | m < 0 = Nothing+ | otherwise = Just (m, pred m)++ slowS = Streamly.mapM (\x -> threadDelay 1000000 >> return x) . fastS++app :: Application+app = serve api server++cli :: Client ClientM (FastAPI Streamly.SerialT)+cli :<|> _ :<|> _ :<|> _ = client api++main :: IO ()+main = do+ args <- getArgs+ case args of+ ("server":_) -> do+ putStrLn "Starting servant-streamly: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) $ \case+ Left err -> print err+ Right c -> do+ x <- Streamly.foldl' (\p _ -> p + 1) (0 :: Int) c+ print x+ _ -> do+ putStrLn "Try:"+ putStrLn "stack exec servant-streamly-example -- server"+ putStrLn "stack exec servant-streamly-example -- client 10"+ putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
+ servant-streamly.cabal view
@@ -0,0 +1,83 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack+--+-- hash: 87bb59a3d82f450cf1f16ac14ef62f1042e0294ef743909c7ca5e4f1b755678f++name: servant-streamly+version: 0.1.0.0+synopsis: Servant Stream support for streamly.+description: Servant Stream support for streamly. Provides 'ToSourceIO' and 'FromSourceIO' instances for all 'IsStream' instances.+category: Web, Servant, Streamly+homepage: https://github.com/blackheaven/servant-streamly#readme+bug-reports: https://github.com/blackheaven/servant-streamly/issues+author: Gautier DI FOLCO+maintainer: gautier.difolco@gmail.com+copyright: Gautier DI FOLCO+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/blackheaven/servant-streamly++library+ exposed-modules:+ Servant.Streamly+ other-modules:+ Paths_servant_streamly+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , resourcet >=1.2.4.2 && <1.3+ , servant >=0.16 && <0.20+ , streamly >=0.7.2 && <0.9+ default-language: Haskell2010++executable servant-streamly-example+ main-is: Main.hs+ other-modules:+ Paths_servant_streamly+ hs-source-dirs:+ example+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , bytestring >=0.10.10.0 && <0.11+ , http-client >=0.6.4.1 && <0.7+ , resourcet >=1.2.4.2 && <1.3+ , servant+ , servant-client >=0.16 && <0.20+ , servant-server >=0.16 && <0.20+ , servant-streamly+ , streamly+ , streamly-bytestring >=0.1.2 && <0.2+ , wai >=3.2.2.1 && <3.3+ , warp >=3.3.13 && <3.4+ default-language: Haskell2010++test-suite servant-streamly-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Servant.StreamlySpec+ Paths_servant_streamly+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , hspec >=2.7.1 && <2.8+ , resourcet >=1.2.4.2 && <1.3+ , servant >=0.16 && <0.20+ , servant-server+ , servant-streamly+ , streamly >=0.7.2 && <0.9+ default-language: Haskell2010
+ src/Servant/Streamly.hs view
@@ -0,0 +1,70 @@+{-# 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 all 'IsStream' instances.+module Servant.Streamly+ ( StreamlyToSourceIO(..)+ )+where++import Control.Monad.IO.Class ( MonadIO(..)+ , liftIO+ )+import Control.Monad.Trans.Resource ( ResourceT+ , runResourceT+ )+import qualified Streamly+import qualified Streamly.Prelude as Streamly+import qualified Servant.API.Stream as Servant+import qualified Servant.Types.SourceT as Servant++-- | Helper class to implement @'ToSourceIO' 'IsStream'@ instance+-- for various monads.+class StreamlyToSourceIO m where+ streamlyToSourceIO :: Streamly.IsStream t => t m a -> Servant.SourceIO a++instance StreamlyToSourceIO IO where+ streamlyToSourceIO stream = Servant.SourceT+ ($ transform $ Streamly.adapt stream)+ where+ transform = Servant.Effect . Streamly.foldr Servant.Yield Servant.Stop++instance StreamlyToSourceIO (ResourceT IO) where+ streamlyToSourceIO stream = Servant.SourceT+ ($ transform $ Streamly.adapt stream)+ where+ transform =+ Servant.Effect . runResourceT . Streamly.foldr Servant.Yield Servant.Stop++instance (StreamlyToSourceIO m, Streamly.IsStream t) => Servant.ToSourceIO a (t m a) where+ toSourceIO = streamlyToSourceIO++instance (Streamly.IsStream t) => Servant.FromSourceIO a (t IO a) where+ fromSourceIO src =+ Streamly.concatMapM id $ Streamly.yield $ Servant.unSourceT src go+ where+ go :: Streamly.IsStream t => Servant.StepT IO a -> IO (t IO a)+ go step = case step of+ Servant.Stop -> return Streamly.nil+ Servant.Error e -> return $ Streamly.yieldM $ error e+ Servant.Skip n -> go n+ Servant.Yield x nextStep -> Streamly.cons x <$> go nextStep+ Servant.Effect nextStep -> nextStep >>= go+ -- {-# SPECIALIZE INLINE fromSourceIO :: Streamly.IsStream t => Servant.SourceIO a -> t IO a #-}++instance (Streamly.IsStream t) => Servant.FromSourceIO a (t (ResourceT IO) a) where+ fromSourceIO src =+ Streamly.concatMapM id $ Streamly.yield $ liftIO $ Servant.unSourceT src go+ where+ go :: Streamly.IsStream t => Servant.StepT IO a -> IO (t (ResourceT IO) a)+ go step = case step of+ Servant.Stop -> return Streamly.nil+ Servant.Error e -> return $ Streamly.yieldM $ error e+ Servant.Skip n -> go n+ Servant.Yield x nextStep -> Streamly.cons x <$> go nextStep+ Servant.Effect nextStep -> nextStep >>= go
+ test/Servant/StreamlySpec.hs view
@@ -0,0 +1,36 @@+module Servant.StreamlySpec+ ( main+ , spec+ )+where++import Control.Monad.Trans.Resource ( ResourceT+ , runResourceT+ )+import qualified Streamly+import qualified Streamly.Prelude as Streamly+import Servant+import qualified Servant.API.Stream as Servant+import qualified Servant.Types.SourceT as Servant+import qualified Servant.Streamly+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "Servant.Streamly" $ do+ let content = [0 .. 4]+ describe "Direct call" $ do+ it "toSourceIO should be equivalent to source (IO)" $ do+ let+ ts = Servant.toSourceIO+ (Streamly.fromList content :: Streamly.SerialT IO Int)+ Streamly.toList (Servant.fromSourceIO ts) `shouldReturn` content+ it "toSourceIO should be equivalent to source (ResourceT IO)" $ do+ let ts = Servant.toSourceIO+ (Streamly.fromList content :: Streamly.SerialT (ResourceT IO) Int)+ Streamly.toList (Servant.fromSourceIO ts) `shouldReturn` content+ it "fromSourceIO should be equivalent to fromList"+ $ Streamly.toList (Servant.fromSourceIO (Servant.source content))+ `shouldReturn` content
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}