{-# 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 "distributes nested routes through dynamic paths" $ do
			inp_dynamic `shouldRouteAs` exp_dynamic
		it "properly reorders permuted static paths" $ do
			inp_permute `shouldRouteAs` exp_permute

-- * 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 :: 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 :: repr ~ Server => Router repr a b -> Router repr c d -> Bool
	go (Router_Map xs) (Router_Map ys) =
		List.and $ (\((kx,x),(ky,y)) -> kx==ky && routerEq x y) <$>
		List.zip (Map.toList xs) (Map.toList ys)
	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_AltL x) y = routerEq x y
	go (Router_AltR x) y = routerEq x y
	go x (Router_AltL y) = routerEq x y
	go x (Router_AltR y) = routerEq x y
	go (Router_Cap xn) (Router_Cap yn) = xn == yn
	go (Router_Caps xs) (Router_Caps ys) = go xs ys
		where
		go :: Captures xs -> Captures ys -> Bool
		go (Captures0 xa xn) (Captures0 ya yn) = xn == xn
		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

{-
map [
 ("a",L (L map [("a","b" <.> R X),("b","c" <.> L (L X)),("c","b" <.> L (R X))])
      <!> "a" <.> "c" <.> X)
,("b",L (L (R map [("a","c" <.> L X),("c","a" <.> R X)])))
,("c",map [("a","b" <.> L (R (L X))),("b","a" <.> L (R (R X)))])
]
-}
{-
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
-}