diff --git a/API.hs b/API.hs new file mode 100644 --- /dev/null +++ b/API.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +module API where +import Text.Read (readMaybe) +import qualified Pipes as P +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL + +import Symantic.HTTP + +-- | Define the API, common to the client and server. +-- Either use @NoMonomorphismRestriction@ like here, +-- or add an argument to 'api', +-- to let the compiler infer its (complex) type. +-- Read the executables of the client and of the server +-- to see how to derive code from this 'api'. +api = + "succ" capture @Integer "n" + <.> get @Integer @'[PlainText] + + + "countdown" capture @Integer "n" + <.> getStream @(P.Producer Integer IO ()) + @'[PlainText] + @NewlineFraming + +instance MimeEncodable Integer PlainText where + mimeEncode _ = TL.encodeUtf8 . TL.pack . show +instance MimeDecodable Integer PlainText where + mimeDecode _mt bs = + let s = TL.unpack $ TL.decodeUtf8 bs in + case readMaybe s of + Nothing -> Left $ "cannot parse as Integer: "<>s + Just n -> Right n diff --git a/client/Main.hs b/client/Main.hs new file mode 100644 --- /dev/null +++ b/client/Main.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +module Main where +import Data.Maybe (fromJust) +import qualified Control.Monad.Classes as MC +import qualified Network.HTTP.Client as Client +import qualified Pipes as P + +import Symantic.HTTP +import Symantic.HTTP.Client +import Symantic.HTTP.Pipes () + +import API (api) + +-- | Derive the callers of the client. +client_succ + :!: client_countdown + = client api + +main :: IO () +main = do + manager <- Client.newManager Client.defaultManagerSettings + let baseURI = fromJust $ parseURI "http://localhost:8080" + let env = clientEnv manager baseURI + + print =<< runClient env (client_succ 42) + + (print =<<) $ runClientStream env (client_countdown 4) $ \pipe -> + P.runEffect $ + P.for pipe $ \i -> + MC.exec @IO $ print i diff --git a/server/Main.hs b/server/Main.hs new file mode 100644 --- /dev/null +++ b/server/Main.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} +module Main where +import qualified Control.Concurrent as Concurrent +import qualified Control.Monad.Classes as MC +import qualified Network.Wai as Wai +import qualified Network.Wai.Handler.Warp as Warp +import qualified Pipes.Prelude as P + +import Symantic.HTTP +import Symantic.HTTP.Server +import Symantic.HTTP.Pipes () + +import API (api) + +-- | Derive an application from the handlers of the server. +app :: Wai.Application +app = server api $ + route_succ :!: + route_countdown + where + route_succ n = + return $ n+1 + + route_countdown n = + return $ + (`P.unfoldr` 1) $ \i -> + if i <= n + then do + MC.exec @IO $ do + putStrLn $ "wait 1s to send: "<>show i + Concurrent.threadDelay 1000000 + return $ Right (i,i+1) + else return $ Left () + +main :: IO () +main = Warp.run 8080 app diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,16 @@ +resolver: lts-12.26 +packages: +- '.' +- location: '../symantic-http' + extra-dep: true +- location: '../symantic-http-client' + extra-dep: true +- location: '../symantic-http-pipes' + extra-dep: true +- location: '../symantic-http-server' + extra-dep: true +extra-deps: +- http-api-data-0.4@sha256:ad69f7cd0d1e7723abfbed6f88ac987bdf75a402b29de161eb867c6131c9d427 +- monad-classes-0.3.2.2@sha256:793faead28dafb47f115c4dec877ce3e3ffab604f134d852652385632ea0923f +nix: + packages: [zlib] diff --git a/symantic-http-demo.cabal b/symantic-http-demo.cabal new file mode 100644 --- /dev/null +++ b/symantic-http-demo.cabal @@ -0,0 +1,124 @@ +name: symantic-http-demo +-- PVP: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.0.0.0 +category: Protocol +synopsis: Demo for symantic-http and its companion libraries +description: + Demo for: + . + * + * . + * . + * . +extra-doc-files: +license: GPL-3 +stability: experimental +author: Julien Moutinho +maintainer: Julien Moutinho +bug-reports: Julien Moutinho +-- homepage: + +build-type: Simple +cabal-version: 1.24 +tested-with: GHC==8.4.4 +extra-source-files: + stack.yaml +extra-tmp-files: + +Source-Repository head + location: git://git.autogeree.net/symantic-http + type: git + +Library + exposed-modules: + API + default-language: Haskell2010 + default-extensions: + ghc-options: + -Wall + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -fno-warn-tabs + build-depends: + symantic-http >= 0.0 + , base >= 4.10 && < 5 + , pipes >= 4.3 + , text >= 1.2 + +Executable symantic-http-demo-client + hs-source-dirs: client + main-is: Main.hs + other-modules: + default-language: Haskell2010 + default-extensions: + ghc-options: + -Wall + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -fno-warn-tabs + -fhide-source-paths + build-depends: + symantic-http-demo + , symantic-http >= 0.0 + , symantic-http-client >= 0.0 + , symantic-http-pipes >= 0.0 + , base >= 4.10 && < 5 + , base64-bytestring >= 1.0.0.1 + , bytestring >= 0.10 + , containers >= 0.5 + , http-api-data >= 0.4 + , http-client >= 0.5.12 + , http-media >= 0.7 + , http-types >= 0.12 + , monad-classes >= 0.3.2 + , network >= 2.6 + , network-uri >= 2.6 + , pipes >= 4.3 + , pipes-bytestring >= 2.1 + , pipes-safe >= 2.2 + , text >= 1.2 + , time >= 1.8 + , transformers >= 0.4 + , wai >= 3.2.1.1 + , wai-extra >= 3.0 + , warp >= 3.2 + +Executable symantic-http-demo-server + hs-source-dirs: server + main-is: Main.hs + other-modules: + default-language: Haskell2010 + default-extensions: + ghc-options: + -Wall + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -fno-warn-tabs + -fhide-source-paths + build-depends: + symantic-http-demo + , symantic-http >= 0.0 + , symantic-http-server >= 0.0 + , symantic-http-pipes >= 0.0 + , base >= 4.10 && < 5 + , base64-bytestring >= 1.0.0.1 + , bytestring >= 0.10 + , containers >= 0.5 + , http-api-data >= 0.4 + , http-client >= 0.5.12 + , http-media >= 0.7 + , http-types >= 0.12 + , monad-classes >= 0.3.2 + , network >= 2.6 + , network-uri >= 2.6 + , pipes >= 4.3 + , pipes-bytestring >= 2.1 + , pipes-safe >= 2.2 + , text >= 1.2 + , time >= 1.8 + , transformers >= 0.4 + , wai >= 3.2.1.1 + , wai-extra >= 3.0 + , warp >= 3.2