1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, OverloadedStrings, TemplateHaskell #-}
module Main (main) where
import Data.Text (Text)
import Test.HUnit
import Test.QuickCheck
import Test.Hspec
import Test.Hspec.QuickCheck
import Web.Routes
newtype ArticleId = ArticleId Int deriving (Eq, Show, Num, PathInfo, Arbitrary)
data Sitemap
= Home
| Article ArticleId
deriving (Eq, Show, Generic)
instance PathInfo Sitemap
instance Arbitrary Sitemap where
arbitrary = oneof [return Home, fmap Article arbitrary]
prop_PathInfo_isomorphism :: Sitemap -> Bool
prop_PathInfo_isomorphism = pathInfoInverse_prop
case_toPathInfo :: Assertion
case_toPathInfo =
do toPathInfo Home @?= "/home"
toPathInfo (Article 0) @?= "/article/0"
case_toPathInfoParams :: Assertion
case_toPathInfoParams =
do toPathInfoParams Home [("q",Just "1"),("r",Just "2")] @?= "/home?q=1&r=2"
toPathInfoParams (Article 0) [("q",Just "1"),("r",Just "2")] @?= "/article/0?q=1&r=2"
case_fromPathInfo :: Assertion
case_fromPathInfo =
do fromPathInfo "/home" @?= Right Home
fromPathInfo "/article/0" @?= Right (Article 0)
case fromPathInfo "/" :: Either String Sitemap of
Left _ -> return ()
url -> assertFailure $ "expected a Left, but got: " ++ show url
case_fromPathInfoParams :: Assertion
case_fromPathInfoParams =
do fromPathInfoParams "/home?q=1&r=2" @?= Right (Home, [("q",Just "1"),("r",Just "2")])
fromPathInfoParams "/article/0?q=1&r=2" @?= Right (Article 0, [("q",Just "1"),("r",Just "2")])
case fromPathInfoParams "/?q=1&r=2" :: Either String (Sitemap, [(Text, Maybe Text)]) of
Left _ -> return ()
url -> assertFailure $ "expected a Left, but got: " ++ show url
main :: IO ()
main = hspec $ do
prop "toPathInfo" case_toPathInfo
prop "toPathInfoParams" case_toPathInfoParams
prop "fromPathInfo" case_fromPathInfo
prop "fromPathInfoParams" case_fromPathInfoParams
prop "PathInfo_isomorphism" prop_PathInfo_isomorphism
|
