{-# 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.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

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 :: Router repr a b -> Router repr c d -> Bool
routerEq (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)
routerEq (Router_Seg x) (Router_Seg y) = x == y
routerEq (Router_Cat xa xb) (Router_Cat ya yb) = routerEq xa ya && routerEq xb yb
routerEq (Router_Alt xl xr) (Router_Alt yl yr) = routerEq xl yl && routerEq xr yr
routerEq (Router_AltL x) y = routerEq x y
routerEq (Router_AltR x) y = routerEq x y
routerEq x (Router_AltL y) = routerEq x y
routerEq x (Router_AltR y) = routerEq x y
routerEq (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
routerEq Router_Any{} Router_Any{} = True
routerEq _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" </> capture @() "anything"
     <.> ("b" </> end <!> "c" </> end <!> "d" </> end)

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
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)

{-
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
-}