web-encodings 0.2.3 → 0.2.4
raw patch · 4 files changed
+402/−47 lines, 4 filesdep +convertible-textdep +directorydep +test-framework-quickcheck2dep −test-framework-quickcheckdep ~QuickCheckPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: convertible-text, directory, test-framework-quickcheck2, wai
Dependencies removed: test-framework-quickcheck
Dependency ranges changed: QuickCheck
API changes (from Hackage documentation)
- Web.Encodings: instance (Show s) => Show (FileInfo s a)
+ Web.Encodings: Sink :: IO x -> (x -> ByteString -> IO x) -> (x -> IO y) -> (y -> IO ()) -> Sink x y
+ Web.Encodings: data Sink x y
+ Web.Encodings: instance (Eq s, Eq c) => Eq (FileInfo s c)
+ Web.Encodings: instance (Show s, Show c) => Show (FileInfo s c)
+ Web.Encodings: instance Show (ParseState x)
+ Web.Encodings: lbsSink :: Sink ([ByteString] -> [ByteString]) ByteString
+ Web.Encodings: parseRequestBody :: Sink x y -> Request -> IO ([(ByteString, ByteString)], [(ByteString, FileInfo ByteString y)])
+ Web.Encodings: sinkAppend :: Sink x y -> x -> ByteString -> IO x
+ Web.Encodings: sinkClose :: Sink x y -> x -> IO y
+ Web.Encodings: sinkFinalize :: Sink x y -> y -> IO ()
+ Web.Encodings: sinkInit :: Sink x y -> IO x
+ Web.Encodings: tempFileSink :: Sink (FilePath, Handle) FilePath
+ Web.Encodings.StringLike: chompStart :: (StringLike a) => a -> a
+ Web.Encodings.StringLike: takeLineMaybe :: (StringLike a) => a -> Maybe (a, a)
+ Web.Encodings.StringLike: takeUntilBlankMaybe :: (StringLike a) => a -> Maybe ([a], a)
Files
- Web/Encodings.hs +256/−26
- Web/Encodings/StringLike.hs +20/−0
- runtests.hs +119/−17
- web-encodings.cabal +7/−4
Web/Encodings.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-} --------------------------------------------------------- -- | -- Module : Web.Encodings@@ -42,6 +44,11 @@ , parseHttpAccept -- * Date/time encoding , formatW3+ -- * WAI-specific decodings+ , parseRequestBody+ , Sink (..)+ , lbsSink+ , tempFileSink ) where import Numeric (showHex)@@ -62,6 +69,14 @@ import Data.Typeable (Typeable) import Control.Exception (Exception) import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import Data.Maybe (catMaybes)+import Data.Either (partitionEithers)+import Network.Wai+import System.Directory (getTemporaryDirectory, removeFile)+import System.IO+import Control.Monad (foldM) -- | Encode all but unreserved characters with percentage encoding. --@@ -295,28 +310,15 @@ , fileContentType :: s , fileContent :: c }-instance Show s => Show (FileInfo s a) where- show (FileInfo fn ct _) =- "FileInfo: " ++ show fn ++ " (" ++ show ct ++ ")"+ deriving (Eq, Show) -- | Parse a multipart form into parameters and files. parseMultipart :: StringLike s => String -- ^ boundary -> s -- ^ content -> ([(s, s)], [(s, FileInfo s s)])-parseMultipart boundary content =- let pieces = getPieces boundary content- getJusts [] = []- getJusts (Nothing:rest) = getJusts rest- getJusts ((Just x):rest) = x : getJusts rest- getLefts [] = []- getLefts (Left x:rest) = x : getLefts rest- getLefts (Right _:rest) = getLefts rest- getRights [] = []- getRights (Left _:rest) = getRights rest- getRights (Right x:rest) = x : getRights rest- pieces' = getJusts $ map parsePiece pieces- in (getLefts pieces', getRights pieces')+parseMultipart boundary =+ partitionEithers . catMaybes . map parsePiece . getPieces boundary -- | Parse a single segment of a multipart/form-data POST. parsePiece :: (StringLike s, MonadFailure (AttributeNotFound s) m)@@ -343,14 +345,6 @@ => String -- ^ boundary -> s -- ^ content -> [s]-{- FIXME this would be nice...-getPieces b c =- let fullBound = ord '-' `BS.cons'` (ord '-' `BS.cons'` b)- pieces = fullBound `BS.split` c- in filter (/= toLazyByteString "--") $- filter (not . BS.null) $- map chompBS pieces--} getPieces _ c | SL.null c = [] getPieces b c = let fullBound = SL.pack $ '-' `SL.cons` ('-' `SL.cons` b)@@ -386,10 +380,14 @@ ((x, _):_) -> x [] -> 0 content = SL.take len body- urlenc = "application/x-www-form-urlencoded"- formBound = "multipart/form-data; boundary=" boundProcessed = drop (length formBound) ctype +urlenc :: String+urlenc = "application/x-www-form-urlencoded"++formBound :: String+formBound = "multipart/form-data; boundary="+ {-# DEPRECATED decodeCookies "Please use parseCookies instead" #-} -- | Deprecate alias for 'parseCookies'. decodeCookies :: StringLike s => s -> [(s, s)]@@ -441,3 +439,235 @@ -- | Format a 'UTCTime' in W3 format; useful for setting cookies. formatW3 :: UTCTime -> String formatW3 = formatTime defaultTimeLocale "%FT%X-00:00"++-- | A destination for data, the opposite of a 'Source'.+data Sink x y = Sink+ { sinkInit :: IO x+ , sinkAppend :: x -> BS.ByteString -> IO x+ , sinkClose :: x -> IO y+ , sinkFinalize :: y -> IO ()+ }++lbsSink :: Sink ([BS.ByteString] -> [BS.ByteString]) BL.ByteString+lbsSink = Sink+ { sinkInit = return id+ , sinkAppend = \front bs -> return $ front . (:) bs+ , sinkClose = \front -> return $ BL.fromChunks $ front []+ , sinkFinalize = \_ -> return ()+ }++tempFileSink :: Sink (FilePath, Handle) FilePath+tempFileSink = Sink+ { sinkInit = do+ tempDir <- getTemporaryDirectory+ openBinaryTempFile tempDir "webenc.buf"+ , sinkAppend = \(fp, h) bs -> BS.hPut h bs >> return (fp, h)+ , sinkClose = \(fp, h) -> do+ hClose h+ return fp+ , sinkFinalize = \fp -> removeFile fp+ }++-- | This function works just like 'parsePost', which two important distinctions:+--+-- * It runs on a 'Source', which is the datatype used by the WAI for feeding a+-- request body.+--+-- * It allows you to specify a 'Sink' for receiving each individual file+-- parameter, so that you can avoid allocating large amounts of memory if+-- desired.+--+-- Remember that it is your obligation to call 'sinkFinalize' on the returned+-- values.+parseRequestBody :: Sink x y+ -> Request+ -> IO ([(BL.ByteString, BL.ByteString)],+ [(BS.ByteString, FileInfo BS.ByteString y)])+parseRequestBody sink req = do+ let ctype = do+ {- NOTE: Ignoring length, WAI must handle it+ clen' <- lookup ReqContentLength $ requestHeaders req+ clen'' <- readMay $ B8.unpack clen'+ -}+ ctype' <- lookup ReqContentType $ requestHeaders req+ if B8.pack urlenc `BS.isPrefixOf` ctype'+ then Just Nothing+ else if B8.pack formBound `BS.isPrefixOf` ctype'+ then Just $ Just (BS.drop (length formBound) ctype')+ else Nothing+ case ctype of+ Nothing -> return ([], [])+ Just Nothing -> do+ lbs <- sourceToLbsStrict $ requestBody req+ return (decodeUrlPairs lbs, [])+ Just (Just bound) ->+ parsePieces sink (PSBegin id) bound BS.empty (requestBody req) id id++type PieceReturn sink =+ Either+ (BL.ByteString, BL.ByteString)+ (BS.ByteString, FileInfo BS.ByteString sink)++data ParseState seed+ = PSBegin ([BS.ByteString] -> [BS.ByteString])+ | PSParam BL.ByteString BL.ByteString+ | PSFile BL.ByteString BL.ByteString BL.ByteString seed BS.ByteString+ | PSNothing+instance Show (ParseState x) where+ show (PSBegin x) = show ("PSBegin", B8.unpack $ B8.concat $ x [])+ show (PSParam x y) = show ("PSParam", x, y)+ show (PSFile x y z _ _) = show ("PSFile", x, y, z)+ show PSNothing = "PSNothing"++-- | Parse a single segment of a multipart/form-data POST.+parsePiece' :: Sink x y+ -> ParseState x+ -> BS.ByteString+ -> IO (ParseState x)+parsePiece' sink (PSBegin front) bs =+ case SL.takeUntilBlankMaybe $ BL.fromChunks $ front [bs] of+ Nothing -> return $ PSBegin $ front . (:) bs+ Just (headers', content) ->+ let headers = map parseHeader headers'+ name = lookupHeaderAttr+ (SL.pack "Content-Disposition")+ (SL.pack "name")+ headers+ fname = lookupHeaderAttr+ (SL.pack "Content-Disposition")+ (SL.pack "filename")+ headers+ ctype = lookupHeader (SL.pack "Content-Type") headers+ in case (name, fname, ctype) of+ (Just name', Nothing, _) ->+ return $ PSParam name' content+ (Just name', Just fname', Just ctype') -> do+ seed <- sinkInit sink+ (seed', hasNewLine)+ <- foldM (sinkAppendNL sink) (seed, BS.empty)+ $ BL.toChunks content+ return $ PSFile name' fname' ctype' seed' hasNewLine+ _ -> return PSNothing+parsePiece' _ PSNothing _ = return PSNothing+parsePiece' _ (PSParam name content) bs =+ return $ PSParam name $ BL.append content $ BL.fromChunks [bs]+parsePiece' sink (PSFile name fname ctype seed newLine) bs = do+ let (bs', newLine') = mychomp bs+ seed' <- sinkAppend sink seed newLine+ seed'' <- sinkAppend sink seed' bs'+ return $ PSFile name fname ctype seed'' newLine'++mychomp :: BS.ByteString -> (BS.ByteString, BS.ByteString)+mychomp bs+ | BS.null bs = (bs, BS.empty)+ | B8.last bs == '\n' && BS.null (BS.init bs) = (BS.empty, bs)+ | B8.last bs == '\n' && B8.last (BS.init bs) == '\r' =+ (BS.init $ BS.init bs, B8.pack "\r\n")+ | B8.last bs == '\n' = (BS.init bs, B8.pack "\n")+ | otherwise = (bs, BS.empty)++-- | Removes one new line from end.+sinkAppendNL :: Sink x y -> (x, BS.ByteString) -> BS.ByteString+ -> IO (x, BS.ByteString)+sinkAppendNL sink (seed, prev) bs = do+ seed' <- sinkAppend sink seed prev+ let (bs', prev') = mychomp bs+ seed'' <- sinkAppend sink seed' bs'+ return (seed'', prev')++type Param = (BL.ByteString, BL.ByteString)+type File y = (BS.ByteString, FileInfo BS.ByteString y)++parsePieces :: Sink x y+ -> ParseState x+ -> BS.ByteString+ -> BS.ByteString+ -> Source+ -> ([Param] -> [Param])+ -> ([File y] -> [File y])+ -> IO ([Param], [File y])+parsePieces sink pstate boundary prev (Source source) frontp frontf = do+ res <- source+ case res of+ Nothing -> do+ (pstate', prev', frontp', frontf') <- go prev+ if BS.null prev' || prev == prev' -- second clause ensures termination+ then return (frontp' [], frontf' [])+ else parsePieces sink pstate' boundary prev' (Source $ return Nothing) frontp' frontf'+ Just (bs', source') -> do+ let bs = BS.append prev bs'+ (pstate', prev', frontp', frontf') <- go bs+ parsePieces sink pstate' boundary prev' source' frontp' frontf'+ where+ go bs =+ case hasBound boundary bs of+ NoBound -> do+ pstate' <- parsePiece' sink pstate bs+ return (pstate', BS.empty, frontp, frontf)+ MaybeBound -> return (pstate, bs, frontp, frontf)+ HasBound before after -> do+ pstate' <- parsePiece' sink pstate before+ es <- extractState sink pstate'+ let (frontp', frontf') =+ case es of+ Nothing -> (frontp, frontf)+ Just (Left p) -> (frontp . (:) p, frontf)+ Just (Right f) -> (frontp, frontf . (:) f)+ return (PSBegin id, after, frontp', frontf')++extractState :: Sink x y+ -> ParseState x+ -> IO (Maybe (PieceReturn y))+extractState _ (PSBegin _) = return Nothing+extractState _ PSNothing = return Nothing+extractState _ (PSParam name val) =+ return $ Just $ Left (name, SL.chomp val)+extractState sink (PSFile name fname ctype seed _newLine) = do+ output <- sinkClose sink seed+ return $ Just $ Right (BS.concat $ BL.toChunks name, FileInfo+ { fileName = BS.concat $ BL.toChunks fname+ , fileContentType = BS.concat $ BL.toChunks ctype+ , fileContent = output+ })++data HasBound = NoBound | MaybeBound | HasBound BS.ByteString BS.ByteString+hasBound :: BS.ByteString -> BS.ByteString -> HasBound+hasBound bound content =+ case notEmpty $ BS.breakSubstring fullBound1 content of+ Just (before, after) ->+ let after' = BS.drop (BS.length fullBound1) after+ in HasBound before $ SL.chompStart after'+ Nothing ->+ case notEmpty $ BS.breakSubstring fullBound2 content of+ Just (before, after) ->+ let after' = BS.drop (BS.length fullBound2) after+ in HasBound before $ SL.chompStart after'+ Nothing ->+ case notEmpty $ BS.breakSubstring fullBound3 content of+ Just (before, after) ->+ let after' = BS.drop (BS.length fullBound3) after+ in HasBound before $ SL.chompStart after'+ Nothing ->+ if endsWithBound+ then MaybeBound+ else NoBound+ where+ fullBound' = B8.cons '-' $ B8.cons '-' bound+ fullBound1 = fullBound' `B8.snoc` '\n'+ fullBound2 = fullBound' `B8.snoc` '\r' `B8.snoc` '\n'+ fullBound3 = fullBound' `B8.snoc` '-' `B8.snoc` '-'+ endsWithBound =+ or $ map (\x -> x `BS.isSuffixOf` content)+ $ (BS.inits fullBound2 ++ BS.inits fullBound3)+ notEmpty (x, y)+ | BS.null y = Nothing+ | otherwise = Just (x, y)++sourceToLbsStrict :: Source -> IO BL.ByteString+sourceToLbsStrict source0 = go source0 id+ where+ go (Source source) front = do+ res <- source+ case res of+ Nothing -> return $ BL.fromChunks $ front []+ Just (bs, source') -> go source' $ front . (:) bs
Web/Encodings/StringLike.hs view
@@ -65,6 +65,14 @@ '\n' -> chomp $ init s '\r' -> chomp $ init s _ -> s+ chompStart :: a -> a+ chompStart s = case uncons s of+ Just ('\r', rest) ->+ case uncons rest of+ Just ('\n', rest') -> rest'+ _ -> s+ Just ('\n', rest) -> rest+ _ -> s split :: Char -> a -> [a] split c s = let (next, rest) = breakChar c s@@ -109,6 +117,10 @@ let (x, y) = breakChar '\n' a x' = chomp x in (x', y)+ takeLineMaybe :: a -> Maybe (a, a)+ takeLineMaybe a = do+ (x, y) <- breakCharMaybe '\n' a+ Just (chomp x, y) takeUntilBlank :: a -> ([a], a) takeUntilBlank a = let (next, rest) = takeLine a@@ -116,6 +128,14 @@ then ([], rest) else let (nexts, rest') = takeUntilBlank rest in (next : nexts, rest')+ takeUntilBlankMaybe :: a -> Maybe ([a], a)+ takeUntilBlankMaybe a = do+ (next, rest) <- takeLineMaybe a+ if null next+ then Just ([], rest)+ else do+ (nexts, rest') <- takeUntilBlankMaybe rest+ Just (next : nexts, rest') lengthLT :: Int -> a -> Bool lengthLT i _ | i <= 0 = False
runtests.hs view
@@ -8,7 +8,7 @@ import Test.QuickCheck import Web.Encodings-import Data.Char (chr, ord)+import Data.Convertible.Text (cs) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL@@ -19,6 +19,8 @@ import qualified Web.Encodings.StringLike as SL import Web.Encodings.StringLike (StringLike) import Control.Arrow ((***))+import qualified Data.ByteString as B+import Network.Wai main :: IO () main = defaultMain [tests]@@ -36,7 +38,6 @@ , testCase "decode URL pairs" $ caseDecodeUrlPairs s , testCase "parse cookies" $ caseParseCookies s , testCase "parse http accept" $ caseParseHttpAccept s- -- FIXME , testCase "parse post" huParsePost , testCase "hebrew query string encode" $ caseHebrewQueryStringEncode s , testCase "hebrew query string decode" $ caseHebrewQueryStringDecode s , testCase "bad query string decode" $ caseBadQueryStringDecode s@@ -49,6 +50,8 @@ , allTests "Lazy ByteString" (undefined :: BL.ByteString) , allTests "Strict Text" (undefined :: TS.Text) , allTests "Lazy Text" (undefined :: TL.Text)+ , testCase "parse post" huParsePost+ , testCase "parse request body" huParseRequestBody ] qcEncodeDecodeUrl :: StringLike a => a -> a -> Bool@@ -113,48 +116,47 @@ instance Arbitrary TL.Text where arbitrary = fmap SL.pack arbitrary -{- FIXME+huParsePost :: Assertion huParsePost = t where- content2 = BSLU.fromString $+ content2 = cs $ "--AaB03x\n" ++ "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" ++- "Content-Type: text/plain; charset=iso-8859-1\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" +++ "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" +++ "Content-Type: text/plain; charset=iso-8859-1\n\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 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"- ([("foo", "bar"), ("baz", "bin")], [])+ (map (cs *** cs) [("foo", "bar"), ("baz", "bin")], []) result1 - let ctype2 = BSLU.fromString "multipart/form-data; boundary=AaB03x"- let len2 = BSLU.fromString $ show $ BS.length content2+ 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 =- [ ("document", "b.txt", "text/plain", BSLU.fromString $- "This is a file.\nIt has two lines.\n") ]- let expected2 = (expectedsmap2, 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@@ -196,3 +198,103 @@ encoded = SL.pack raw `asTypeOf` dummy expected = SL.unpackUtf8 bs expected @=? decodeUrlFailure encoded++huParseRequestBody :: Assertion+huParseRequestBody = 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--"+ content3 = cs "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\nContent-Disposition: form-data; name=\"yaml\"; filename=\"README\"\r\nContent-Type: application/octet-stream\r\n\r\nPhoto blog using Hack.\n\r\n------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n"+ t = do+ let content1 = cs "foo=bar&baz=bin"+ let ctype1 = cs "application/x-www-form-urlencoded"+ result1 <- parseRequestBody lbsSink $ toRequest ctype1 content1+ assertEqual "parsing post x-www-form-urlencoded"+ (map (cs *** cs) [("foo", "bar"), ("baz", "bin")], [])+ result1++ let ctype2 = cs "multipart/form-data; boundary=AaB03x"+ result2 <- parseRequestBody lbsSink $ toRequest ctype2 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++ let ctype3 = cs "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"+ result3 <- parseRequestBody lbsSink $ toRequest ctype3 content3+ let expectedsmap3 = []+ let expectedfile3 = [(cs "yaml", FileInfo (cs "README") (cs "application/octet-stream") $+ cs "Photo blog using Hack.\n")]+ let expected3 = (expectedsmap3, expectedfile3)+ assertEqual "parsing actual post multipart/form-data"+ expected3+ result3++ result2' <- parseRequestBody lbsSink $ toRequest' ctype2 content2+ assertEqual "parsing post multipart/form-data 2"+ expected2+ result2+ putStrLn "\n\n\n\n\n"+ result3' <- parseRequestBody lbsSink $ toRequest' ctype3 content3+ assertEqual "parsing actual post multipart/form-data 2"+ expected3+ result3'++toRequest :: BS.ByteString -> BS.ByteString -> Request+toRequest ctype content = Request+ { requestHeaders = [(ReqContentType, ctype)]+ , requestBody = toSource content+ , requestMethod = undefined+ , httpVersion = undefined+ , pathInfo = undefined+ , queryString = undefined+ , serverName = undefined+ , serverPort = undefined+ , urlScheme = undefined+ , errorHandler = undefined+ , remoteHost = undefined+ }++toRequest' :: BS.ByteString -> BS.ByteString -> Request+toRequest' ctype content = Request+ { requestHeaders = [(ReqContentType, ctype)]+ , requestBody = toSource' content+ , requestMethod = undefined+ , httpVersion = undefined+ , pathInfo = undefined+ , queryString = undefined+ , serverName = undefined+ , serverPort = undefined+ , urlScheme = undefined+ , errorHandler = undefined+ , remoteHost = undefined+ }++toSource :: BS.ByteString -> Source+toSource bs = Source $+ case B.uncons bs of+ Nothing -> return Nothing+ Just (x, xs) -> return $ Just (B.singleton x, toSource xs)++toSource' :: BS.ByteString -> Source+toSource' bs = Source $ return $ Just (bs, Source $ return Nothing)
web-encodings.cabal view
@@ -1,5 +1,5 @@ name: web-encodings-version: 0.2.3+version: 0.2.4 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -23,7 +23,9 @@ bytestring >= 0.9.1.4 && < 0.10, text >= 0.5 && < 0.8, failure >= 0.0.0 && < 0.1,- safe >= 0.2 && < 0.3+ safe >= 0.2 && < 0.3,+ wai >= 0.0.0 && < 0.1,+ directory >= 1 && < 1.1 exposed-modules: Web.Encodings Web.Encodings.MimeHeader, Web.Encodings.StringLike,@@ -34,10 +36,11 @@ if flag(buildtests) Buildable: True build-depends: test-framework,- test-framework-quickcheck,+ test-framework-quickcheck2, test-framework-hunit, HUnit,- QuickCheck >= 1 && < 2+ QuickCheck >= 2 && < 3,+ convertible-text >= 0.2.0 && < 0.3 else Buildable: False ghc-options: -Wall