{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}

module Main (main) where

import Control.Concurrent (threadDelay)
import Control.Monad.IO.Class (MonadIO (..))
import qualified Data.ByteString as BS
import Data.Machine
import Data.Maybe (fromMaybe)
import Data.Void (Void)
import Network.HTTP.Client (defaultManagerSettings, newManager)
import Network.Wai (Application)
import qualified Network.Wai.Handler.Warp as Warp
import Prelude.Compat
import Servant
import Servant.Client.Streaming
import System.Environment (getArgs, lookupEnv)
import Text.Read (readMaybe)
import Prelude ()

import Servant.Machines ()

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)
      pure $ fastMachine n

    slow n = liftIO $ do
      putStrLn ("/slow/" ++ show n)
      pure $ slowMachine n

    proxy c = liftIO $ do
      putStrLn "/proxy"
      pure c

    -- for some reason unfold leaks?
    fastMachine m
      | m < 0 = MachineT (pure Stop)
      | otherwise = MachineT (pure (Yield m (fastMachine (m - 1))))

    slowMachine m
      | m < 0 = MachineT (pure Stop)
      | otherwise = MachineT $ do
          threadDelay 1000000
          pure (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) $ \case
        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"
