web-encodings 0.2.0 → 0.2.0.1
raw patch · 4 files changed
+166/−162 lines, 4 filesdep −convertiblePVP ok
version bump matches the API change (PVP)
Dependencies removed: convertible
API changes (from Hackage documentation)
Files
- Test.hs +0/−153
- Web/Encodings.hs +2/−0
- runtests.hs +160/−0
- web-encodings.cabal +4/−9
− Test.hs
@@ -1,153 +0,0 @@-{-# 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- -- 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--}
Web/Encodings.hs view
@@ -70,6 +70,7 @@ encodeUrlChar c@'_' = [c] encodeUrlChar c@'.' = [c] encodeUrlChar c@'~' = [c]+encodeUrlChar ' ' = "+" encodeUrlChar y = let (a, c) = fromEnum y `divMod` 16 b = a `mod` 16@@ -88,6 +89,7 @@ (b, s'') <- SL.uncons s' (c, s''') <- SL.uncons s'' return $ getHex b c `SL.cons` decodeUrl s'''+ '+' -> return $ ' ' `SL.cons` decodeUrl s' _ -> return $ a `SL.cons` decodeUrl s' getHex :: Char -> Char -> Char
+ runtests.hs view
@@ -0,0 +1,160 @@+{-# 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
web-encodings.cabal view
@@ -1,5 +1,5 @@ name: web-encodings-version: 0.2.0+version: 0.2.0.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -17,11 +17,7 @@ default: False library- if flag(buildtests)- Buildable: False- else- Buildable: True- build-depends: base >=4 && <5,+ build-depends: base >= 4 && <5, time >= 1.1.2.4 && < 1.2, old-locale >= 1.0.0.1 && < 1.1, bytestring >= 0.9.1.4 && < 0.10,@@ -41,9 +37,8 @@ test-framework-quickcheck, test-framework-hunit, HUnit,- QuickCheck >= 1 && < 2,- convertible >= 1.2.0 && < 1.3+ QuickCheck >= 1 && < 2 else Buildable: False ghc-options: -Wall- main-is: Test.hs+ main-is: runtests.hs