X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEParams.hs;h=e4e4271a6fcdd405b25804c113778f4158ae344a;hp=6f9eb7e1b8a9f4055b0bc878578d6b2679952991;hb=90fca0675b1694e69b8e431c989343855cbd125d;hpb=5f2ef377345fc47aabc63c1325df82c1cd9da9ed diff --git a/Network/HTTP/Lucu/MIMEParams.hs b/Network/HTTP/Lucu/MIMEParams.hs index 6f9eb7e..e4e4271 100644 --- a/Network/HTTP/Lucu/MIMEParams.hs +++ b/Network/HTTP/Lucu/MIMEParams.hs @@ -16,7 +16,6 @@ -- (). module Network.HTTP.Lucu.MIMEParams ( MIMEParams - , mimeParams ) where import Control.Applicative hiding (empty) @@ -34,6 +33,7 @@ import qualified Data.Collections.Newtype.TH as C import Data.Convertible.Base import Data.Convertible.Instances.Ascii () import Data.Convertible.Utils +import Data.Default import qualified Data.Map as M (Map) import Data.Monoid.Unicode import Data.Sequence (Seq) @@ -145,34 +145,33 @@ section ∷ ExtendedParam → Integer section (InitialEncodedParam {..}) = 0 section ep = epSection ep --- |'Parser' for MIME parameter values. -mimeParams ∷ Parser MIMEParams -{-# INLINEABLE mimeParams #-} -mimeParams = decodeParams =≪ many (try paramP) +instance Default (Parser MIMEParams) where + {-# INLINE def #-} + def = decodeParams =≪ many (try def) -paramP ∷ Parser ExtendedParam -paramP = do skipMany lws - void $ char ';' - skipMany lws - epm ← nameP - void $ char '=' - case epm of - (name, 0, True) - → do (charset, payload) ← initialEncodedValue - return $ InitialEncodedParam name charset payload - (name, sect, True) - → do payload ← encodedPayload - return $ ContinuedEncodedParam name sect payload - (name, sect, False) - → do payload ← token <|> quotedStr - return $ AsciiParam name sect payload +instance Default (Parser ExtendedParam) where + def = do skipMany lws + void $ char ';' + skipMany lws + epm ← name + void $ char '=' + case epm of + (nm, 0, True) + → do (charset, payload) ← initialEncodedValue + return $ InitialEncodedParam nm charset payload + (nm, sect, True) + → do payload ← encodedPayload + return $ ContinuedEncodedParam nm sect payload + (nm, sect, False) + → do payload ← token <|> quotedStr + return $ AsciiParam nm sect payload -nameP ∷ Parser (CIAscii, Integer, Bool) -nameP = do name ← (cs ∘ A.unsafeFromByteString) <$> - takeWhile1 (\c → isToken c ∧ c ≢ '*') - sect ← option 0 $ try (char '*' *> decimal ) - isEncoded ← option False $ try (char '*' *> pure True) - return (name, sect, isEncoded) +name ∷ Parser (CIAscii, Integer, Bool) +name = do nm ← (cs ∘ A.unsafeFromByteString) <$> + takeWhile1 (\c → isToken c ∧ c ≢ '*') + sect ← option 0 $ try (char '*' *> decimal ) + isEncoded ← option False $ try (char '*' *> pure True) + return (nm, sect, isEncoded) initialEncodedValue ∷ Parser (CIAscii, BS.ByteString) initialEncodedValue