web-encodings 0.2.1 → 0.2.2

raw patch · 4 files changed

+79/−25 lines, 4 filesdep −splitdep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: split

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• Web/Encodings.hs +43/−20
• Web/Encodings/StringLike.hs +16/−1
• runtests.hs +17/−0
• web-encodings.cabal +3/−4

@@ -34,13 +34,14 @@     , parsePost       -- ** Specific HTTP headers     , decodeCookies+    , parseCookies     , parseHttpAccept       -- * Date/time encoding     , formatW3     ) where  import Numeric (showHex)-import Data.List (isPrefixOf)+import Data.List (isPrefixOf, sortBy) import Web.Encodings.MimeHeader import Data.Maybe (fromMaybe) @@ -53,7 +54,7 @@ import Control.Failure import Safe import Data.Char (ord, isControl)-import Data.List.Split (splitOneOf)+import Data.Function (on)  -- | Encode all but unreserved characters with percentage encoding. --@@ -342,31 +343,53 @@         formBound = "multipart/form-data; boundary="         boundProcessed = drop (length formBound) ctype +{-# DEPRECATED decodeCookies "Please use parseCookies instead" #-}+-- | Deprecate alias for 'parseCookies'.+decodeCookies :: StringLike s => s -> [(s, s)]+decodeCookies = parseCookies+ -- | Decode the value of an HTTP_COOKIE header into key/value pairs.-decodeCookies :: String -> [(String, String)]-decodeCookies [] = []-decodeCookies s =-    let (first, rest) = break (== ';') s-     in decodeCookie first : decodeCookies (dropWhile (== ';') rest)+parseCookies :: StringLike s => s -> [(s, s)]+parseCookies s+  | SL.null s = []+  | otherwise =+    let (first, rest) = SL.break (== ';') s+     in parseCookie first : parseCookies (SL.dropWhile (== ';') rest) -decodeCookie :: String -> (String, String)-decodeCookie s =-    let (key, value) = break (== '=') s-        key' = dropWhile (== ' ') key+parseCookie :: StringLike s => s -> (s, s)+parseCookie s =+    let (key, value) = SL.break (== '=') s+        key' = SL.dropWhile (== ' ') key         value' =-          case value of-            ('=':rest) -> rest-            x -> x+          case SL.uncons value of+            Just ('=', rest) -> rest+            _ -> value      in (key', value')  -- | Parse the HTTP accept string to determine supported content types.-parseHttpAccept :: String -> [String]-parseHttpAccept = filter (not . specialHttpAccept) . splitOneOf ";,"+parseHttpAccept :: StringLike s => s -> [s]+parseHttpAccept = map fst+                . sortBy (rcompare `on` snd)+                . map grabQ+                . SL.split ',' -specialHttpAccept :: String -> Bool-specialHttpAccept ('q':'=':_) = True-specialHttpAccept ('*':_) = True-specialHttpAccept _ = False+rcompare :: Ord a => a -> a -> Ordering+rcompare x y = case compare x y of+    LT -> GT+    GT -> LT+    EQ -> EQ++grabQ :: StringLike s => s -> (s, Double)+grabQ s =+    let (s', q) = SL.breakChar ';' s+        (_, q') = SL.breakChar '=' q+     in (trimWhite s', readQ $ trimWhite q')++readQ :: StringLike s => s -> Double+readQ = Safe.readDef 1.0 . SL.unpack++trimWhite :: StringLike s => s -> s+trimWhite = SL.dropWhile (== ' ')  -- | Format a 'UTCTime' in W3 format; useful for setting cookies. formatW3 :: UTCTime -> String

@@ -4,7 +4,7 @@     ) where  import Prelude (Char, Bool (..), String, Int, Eq (..), Show, ($), (.),-                (<=), (-), otherwise, Maybe (..), (&&), not)+                (<=), (-), otherwise, Maybe (..), (&&), not, elem) import qualified Prelude as P import qualified Data.List as L import qualified Web.Encodings.ListHelper as LH@@ -64,6 +64,19 @@          in if null next                 then (if null rest then [] else [rest])                 else next : split c rest+    splitOneOf :: [Char] -> a -> [a]+    splitOneOf cs s =+        let (next, rest) = breakChars cs s+         in if null next+                then (if null rest then [] else [rest])+                else next : splitOneOf cs rest+    breakCharsMaybe :: [Char] -> a -> Maybe (a, a)+    breakCharsMaybe c s+        | null s = Nothing+        | head s `elem` c = Just (empty, tail s)+        | otherwise = do+            (next, rest) <- breakCharsMaybe c (tail s)+            Just (cons (head s) next, rest)     breakCharMaybe :: Char -> a -> Maybe (a, a)     breakCharMaybe c s         | null s = Nothing@@ -73,6 +86,8 @@             Just (cons (head s) next, rest)     breakChar :: Char -> a -> (a, a)     breakChar c s = fromMaybe (s, empty) $ breakCharMaybe c s+    breakChars :: [Char] -> a -> (a, a)+    breakChars c s = fromMaybe (s, empty) $ breakCharsMaybe c s     breakString :: a -> a -> (a, a)     breakString _ c | null c = (empty, empty)     breakString p c = case dropPrefix p c of

@@ -32,6 +32,8 @@     , 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     ] @@ -158,3 +160,18 @@     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

@@ -1,5 +1,5 @@ name:            web-encodings-version:         0.2.1+version:         0.2.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -21,10 +21,9 @@                      time >= 1.1.2.4 && < 1.2,                      old-locale >= 1.0.0.1 && < 1.1,                      bytestring >= 0.9.1.4 && < 0.10,-                     text >= 0.5 && < 0.6,+                     text >= 0.5 && < 0.8,                      failure >= 0.0.0 && < 0.1,-                     safe >= 0.2 && < 0.3,-                     split >= 0.1.2 && < 0.2+                     safe >= 0.2 && < 0.3     exposed-modules: Web.Encodings                      Web.Encodings.MimeHeader,                      Web.Encodings.StringLike,