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
60
61
62
63
64
65
66
|
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Web.Internal.TestInstances
( RandomCase(..)
, SimpleRec(..)
, NoEmptyKeyForm(..)
) where
import Control.Applicative
import Data.Char
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as T
import Data.Time.Compat
import GHC.Exts (fromList)
import GHC.Generics
import Test.QuickCheck
import Test.QuickCheck.Instances ()
import Web.Internal.FormUrlEncoded
import Web.Internal.HttpApiData
instance Eq ZonedTime where
ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y
instance Arbitrary Form where
arbitrary = fromList <$> arbitrary
data RandomCase a = RandomCase [Bool] a
instance ToHttpApiData a => Show (RandomCase a) where
show rc@(RandomCase _ x) = show (toUrlPiece rc) ++ " (original: " ++ show (toUrlPiece x) ++ ")"
instance Eq a => Eq (RandomCase a) where
RandomCase _ x == RandomCase _ y = x == y
instance Arbitrary a => Arbitrary (RandomCase a) where
arbitrary = liftA2 RandomCase nonempty arbitrary
where
nonempty = liftA2 (:) arbitrary arbitrary
instance ToHttpApiData a => ToHttpApiData (RandomCase a) where
toUrlPiece (RandomCase us x) = T.pack (zipWith (\u -> if u then toUpper else toLower) (cycle us) (T.unpack (toUrlPiece x)))
instance FromHttpApiData a => FromHttpApiData (RandomCase a) where
parseUrlPiece s = RandomCase [] <$> parseUrlPiece s
data SimpleRec = SimpleRec { rec1 :: T.Text, rec2 :: Int }
deriving (Eq, Show, Read, Generic)
instance ToForm SimpleRec
instance FromForm SimpleRec
instance Arbitrary SimpleRec where
arbitrary = SimpleRec <$> arbitrary <*> arbitrary
newtype NoEmptyKeyForm =
NoEmptyKeyForm { unNoEmptyKeyForm :: Form }
deriving Show
instance Arbitrary NoEmptyKeyForm where
arbitrary = NoEmptyKeyForm . removeEmptyKeys <$> arbitrary
where
removeEmptyKeys (Form m) = Form (HashMap.delete "" m)
|
