servant-machines (empty) → 0.15
raw patch · 6 files changed
+243/−0 lines, 6 filesdep +basedep +base-compatdep +bytestringsetup-changed
Dependencies added: base, base-compat, bytestring, http-client, http-media, machines, mtl, servant, servant-client, servant-machines, servant-server, wai, warp
Files
- CHANGELOG.md +4/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- example/Main.hs +98/−0
- servant-machines.cabal +63/−0
- src/Servant/Machines.hs +46/−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,98 @@+{-# 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 Data.Void+ (Void)+import Network.HTTP.Client+ (defaultManagerSettings, newManager)+import Network.Wai+ (Application)+import System.Environment+ (getArgs, lookupEnv)+import Text.Read+ (readMaybe)++import Data.Machine+import Servant+import Servant.Client.Streaming+import Servant.Machines ()++import qualified Network.Wai.Handler.Warp as Warp++type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (MachineT IO (Is Void) Int)++type API = FastAPI+ :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (MachineT IO (Is Void) Int)+ :<|> "proxy"+ :> StreamBody NoFraming OctetStream (MachineT IO (Is Void) BS.ByteString)+ :> StreamPost NoFraming OctetStream (MachineT IO (Is Void) BS.ByteString)++api :: Proxy API+api = Proxy++server :: Server API+server = fast :<|> slow :<|> proxy+ where+ fast n = liftIO $ do+ putStrLn ("/get/" ++ show n)+ return $ fastMachine n++ slow n = liftIO $ do+ putStrLn ("/slow/" ++ show n)+ return $ slowMachine n++ proxy c = liftIO $ do+ putStrLn "/proxy"+ return c++ -- for some reason unfold leaks?+ fastMachine m+ | m < 0 = MachineT (return Stop)+ | otherwise = MachineT (return (Yield m (fastMachine (m - 1))))++ slowMachine m+ | m < 0 = MachineT (return Stop)+ | otherwise = MachineT $ do+ threadDelay 1000000+ return (Yield m (slowMachine (m - 1)))++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-machines: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 m -> do+ x <- runT $ fold (\p _ -> p + 1) (0 :: Int) <~ m+ print x+ _ -> do+ putStrLn "Try:"+ putStrLn "cabal new-run servant-machines:example server"+ putStrLn "cabal new-run servant-machines:example client 10"+ putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
+ servant-machines.cabal view
@@ -0,0 +1,63 @@+cabal-version: >=1.10+name: servant-machines+version: 0.15++synopsis: Servant Stream support for machines+category: Servant, Web, Enumerator+description: Servant Stream support for machines.+ .+ Provides 'ToSourceIO' and 'FromSourceIO' instances for 'MachineT'.++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-machines.git++library+ exposed-modules: Servant.Machines+ build-depends:+ base >=4.9 && <5+ , bytestring >=0.10.8.1 && <0.11+ , machines >=0.6.4 && <0.7+ , mtl >=2.2.2 && <2.3+ , 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+ , machines+ , servant-machines+ , 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/Machines.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}+-- | This module exports 'ToSourceIO' and 'FromSourceIO' for 'MachineT' instances.+module Servant.Machines (+ MachineToSourceIO (..),+ ) where++import Control.Monad.IO.Class+ (MonadIO (..))+import Data.Machine+ (MachineT (..), Step (..))+import Servant.API.Stream+import qualified Servant.Types.SourceT as S++-- | Helper class to implement @'ToSourceIO' 'MachineT'@ instance+-- for various monads.+class MachineToSourceIO m where+ machineToSourceIO :: MachineT m k o -> S.SourceT IO o++instance MachineToSourceIO IO where+ machineToSourceIO ma = S.SourceT ($ go ma) where+ go (MachineT m) = S.Effect $ do+ step <- m+ case step of+ Stop -> return S.Stop+ Yield x m' -> return (S.Yield x (go m'))+ Await _ _ m' -> return (S.Skip (go m'))++instance MachineToSourceIO m => ToSourceIO o (MachineT m k o) where+ toSourceIO = machineToSourceIO++instance MonadIO m => FromSourceIO o (MachineT m k o) where+ fromSourceIO src = MachineT $ liftIO $ S.unSourceT src go+ where+ go :: S.StepT IO o -> IO (Step k o (MachineT m k o))+ go S.Stop = return Stop+ go (S.Error err) = fail err+ go (S.Skip s) = go s+ go (S.Effect ms) = ms >>= go+ go (S.Yield x s) = return (Yield x (MachineT (liftIO (go s))))+ {-# SPECIALIZE INLINE fromSourceIO :: SourceIO o -> MachineT IO k o #-}