git.iko.soy/typeable/http-api-data
on 8cc39ea help sign in
typeable/http-api-data/test/Web/Internal/TestInstances.hs
66 lines 2.1 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# OPTIONS_GHC -fno-warn-orphans #-}
5module Web.Internal.TestInstances
6 ( RandomCase(..)
7 , SimpleRec(..)
8 , NoEmptyKeyForm(..)
9 ) where
11import Control.Applicative
12import Data.Char
13import qualified Data.HashMap.Strict as HashMap
14import qualified Data.Text as T
15import Data.Time
16import GHC.Exts (fromList)
17import GHC.Generics
19import Test.QuickCheck
20import Test.QuickCheck.Instances ()
22import Web.Internal.FormUrlEncoded
23import Web.Internal.HttpApiData
25instance Eq ZonedTime where
26 ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y
28instance Arbitrary Form where
29 arbitrary = fromList <$> arbitrary
31data RandomCase a = RandomCase [Bool] a
33instance ToHttpApiData a => Show (RandomCase a) where
34 show rc@(RandomCase _ x) = show (toUrlPiece rc) ++ " (original: " ++ show (toUrlPiece x) ++ ")"
36instance Eq a => Eq (RandomCase a) where
37 RandomCase _ x == RandomCase _ y = x == y
39instance Arbitrary a => Arbitrary (RandomCase a) where
40 arbitrary = liftA2 RandomCase nonempty arbitrary
41 where
42 nonempty = liftA2 (:) arbitrary arbitrary
44instance ToHttpApiData a => ToHttpApiData (RandomCase a) where
45 toUrlPiece (RandomCase us x) = T.pack (zipWith (\u -> if u then toUpper else toLower) (cycle us) (T.unpack (toUrlPiece x)))
47instance FromHttpApiData a => FromHttpApiData (RandomCase a) where
48 parseUrlPiece s = RandomCase [] <$> parseUrlPiece s
50data SimpleRec = SimpleRec { rec1 :: T.Text, rec2 :: Int }
51 deriving (Eq, Show, Read, Generic)
53instance ToForm SimpleRec
54instance FromForm SimpleRec
56instance Arbitrary SimpleRec where
57 arbitrary = SimpleRec <$> arbitrary <*> arbitrary
59newtype NoEmptyKeyForm =
60 NoEmptyKeyForm { unNoEmptyKeyForm :: Form }
61 deriving Show
63instance Arbitrary NoEmptyKeyForm where
64 arbitrary = NoEmptyKeyForm . removeEmptyKeys <$> arbitrary
65 where
66 removeEmptyKeys (Form m) = Form (HashMap.delete "" m)