Routing.hs

{-# OPTIONS_GHC -F -pgmF htfpp #-}
{-# LANGUAGE OverloadedStrings #-}
module Tests.Routing (htf_thisModulesTests) where

import Test.Framework

import Web.Spock.Routing
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as HM

test_matchNode :: IO ()
test_matchNode =
    do assertEqual (False, Nothing) (matchNode "foo" (RouteNodeRoot))
       assertEqual (True, Just (CaptureVar "x", "123")) (matchNode "123" (RouteNodeCapture (CaptureVar "x")))
       assertEqual (True, Just (CaptureVar "x", "123")) (matchNode "123" (RouteNodeRegex (CaptureVar "x") (buildRegex "^[0-9]+$")))

test_matchRoute :: IO ()
test_matchRoute =
    do assertEqual noMatches (matchRoute "random" routingTree)
       assertEqual (oneMatch emptyParamMap [1]) (matchRoute "/" routingTree)
       assertEqual noMatches (matchRoute "/baz" routingTree)
       assertEqual (oneMatch emptyParamMap [2]) (matchRoute "/bar" routingTree)
       assertEqual (oneMatch (vMap [("baz", "5")]) [3]) (matchRoute "/bar/5" routingTree)
       assertEqual multiMatch (matchRoute "/bar/bingo" routingTree)
       assertEqual (oneMatch (vMap [("baz", "23")]) [4]) (matchRoute "/bar/23/baz" routingTree)
       assertEqual (oneMatch (vMap [("baz", "23"), ("bim", "100")]) [4]) (matchRoute "/bar/23/baz/100" routingTree)
       assertEqual (oneMatch (vMap [("baz", "23"), ("bim", "100")]) [4]) (matchRoute "/ba/23/100" routingTree)
       assertEqual (oneMatch (vMap [("cid", "344"), ("since", "2014-20-14T12:23")]) [6]) (matchRoute "/entry/344/2014-20-14T12:23" routingTree)
       assertEqual (oneMatch (vMap [("cid", "344"), ("since", "2014-20-14T12:23")]) [7]) (matchRoute "/entry/bytags/344/2014-20-14T12:23" routingTree)
       assertEqual multiMatch' (matchRoute "/entry/1/audit" routingTree)
       assertEqual (oneMatch (vMap [("eid", "2"), ("cid", "3")]) [9]) (matchRoute "/entry/2/rel/3" routingTree)
    where
      vMap kv =
          HM.fromList $ map (\(k, v) -> (CaptureVar k, v)) kv
      multiMatch =
          ((oneMatch emptyParamMap [5])
            ++ oneMatch (vMap [("baz", "bingo")]) [3])
      multiMatch' =
          ((oneMatch (vMap [("since", "audit"), ("cid", "1")]) [6])
           ++ (oneMatch (vMap [("eid", "1")]) [8]))
      noMatches = []
      oneMatch pm m = [(pm, m)]
      routingTree =
          foldl (\tree (route, action) -> addToRoutingTree route action tree) emptyRoutingTree routes
      routes =
          [ ("/", [1])
          , ("/bar", [2 :: Int])
          , ("/bar/:baz", [3])
          , ("/bar/bingo", [5])
          , ("/bar/:baz/baz", [4])
          , ("/bar/:baz/baz/:bim", [4])
          , ("/ba/:baz/:bim", [4])
          , ("/entry/:cid/:since", [6])
          , ("/entry/bytags/:cid/:since", [7])
          , ("/entry/:eid/audit", [8])
          , ("/entry/:eid/rel/:cid", [9])
          ]

test_parseRouteNode :: IO ()
test_parseRouteNode =
    do assertEqual (RouteNodeText "foo") (parseRouteNode "foo")
       assertEqual (RouteNodeCapture (CaptureVar "bar")) (parseRouteNode ":bar")
       assertEqual (RouteNodeRegex (CaptureVar "bar") (buildRegex "^[0-9]$")) (parseRouteNode "{bar:^[0-9]$}")

test_addToRoutingTree :: IO ()
test_addToRoutingTree =
    do assertEqual baseRoute (addToRoutingTree "/" [True] emptyT)
       assertEqual (fooBar []) (addToRoutingTree "/foo/:bar" [True] emptyT)
       assertEqual (fooBar baz) (addToRoutingTree "/foo/:bar/baz" [True] (fooBar []))
    where
      emptyT = emptyRoutingTree
      baseRoute = RoutingTree { rt_node = RouteData{rd_node = RouteNodeRoot, rd_data = Just [True]}, rt_children = V.empty}
      baz = [ RoutingTree { rt_node = RouteData { rd_node = RouteNodeText "baz", rd_data = Just [True] },rt_children = V.empty }]
      fooBar xs =
          RoutingTree
          { rt_node =
                RouteData {rd_node = RouteNodeRoot, rd_data = Nothing }
          , rt_children =
              V.fromList
                   [ RoutingTree { rt_node = RouteData{rd_node = RouteNodeText "foo", rd_data = Nothing}
                                 , rt_children =
                                     V.fromList
                                          [ RoutingTree { rt_node = RouteData { rd_node = RouteNodeCapture (CaptureVar "bar")
                                                                              , rd_data = Just [True]
                                                                              }
                                                        , rt_children = V.fromList xs}]}]}