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

import Control.Monad (when)
import Data.Eq (Eq(..))
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
import Data.String (String, IsString(..))
import Prelude ((+))
import System.IO (IO, putStrLn)
import Test.Hspec.Wai (liftIO)
import Text.Show (Show(..), showString, showParen)
import qualified Data.ByteString as BS
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.ByteString.Base64 as BS64
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai.Handler.Warp as Warp
import qualified Test.Hspec.Wai as Wai
import qualified Data.Map.Strict as Map
import qualified Control.Monad.Classes as MC

import Control.Arrow (first)
import Data.Function (const)
import Data.Bool
import qualified Data.Map.Merge.Strict as Map
import qualified Data.List as List

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


api2 =
     "a" </> "b" </> "b" </> end
 <!> "a" </> "b" </> "c" </> end
api3 =
     "a" </> "b" </> end
 <!> "a" </> "c" </> end

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]


end = get @String @'[PlainText]
api_permute0 =
     "a" </> "b" </> "c" </> end
api_permute1 =
     "a" </> "b" </> "c" </> end
 <!> "b" </> "a" </> "c" </> end
api_permute2 =
     "a" </> "b" </> "c" </> end
 <!> "b" </> "a" </> "c" </> end
 <!> "a" </> "c" </> "b" </> end
api_permute3 =
     "a" </> "b" </> "c" </> end
 <!> "b" </> "a" </> "c" </> end
 <!> "a" </> "c" </> "b" </> end
 <!> "c" </> "a" </> "b" </> end
api_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

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

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

instance Show (Router Server a b) where
	showsPrec p = \case
	 Router_Any{} ->
		showString "X"
	 Router_Map ms ->
		showParen (p>=10) $
		showString "map " .
		showsPrec p (Map.toList ms)
	 Router_Seg s ->
		showsPrec 10 s
	 Router_Cat x y ->
		showParen (p>=4) $
		showsPrec 10 x .
		showString " <.> " .
		showsPrec 10 y
	 Router_Alt x y ->
		showParen (p>=3) $
		showsPrec 10 x .
		showString " <!> " .
		showsPrec 10 y
	 Router_AltL x ->
		showParen (p>=4) $
		showString "L " .
		showsPrec 10 x
	 Router_AltR x ->
		showParen (p>=4) $
		showString "R " .
		showsPrec 10 x

r = show (router @Server api)

hspec = testSpecs $ describe "Router" $ 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" }

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