+{-# LANGUAGE
+ OverloadedStrings
+ , UnicodeSyntax
+ #-}
+-- |Provide facilities to encode/decode MIME parameter values in
+-- character sets other than US-ASCII. See:
+-- http://www.faqs.org/rfcs/rfc2231.html
+module Network.HTTP.Lucu.RFC2231
+ ( printParams
+-- , paramsP
+ )
+ where
+import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
+import qualified Data.Ascii as A
+import Data.Bits
+import qualified Data.ByteString.Char8 as BS
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Monoid.Unicode
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding
+import Data.Word
+import Network.HTTP.Lucu.Parser.Http
+import Network.HTTP.Lucu.Utils
+import Prelude.Unicode
+
+printParams ∷ Map CIAscii Text → AsciiBuilder
+printParams params
+ | M.null params = (∅)
+ | otherwise = A.toAsciiBuilder "; " ⊕
+ joinWith "; " (map printPair $ M.toList params)
+ where
+ printPair ∷ (CIAscii, Text) → AsciiBuilder
+ printPair (name, value)
+ | T.any (> '\xFF') value
+ = printPairInUTF8 name value
+ | otherwise
+ = printPairInAscii name (A.unsafeFromByteString $ encodeUtf8 value)
+
+ printPairInUTF8 ∷ CIAscii → Text → AsciiBuilder
+ printPairInUTF8 name value
+ = A.toAsciiBuilder (A.fromCIAscii name) ⊕
+ A.toAsciiBuilder "*=utf-8''" ⊕
+ escapeUnsafeChars (encodeUtf8 value) (∅)
+
+ printPairInAscii ∷ CIAscii → Ascii → AsciiBuilder
+ printPairInAscii name value
+ = A.toAsciiBuilder (A.fromCIAscii name) ⊕
+ A.toAsciiBuilder "=" ⊕
+ if BS.any ((¬) ∘ isToken) (A.toByteString value) then
+ quoteStr value
+ else
+ A.toAsciiBuilder value
+
+ escapeUnsafeChars ∷ BS.ByteString → AsciiBuilder → AsciiBuilder
+ escapeUnsafeChars bs b
+ = case BS.uncons bs of
+ Nothing → b
+ Just (c, bs')
+ | isToken c → escapeUnsafeChars bs' $
+ b ⊕ A.toAsciiBuilder (A.unsafeFromString [c])
+ | otherwise → escapeUnsafeChars bs' $
+ b ⊕ toHex (fromIntegral $ fromEnum c)
+
+ toHex ∷ Word8 → AsciiBuilder
+ toHex o = A.toAsciiBuilder "%" ⊕
+ A.toAsciiBuilder (A.unsafeFromString [ toHex' (o `shiftR` 8)
+ , toHex' (o .&. 0x0F) ])
+
+ toHex' ∷ Word8 → Char
+ toHex' o
+ | o ≤ 0x09 = toEnum $ fromIntegral $ fromEnum '0' + fromIntegral o
+ | otherwise = toEnum $ fromIntegral $ fromEnum 'A' + fromIntegral (o - 0x0A)
+
+{-
+decode ∷ [(CIAscii, Ascii)] → Map CIAscii Text
+{-# INLINEABLE decode #-}
+decode = error "FIXME: not implemented"
+-}
\ No newline at end of file