ocharles.hs

#!/usr/bin/env nix-shell
#!nix-shell -i runhaskell -p "unstable.haskellPackages.ghcWithPackages (pkgs: with pkgs; [ http-client servant-client servant-server warp ])"
{-# language TypeApplications #-}

module Main where

import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TChan
import Control.Monad
import Control.Monad.IO.Class
import Data.Foldable
import Data.Semigroup
import Network.HTTP.Client hiding (Proxy)
import Servant
import Servant.Client
import Servant.Server
import qualified Network.Wai.Handler.Warp

type API stream = StreamGet NewlineFraming JSON ( stream Bool )

getStream :: ClientM (ResultStream Bool)
getStream = client (Proxy @(API ResultStream))

runServer :: IO ()
runServer = Network.Wai.Handler.Warp.run 8080 $ serve ( Proxy @(API StreamGenerator) ) $ liftIO $ do
  chan <- newTChanIO
  traverse_ ( atomically . writeTChan chan ) [ True, False, True ]

  return $ StreamGenerator $ \yieldFirst yieldRest -> do
    atomically ( readTChan chan ) >>= yieldFirst

    forever $ do
      msg <- atomically ( readTChan chan )
      putStrLn ( " !!!!! " <> show msg )
      yieldRest msg
      putStrLn "OK"

runClient :: IO ()
runClient = do
  mgr <- newManager defaultManagerSettings
  Right (ResultStream consumeStream)
    <- runClientM getStream (ClientEnv mgr url Nothing)
  consumeStream go

  where url = BaseUrl Http "localhost" 8080 ""
        go popElt = do
          melt <- popElt
          case melt of
            Nothing -> return ()
            Just (Left str) -> error str >> go popElt
            Just (Right a) -> putStrLn ("[Client] " ++ show a)
                           >> go popElt

main :: IO ()
main = do
  servid <- forkIO runServer
  threadDelay 500000
  runClient
  killThread servid