{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Hspec.Server.Stream where

import Control.Monad (when)
import Data.Bool
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Ord (Ord(..))
import Data.Functor ((<$))
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Prelude ((+), (-))
import System.IO (putStrLn)
import Test.Hspec.Wai (liftIO)
import Text.Read (readMaybe)
import Text.Show (Show(..))
import qualified Control.Concurrent as Concurrent
import qualified Data.ByteString.Base64 as BS64
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai.Handler.Warp as Warp
import qualified Test.Hspec.Wai as Wai
import qualified Control.Monad.Classes as MC

import Symantic.HTTP
import Hspec.Utils

{-
api = "stream" </> "slow"
               </> capture @Int "n"
               <.> getStream @(SourceIO Int) @'[PlainText] @NewlineFraming

srv = server api $ route_slow
	where
	route_slow n = MC.exec $ do
		putStrLn $ "/stream/slow/" <> show n
		return $ mapStepT (delaySource 100000) $ fastSource n
	fastSource n = source [1..n]
	delaySource t = mapYield $ \a next ->
		Yield a $ Effect $ do
			-- NOTE: add a delay after each yielded value.
			Concurrent.threadDelay t
			return $ delaySource t next

cli_slow = client api

warp :: IO ()
warp = Warp.run 8080 srv
-}

{-
hspec = testSpecs $ describe "Error" $ Wai.with (return srv) $ do
	describe "Path" $ do
		it "checks shorter path" $ do
			Wai.get "/good"
			 `Wai.shouldRespondWith` 404
		it "checks longer path" $ do
			Wai.get "/good/path/bad"
			 `Wai.shouldRespondWith` 404
-}

{-
type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int)

type API = FastAPI
    :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int)
    -- monad can be ResourceT IO too.
    :<|> "readme" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
    -- we can have streaming request body
    :<|> "proxy"
        :> StreamBody NoFraming OctetStream (SourceIO BS.ByteString)
        :> StreamPost NoFraming OctetStream (SourceIO BS.ByteString)

api :: Proxy API
api = Proxy

server :: Server API
server = fast :<|> slow :<|> readme :<|> proxy where
    fast n = liftIO $ do
        putStrLn $ "/get/" ++ show n
        return $ fastSource n

    slow n = liftIO $ do
        putStrLn $ "/slow/" ++ show n
        return $ slowSource n

    readme = liftIO $ do
        putStrLn "/proxy"
        return (S.readFile "README.md")

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

    -- for some reason unfold leaks?
    fastSource = S.fromStepT . mk where
        mk m
            | m < 0     = S.Stop
            | otherwise = S.Yield m (mk (m - 1))

    slowSource m = S.mapStepT delay (fastSource m) where
        delay S.Stop        = S.Stop
        delay (S.Error err) = S.Error err
        delay (S.Skip s)    = S.Skip (delay s)
        delay (S.Effect ms) = S.Effect (delay <$> ms)
        delay (S.Yield x s) = S.Effect $
            S.Yield x (delay s) <$ threadDelay 1000000

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 cookbook-basic-streaming 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) $ \me -> case me of
                Left err  -> print err
                Right src -> do
                    x <- S.unSourceT src (go (0 :: Int))
                    print x
                  where
                    go !acc S.Stop        = return acc
                    go !acc (S.Error err) = print err >> return acc
                    go !acc (S.Skip s)    = go acc s
                    go !acc (S.Effect ms) = ms >>= go acc
                    go !acc (S.Yield _ s) = go (acc + 1) s
        _ -> do
            putStrLn "Try:"
            putStrLn "cabal new-run cookbook-basic-streaming server"
            putStrLn "cabal new-run cookbook-basic-streaming client 10"
            putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
-}