RFC2231.printParams

[Lucu.git] / Network / HTTP / Lucu / RFC2231.hs

diff --git a/Network/HTTP/Lucu/RFC2231.hs b/Network/HTTP/Lucu/RFC2231.hs
new file mode 100644 (file)
index 0000000..9e99829
--- /dev/null
+++ b/Network/HTTP/Lucu/RFC2231.hs
@@ -0,0 +1,80 @@
+{-# 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