+
+data ExtendedParam
+ = InitialEncodedParam {
+ epName ∷ !CIAscii
+ , epCharset ∷ !CIAscii
+ , epPayload ∷ !BS.ByteString
+ }
+ | ContinuedEncodedParam {
+ epName ∷ !CIAscii
+ , epSection ∷ !Integer
+ , epPayload ∷ !BS.ByteString
+ }
+ | AsciiParam {
+ epName ∷ !CIAscii
+ , epSection ∷ !Integer
+ , apPayload ∷ !Ascii
+ }
+
+paramsP ∷ Parser (Map CIAscii Text)
+paramsP = decodeParams <$> P.many (try paramP)
+ where
+ paramP ∷ Parser ExtendedParam
+ paramP = do skipMany lws
+ _ ← char ';'
+ skipMany lws
+ epm ← nameP
+ _ ← char '='
+ case epm of
+ (name, 0, True)
+ → do (charset, payload) ← initialEncodedValue
+ return $ InitialEncodedParam name charset payload
+ (name, section, True)
+ → do payload ← encodedPayload
+ return $ ContinuedEncodedParam name section payload
+ (name, section, False)
+ → do payload ← token <|> quotedStr
+ return $ AsciiParam name section payload
+
+ nameP ∷ Parser (CIAscii, Integer, Bool)
+ nameP = do name ← (A.toCIAscii ∘ A.unsafeFromByteString) <$>
+ takeWhile1 (\c → isToken c ∧ c ≢ '*')
+ section ← option 0 $
+ try $
+ do _ ← char '*'
+ n ← decimal
+ return n
+ isEncoded ← option False $
+ do _ ← char '*'
+ return True
+ return (name, section, isEncoded)
+
+ initialEncodedValue ∷ Parser (CIAscii, BS.ByteString)
+ initialEncodedValue = do charset ← metadata
+ _ ← char '\''
+ _ ← metadata -- Ignore the language tag
+ _ ← char '\''
+ payload ← encodedPayload
+ return (charset, payload)
+ where
+ metadata ∷ Parser CIAscii
+ metadata = (A.toCIAscii ∘ A.unsafeFromByteString) <$>
+ takeWhile (\c → isToken c ∧ c ≢ '\'')
+
+ encodedPayload ∷ Parser BS.ByteString
+ encodedPayload = BS.concat <$> P.many (hexChar <|> literal)
+ where
+ hexChar ∷ Parser BS.ByteString
+ hexChar = do _ ← char '%'
+ h ← satisfy isHexChar
+ l ← satisfy isHexChar
+ return $ BS.singleton $ hexToChar h l
+
+ isHexChar ∷ Char → Bool
+ isHexChar = inClass "0-9a-fA-F"
+
+ hexToChar ∷ Char → Char → Char
+ hexToChar h l
+ = chr $ (hexToInt h `shiftL` 8) .&. hexToInt l
+
+ hexToInt ∷ Char → Int
+ hexToInt c
+ | c ≤ '9' = ord c - ord '0'
+ | c ≤ 'F' = ord c - ord 'A' + 10
+ | otherwise = ord c - ord 'a' + 10
+
+ literal ∷ Parser BS.ByteString
+ literal = takeWhile1 (\c → isToken c ∧ c ≢ '%')
+
+ decodeParams ∷ [ExtendedParam] → Map CIAscii Text
+ decodeParams = error "FIXME"