{-# 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
    -- 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