{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck
import Test.HUnit
import Test.QuickCheck
import Web.Encodings
import Data.Char (chr, ord)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
--import Debug.Trace
import qualified Web.Encodings.StringLike as SL
import Web.Encodings.StringLike (StringLike)
import Control.Arrow ((***))
main :: IO ()
main = defaultMain [tests]
allTests :: (Arbitrary a, StringLike a) => String -> a -> Test.Framework.Test
allTests n s = testGroup n
[ testProperty "encode/decode URL" $ qcEncodeDecodeUrl s
, testProperty "encode/decode HTML" $ qcEncodeDecodeHtml s
, testProperty "encode/decode JSON" $ qcEncodeDecodeJson s
, testProperty "encode/decode URL pairs" $ qcEncodeDecodeUrlPairs s
, testCase "hunit query string" $ huQueryString s
, testCase "hunit encode json" $ huEncodeJson s
, testCase "decode URL pairs" $ caseDecodeUrlPairs s
, testCase "parse cookies" $ caseParseCookies s
, testCase "parse http accept" $ caseParseHttpAccept s
-- FIXME , testCase "parse post" huParsePost
]
tests :: Test.Framework.Test
tests = testGroup "Web.Encodings"
[ allTests "String" (undefined :: String)
, allTests "Strict ByteString" (undefined :: BS.ByteString)
, allTests "Lazy ByteString" (undefined :: BL.ByteString)
, allTests "Strict Text" (undefined :: TS.Text)
, allTests "Lazy Text" (undefined :: TL.Text)
]
qcEncodeDecodeUrl :: StringLike a => a -> a -> Bool
qcEncodeDecodeUrl _ s = decodeUrl (encodeUrl s) == s
qcEncodeDecodeHtml :: StringLike a => a -> a -> Bool
qcEncodeDecodeHtml _ s = decodeHtml (encodeHtml s) == s
{-
qcEncodeDecodeHtml _ s =
let encoded = encodeHtml s
decoded = decodeHtml encoded
res = decoded == s
in trace ("en/de html: " ++ show (s, encoded, decoded)) res
-}
qcEncodeDecodeJson :: StringLike a => a -> a -> Bool
qcEncodeDecodeJson _ s = decodeJson (encodeJson s) == s
{-
qcEncodeDecodeJson _ s =
let encoded = encodeJson s
decoded = decodeJson encoded
res = decoded == s
in trace ("en/de json: " ++ show (s, encoded, decoded)) res
-}
qcEncodeDecodeUrlPairs :: StringLike a => a -> [(a, a)] -> Bool
qcEncodeDecodeUrlPairs _ s =
let --encoded :: String
encoded = encodeUrlPairs s
--decoded :: [(String, String)]
decoded = decodeUrlPairs encoded
--in trace ("url pairs: " ++ show (s, encoded, decoded)) $ s == decoded
in s == decoded
huQueryString :: StringLike a => a -> IO ()
huQueryString dummy = mapM_ t' [(k `asTypeOf` dummy, v)] where
--t' :: StringLike a => (a, [(a, a)]) -> IO ()
t' (s, p) = do
assertEqual (SL.unpack s) s $ encodeUrlPairs p
assertEqual (SL.unpack s) p $ decodeUrlPairs s
k = SL.pack "foo=bar&baz=bin"
v = map (SL.pack *** SL.pack) [("foo", "bar"), ("baz", "bin")]
huEncodeJson :: StringLike a => a -> IO ()
huEncodeJson dummy = do
let s = SL.pack "this is just a plain string" `asTypeOf` dummy
assertEqual "encodeJson on a plain string" s $ encodeJson s
instance Arbitrary Char where
arbitrary = choose (32,255) >>= \n -> return (chr n)
coarbitrary n = variant (ord n)
instance Arbitrary BS.ByteString where
arbitrary = fmap SL.pack arbitrary
coarbitrary = undefined
instance Arbitrary BL.ByteString where
arbitrary = fmap SL.pack arbitrary
coarbitrary = undefined
instance Arbitrary TS.Text where
arbitrary = fmap SL.pack arbitrary
coarbitrary = undefined
instance Arbitrary TL.Text where
arbitrary = fmap SL.pack arbitrary
coarbitrary = undefined
{- FIXME
huParsePost = t where
content2 = BSLU.fromString $
"--AaB03x\n" ++
"Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" ++
"Content-Type: text/plain; charset=iso-8859-1\n" ++
"This is a file.\n" ++
"It has two lines.\n" ++
"--AaB03x\n" ++
"Content-Disposition: form-data; name=\"title\"\n" ++
"Content-Type: text/plain; charset=iso-8859-1\n" ++
"A File\n" ++
"--AaB03x\n" ++
"Content-Disposition: form-data; name=\"summary\"\n" ++
"Content-Type: text/plain; charset=iso-8859-1\n" ++
"This is my file\n" ++
"file test\n" ++
"--AaB03x--\n"
t = do
let content1 = BSLU.fromString "foo=bar&baz=bin"
let len1 = BSLU.fromString $ show $ BS.length content1
let ctype1 = BSLU.fromString "application/x-www-form-urlencoded"
let result1 = parsePost ctype1 len1 content1
assertEqual "parsing post x-www-form-urlencoded"
([("foo", "bar"), ("baz", "bin")], [])
result1
let ctype2 = BSLU.fromString "multipart/form-data; boundary=AaB03x"
let len2 = BSLU.fromString $ show $ BS.length content2
let result2 = parsePost ctype2 len2 content2
let expectedsmap2 =
[ ("title", "A File")
, ("summary", "This is my file\nfile test")
]
let expectedfile2 =
[ ("document", "b.txt", "text/plain", BSLU.fromString $
"This is a file.\nIt has two lines.\n") ]
let expected2 = (expectedsmap2, expectedfile2)
assertEqual "parsing post multipart/form-data"
expected2
result2
-}
caseDecodeUrlPairs :: StringLike a => a -> IO ()
caseDecodeUrlPairs dummy = do
let input = SL.pack "foo=bar+baz+bin&x=y" `asTypeOf` dummy
expected = [("foo", "bar baz bin"), ("x", "y")]
map (SL.pack *** SL.pack) expected @=? decodeUrlPairs input
caseParseCookies :: StringLike a => a -> IO ()
caseParseCookies dummy = do
let input = SL.pack "a=a1;b=b2; c=c3" `asTypeOf` dummy
expected = [("a", "a1"), ("b", "b2"), ("c", "c3")]
map (SL.pack *** SL.pack) expected @=? parseCookies input
caseParseHttpAccept :: StringLike a => a -> IO ()
caseParseHttpAccept dummy = do
let input =
SL.pack
"text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c"
`asTypeOf` dummy
expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]
map SL.pack expected @=? parseHttpAccept input