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