{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2

import Test.HUnit
import Test.QuickCheck

import Web.Encodings
import Data.Convertible.Text (cs)

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 ((***))
import qualified Data.ByteString as B

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
    , testProperty "encode/decode URL pairs failure"
        $ qcEncodeDecodeUrlPairsFailure 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
    , testCase "hebrew query string encode" $ caseHebrewQueryStringEncode s
    , testCase "hebrew query string decode" $ caseHebrewQueryStringDecode s
    , testCase "bad query string decode" $ caseBadQueryStringDecode s
    ]

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)
    , testCase "parse post" huParsePost
    ]

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

qcEncodeDecodeUrlPairsFailure :: StringLike a => a -> [(a, a)] -> Bool
qcEncodeDecodeUrlPairsFailure _ s =
    decodeUrlPairsFailure (encodeUrlPairs s) == Just s

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 BS.ByteString where
    arbitrary = fmap SL.pack arbitrary

instance Arbitrary BL.ByteString where
    arbitrary = fmap SL.pack arbitrary

instance Arbitrary TS.Text where
    arbitrary = fmap SL.pack arbitrary

instance Arbitrary TL.Text where
    arbitrary = fmap SL.pack arbitrary

huParsePost :: Assertion
huParsePost = t where
    content2 = cs $
        "--AaB03x\n" ++
        "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" ++
        "Content-Type: text/plain; charset=iso-8859-1\n\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\n" ++
        "A File\n" ++
        "--AaB03x\n" ++
        "Content-Disposition: form-data; name=\"summary\"\n" ++
        "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
        "This is my file\n" ++
        "file test\n" ++
        "--AaB03x--\n"
    t = do
        let content1 = cs "foo=bar&baz=bin"
        let len1 = cs $ show $ BS.length content1
        let ctype1 = cs "application/x-www-form-urlencoded"
        let result1 = parsePost ctype1 len1 content1
        assertEqual "parsing post x-www-form-urlencoded"
                    (map (cs *** cs) [("foo", "bar"), ("baz", "bin")], [])
                    result1

        let ctype2 = cs "multipart/form-data; boundary=AaB03x"
        let len2 = cs $ show $ BS.length content2
        let result2 = parsePost ctype2 len2 content2
        let expectedsmap2 =
              [ ("title", "A File")
              , ("summary", "This is my file\nfile test")
              ]
        let expectedfile2 =
              [(cs "document", FileInfo (cs "b.txt") (cs "text/plain") $ cs
                 "This is a file.\nIt has two lines.")]
        let expected2 = (map (cs *** cs) 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

caseHebrewQueryStringEncode :: StringLike a => a -> IO ()
caseHebrewQueryStringEncode dummy = do
    let encoded = SL.pack "%D7%A9%D7%9C%D7%95%D7%9D" `asTypeOf` dummy
        decoded = SL.packUtf8 "שלום"
    encoded @=? encodeUrl decoded

caseHebrewQueryStringDecode :: StringLike a => a -> IO ()
caseHebrewQueryStringDecode dummy = do
    let encoded = SL.pack "%D7%A9%D7%9C%D7%95%D7%9D" `asTypeOf` dummy
        decoded = SL.packUtf8 "שלום"
    decoded @=? decodeUrl encoded

caseBadQueryStringDecode :: StringLike a => a -> IO ()
caseBadQueryStringDecode dummy = do
    let raw = "%D7%D7%9C%D7%95%D7%9D"
        bs = decodeUrl $ SL.pack raw
        encoded = SL.pack raw `asTypeOf` dummy
        expected = SL.unpackUtf8 bs
    expected @=? decodeUrlFailure encoded