{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Snap.Internal.Routing.Tests
  ( tests ) where

import           Control.Exception
import           Control.Monad
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import           Data.IORef
import qualified Data.Map as Map
import           Data.Maybe
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit hiding (Test, path)

import           Snap.Internal.Http.Types
import           Snap.Internal.Routing
import           Snap.Internal.Types
import           Snap.Iteratee hiding (head)
import qualified Snap.Types.Headers as H

tests :: [Test]
tests = [ testRouting1
        , testRouting2
        , testRouting3
        , testRouting4
        , testRouting5
        , testRouting6
        , testRouting7
        , testRouting8
        , testRouting9
        , testRouting10
        , testRouting11
        , testRouting12
        , testRouting13
        , testRouting14
        , testRouting15
        , testRouting16
        , testRouting17
        , testRouting18
        , testRouting19
        , testRouting20
        , testRouting21
        , testRouting22
        , testRouting23
        , testRouting24
        , testRouting25
        , testRouting26
        , testRouting27
        , testRouting28
        , testRouteLocal ]

expectException :: IO a -> IO ()
expectException m = do
    e <- try m
    case e of
      Left (z::SomeException)  -> (show z) `seq` return ()
      Right _ -> assertFailure "expected exception, didn't get one"


mkRequest :: ByteString -> IO Request
mkRequest uri = do
    enum <- newIORef $ SomeEnumerator returnI

    return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False H.empty
                     enum Nothing GET (1,1) [] "" uri "/"
                     (B.concat ["/",uri]) "" Map.empty

go :: Snap a -> ByteString -> IO a
go m s = do
    req <- mkRequest s
    run_ $ evalSnap m dummy dummy req
  where
    dummy = const $ return ()

routes :: Snap ByteString
routes = route [ ("foo"          , topFoo    )
               , ("foo/bar"      , fooBar    )
               , ("foo/bar/baz"  , fooBarBaz )
               , ("foo/:id"      , fooCapture)
               , ("bar/:id"      , fooCapture)
               , ("bar/quux"     , barQuux   )
               , ("bar"          , bar       )
               , ("z/:a/:b/:c/d" , zabc      ) ]

routesLocal :: Snap ByteString
routesLocal = routeLocal [ ("foo/bar/baz"  , fooBarBaz )
                         , ("bar"          , pass ) ]

routes2 :: Snap ByteString
routes2 = route [ (""    , topTop )
                , ("foo" , topFoo ) ]

routes3 :: Snap ByteString
routes3 = route [ (":foo" , topCapture )
                , (""     , topTop     ) ]

routes4 :: Snap ByteString
routes4 = route [ (":foo"     , pass        )
                , (":foo"     , topCapture  )
                , (":qqq/:id" , fooCapture  )
                , (":id2/baz" , fooCapture2 ) ]

routes5 :: Snap ByteString
routes5 = route [ ("" , pass       )
                , ("" , topTop ) ]

routes6 :: Snap ByteString
routes6 = route [ (":a/:a" , dblA ) ]

routes7 :: Snap ByteString
routes7 = route [ ("foo/:id"       , fooCapture )
                , ("foo/:id/:id2"  , fooCapture2)
                , ("fooo/:id/:id2" , fooCapture2)
                , ("foooo/bar/baz" , bar        )
                , (""              , topTop     ) ]


topTop, topFoo, fooBar, fooCapture, fooBarBaz, bar, barQuux :: Snap ByteString
dblA, zabc, topCapture, fooCapture2 :: Snap ByteString

dblA = do
    ma <- getParam "a"

    unless (ma == Just "a a") pass
    return "ok"


zabc = do
    ma <- getParam "a"
    mb <- getParam "b"
    mc <- getParam "c"

    unless (   ma == Just "a"
            && mb == Just "b"
            && mc == Just "c" ) pass

    return "ok"


topCapture = do
    mp <- getParam "foo"
    maybe pass return mp

topTop = return "topTop"
topFoo = return "topFoo"
fooBar = return "fooBar"
fooCapture = liftM (head . fromJust . rqParam "id") getRequest
fooCapture2 = liftM (head . fromJust . rqParam "id2") getRequest
fooBarBaz = liftM rqPathInfo getRequest
barQuux = return "barQuux"
bar     = return "bar"

-- TODO more useful test names

testRouting1 :: Test
testRouting1 = testCase "routing1" $ do
    r1 <- go routes "foo"
    assertEqual "/foo" "topFoo" r1

testRouting2 :: Test
testRouting2 = testCase "routing2" $ do
    r2 <- go routes "foo/baz"
    assertEqual "/foo/baz" "baz" r2

testRouting3 :: Test
testRouting3 = testCase "routing3" $ do
    expectException $ go routes "/xsaxsaxsax"

testRouting4 :: Test
testRouting4 = testCase "routing4" $ do
    r3 <- go routes "foo/bar"
    assertEqual "/foo/bar" "fooBar" r3

testRouting5 :: Test
testRouting5 = testCase "routing5" $ do
    r4 <- go routes "foo/bar/baz/quux"
    assertEqual "/foo/bar/baz/quux" "quux" r4

testRouting6 :: Test
testRouting6 = testCase "routing6" $ do
    r5 <- go routes "foo/bar/sproing"
    assertEqual "/foo/bar/sproing" "fooBar" r5

testRouting7 :: Test
testRouting7 = testCase "routing7" $ do
    r <- go routes "bar"
    assertEqual "/bar" "bar" r

testRouting8 :: Test
testRouting8 = testCase "routing8" $ do
    r2 <- go routes "bar/quux"
    assertEqual "/bar/quux" "barQuux" r2

testRouting9 :: Test
testRouting9 = testCase "routing9" $ do
    r3 <- go routes "bar/whatever"
    assertEqual "/bar/whatever" "whatever" r3

testRouting10 :: Test
testRouting10 = testCase "routing10" $ do
    r4 <- go routes "bar/quux/whatever"
    assertEqual "/bar/quux/whatever" "barQuux" r4

testRouting11 :: Test
testRouting11 = testCase "routing11" $ do
    r1 <- go routes2 ""
    assertEqual "/" "topTop" r1

testRouting12 :: Test
testRouting12 = testCase "routing12" $ do
    r1 <- go routes2 "foo"
    assertEqual "/foo" "topFoo" r1

testRouting13 :: Test
testRouting13 = testCase "routing13" $ do
    r1 <- go routes3 "zzzz"
    assertEqual "/zzzz" "zzzz" r1

testRouting14 :: Test
testRouting14 = testCase "routing14" $ do
    r1 <- go routes3 ""
    assertEqual "/" "topTop" r1

testRouting15 :: Test
testRouting15 = testCase "routing15" $ do
    r1 <- go routes4 "zzzz"
    assertEqual "/zzzz" "zzzz" r1

testRouting16 :: Test
testRouting16 = testCase "routing16" $ do
    r1 <- go routes5 ""
    assertEqual "/" "topTop" r1

testRouting17 :: Test
testRouting17 = testCase "routing17" $ do
    r1 <- go routes "z/a/b/c/d"
    assertEqual "/z/a/b/c/d" "ok" r1

testRouting18 :: Test
testRouting18 = testCase "routing18" $ do
    r1 <- go routes6 "a/a"
    assertEqual "/a/a" "ok" r1

testRouting19 :: Test
testRouting19 = testCase "routing19" $ do
    r1 <- go routes7 "foo"
    assertEqual "/foo" "topTop" r1

testRouting20 :: Test
testRouting20 = testCase "routing20" $ do
    r1 <- go routes7 "foo/baz"
    assertEqual "/foo/baz" "baz" r1

testRouting21 :: Test
testRouting21 = testCase "routing21" $ do
    r1 <- go routes7 "foo/baz/quux"
    assertEqual "/foo/baz/quux" "quux" r1

testRouting22 :: Test
testRouting22 = testCase "routing22" $ do
    r1 <- go routes7 "fooo/baz"
    assertEqual "/fooo/baz" "topTop" r1

testRouting23 :: Test
testRouting23 = testCase "routing23" $ do
    r1 <- go routes7 "fooo/baz/quux"
    assertEqual "/fooo/baz/quux" "quux" r1

testRouting24 :: Test
testRouting24 = testCase "routing24" $ do
    r1 <- go routes7 "foooo/bar/bax"
    assertEqual "/foooo/bar/bax" "topTop" r1

testRouting25 :: Test
testRouting25 = testCase "routing25" $ do
    r1 <- go routes7 "foooo/bar/baz"
    assertEqual "/foooo/bar/baz" "bar" r1

testRouting26 :: Test
testRouting26 = testCase "routing26" $ do
    r1 <- go routes4 "foo/bar"
    assertEqual "capture union" "bar" r1

testRouting27 :: Test
testRouting27 = testCase "routing27" $ do
    r1 <- go routes4 "foo"
    assertEqual "capture union" "foo" r1

testRouting28 :: Test
testRouting28 = testCase "routing28" $ do
    r1 <- go routes4 "quux/baz"
    assertEqual "capture union" "quux" r1

testRouteLocal :: Test
testRouteLocal = testCase "routeLocal" $ do
    r4 <- go routesLocal "foo/bar/baz/quux"
    assertEqual "/foo/bar/baz/quux" "foo/bar/baz/quux" r4
    expectException $ go routesLocal "bar"