]> Git — Sourcephile - haskell/symantic-http.git/blob - symantic-http-demo/server/Main.hs
stack: bump to lts-14.13
[haskell/symantic-http.git] / symantic-http-demo / server / Main.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE TypeApplications #-}
3 module Main where
4 import qualified Control.Concurrent as Concurrent
5 import qualified Control.Monad.Classes as MC
6 import qualified Network.Wai as Wai
7 import qualified Network.Wai.Handler.Warp as Warp
8 import qualified Pipes.Prelude as P
9
10 import Symantic.HTTP
11 import Symantic.HTTP.Server
12 import Symantic.HTTP.Pipes ()
13
14 import API (api)
15
16 -- | Derive an application from the handlers of the server.
17 app :: Wai.Application
18 app = server api $
19 route_succ :!:
20 route_countdown
21 where
22 route_succ n =
23 return $ n+1
24
25 route_countdown n =
26 return $
27 (`P.unfoldr` 1) $ \i ->
28 if i <= n
29 then do
30 MC.exec @IO $ do
31 putStrLn $ "wait 1s to send: "<>show i
32 Concurrent.threadDelay 1000000
33 return $ Right (i,i+1)
34 else return $ Left ()
35
36 main :: IO ()
37 main = Warp.run 8080 app