{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS -Wno-missing-signatures #-}
{-# OPTIONS -Wno-orphans #-}
module Hspec.Server.Router where

import Control.Monad (unless)
import Data.Bool
import Data.Char (Char)
import Data.Eq (Eq(..))
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
import Data.Proxy (Proxy(..))
import Data.String (String, IsString(..))
import System.IO (IO, putStrLn)
import Text.Show (Show(..), showString, showParen)
import qualified Control.Monad.Classes as MC
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Network.Wai.Handler.Warp as Warp
import qualified Test.Hspec as Hspec
import qualified Test.Hspec.Wai as Wai

import Symantic.HTTP
import Symantic.HTTP.Server
import Hspec.Utils

import qualified Debug.Trace as Dbg

hspec = testSpecs $ describe "Router" $ do
	{-
	Wai.with (return srv) $ do
		describe "Path" $ do
			it "call the right route" $ do
				Wai.get "/a/aa"
				 `Wai.shouldRespondWith` 200 { Wai.matchBody = mkBody $ fromString "0" }
			it "call the right route" $ do
				Wai.get "/a/AA"
				 `Wai.shouldRespondWith` 200 { Wai.matchBody = mkBody $ fromString "3" }
	-}
	describe "structure" $ do
		it "distributes endpoints through static paths" $ do
			inp_endpoint `shouldRouteAs` exp_endpoint
		it "distributes nested routes through static paths" $ do
			inp_static `shouldRouteAs` exp_static
		it "properly reorders permuted static paths" $ do
			inp_permute `shouldRouteAs` exp_permute
		{-
		it "distributes nested routes through dynamic paths" $ do
			inp_dynamic `shouldRouteAs` exp_dynamic
		-}

-- * Path tests Server

api = "a" </> "aa" </> get @String @'[PlainText]
  <!> "b" </> "bb" </> get @Int @'[PlainText]
  <!> "c" </> "cc" </> get @Int @'[PlainText]
  <!> "a" </> "AA" </> get @String @'[PlainText]
  <!> "b" </> "bb" </> get @Int @'[PlainText]

srv = server api $
	route_a_aa :!:
	route_b_bb :!:
	route_c_cc :!:
	route_a_AA :!:
	route_b_bb'
	where
	route_a_aa = do
		MC.exec $ putStrLn "/a/aa"
		return "0"
	route_b_bb = do
		MC.exec $ putStrLn "/b/bb"
		return (-1)
	route_c_cc = do
		MC.exec $ putStrLn "/c/cc"
		return 2
	route_a_AA = do
		MC.exec $ putStrLn "/a/AA"
		return "3"
	route_b_bb' = do
		MC.exec $ putStrLn "/b/bb'"
		return 4

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

-- * Utils

routerEq ::
 forall repr a b c d. repr ~ Server =>
 Router repr a b -> Router repr c d -> Bool
routerEq x0 y0 =
	{-
	let r = go
		 (Dbg.trace ("eq: x: " <> show x0) x0)
		 (Dbg.trace ("eq: y: " <> show y0) y0) in
	Dbg.trace ("eq: r: " <> show r) r
	-}
	go x0 y0
	where
	go :: Router repr a b -> Router repr c d -> Bool
	go (Router_Seg x) (Router_Seg y) = x == y
	go (Router_Cat xa xb) (Router_Cat ya yb) = routerEq xa ya && routerEq xb yb
	go (Router_Alt xl xr) (Router_Alt yl yr) = routerEq xl yl && routerEq xr yr
	go (Router_Cap xn) (Router_Cap yn) = xn == yn
	go (Router_Map xs) (Router_Map ys) =
		let xl = Map.toList xs in
		let yl = Map.toList ys in
		(List.length xl == List.length yl &&) $
		List.and $
		 (\((kx, RouterUnion _xb2a x),(ky, RouterUnion _yb2a y)) ->
			kx==ky && routerEq x y) <$>
		List.zip xl yl
	go (Router_Caps xs) (Router_Caps ys) = go xs ys
		where
		go :: Captures (Router repr) xs b -> Captures (Router repr) ys d -> Bool
		go (Captures0 xa xn xr) (Captures0 ya yn yr) = xn == xn && routerEq xr yr
		go (Captures2 xx xy) (Captures2 yx yy) = go xx yx && go xy yy
	go Router_Any{} Router_Any{} = True
	go _x _y = False

shouldRouteAs :: Router Server a b -> Router Server c d -> Hspec.Expectation
shouldRouteAs inp exp =
	let inpR = router inp in
	let expR = router exp in
	unless (inpR`routerEq`expR) $
		Hspec.expectationFailure $ "expected:\n" <> show expR <> "\nbut got:\n" <> show inpR

mkBody :: Wai.Body -> Wai.MatchBody
mkBody b = Wai.MatchBody $ \_ b' ->
	if b == b'
	then Nothing
	else Just $ TL.unpack $
	 "expecting: "<>TL.decodeUtf8 b<>
	 " but got: "<>TL.decodeUtf8 b'<>"\n"

-- * APIs

end = get @String @'[PlainText]

inp_endpoint = "a" </> end <!> "a" </> end
exp_endpoint = "a" </> (end <!> end)

inp_static = "a" </> "b" </> end <!> "a" </> "c" </> end
exp_static = "a" </> ("b" </> end <!> "c" </> end)

inp_dynamic =
     "a" </> capture @Int  "foo" <.> "b" </> end
 <!> "a" </> capture @Bool "bar" <.> "c" </> end
 <!> "a" </> capture @Char "baz" <.> "d" </> end
{-
exp_dynamic =
 "a" </> captures (Captures2 (Captures2 (Captures0 (Proxy @(Int -> Res)) "foo")
                                        (Captures0 (Proxy @(Bool -> Res)) "bar"))
                             (Captures0 (Proxy @(Char -> Res)) "baz"))
     <.> ("b" </> end <!> "c" </> end <!> "d" </> end)
type Res = ResponseArgs (Router Server) String '[PlainText]
-}

inp_permute =
     "a" </> "b" </> "c" </> end
 <!> "b" </> "a" </> "c" </> end
 <!> "a" </> "c" </> "b" </> end
 <!> "c" </> "a" </> "b" </> end
 <!> "b" </> "c" </> "a" </> end
 <!> "c" </> "b" </> "a" </> end
 <!> "a" </> "a" </> "b" </> end
 <!> "a" </> "a" </> "c" </> end
exp_permute =
     "a" </> ("b" </> "c" </> end
          <!> "c" </> "b" </> end
          <!> "a" </> "b" </> end)
 <!> "b" </> ("a" </> "c" </> end
          <!> "c" </> "a" </> end)
 <!> "c" </> ("a" </> "b" </> end
          <!> "b" </> "a" </> end)
 <!> "a" </> "a" </> "c" </> end


{-
api_PermuteRawEnd =
       "a" </> "b" </> "c" </> end
  <!> "b" </> "a" </> "c" </> end
  <!> "a" </> "c" </> "b" </> end
  <!> "c" </> "a" </> "b" </> end
  <!> "b" </> "c" </> "a" </> end
  <!> "c" </> "b" </> "a" </> end
  <!> raw
api_PermuteRawEndRef = api_PermuteRef <!> api_Raw
api_PermuteRawBegin =
       raw
  <!> "a" </> "b" </> "c" </> end
  <!> "b" </> "a" </> "c" </> end
  <!> "a" </> "c" </> "b" </> end
  <!> "c" </> "a" </> "b" </> end
  <!> "b" </> "c" </> "a" </> end
  <!> "c" </> "b" </> "a" </> end
api_PermuteRawBeginRef = raw <!> api_PermuteRef
-}