New module: Network.HTTP.Lucu.MIMEType.TH

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

diff --git a/Network/HTTP/Lucu/RFC2231.hs b/Network/HTTP/Lucu/MIMEParams.hs
similarity index 90%
rename from Network/HTTP/Lucu/RFC2231.hs
rename to Network/HTTP/Lucu/MIMEParams.hs
index 1046c5df516f47ebcb06bcaf1ea1228a381cba72..b3edeb5836745779d8f2820eae92b90d19f98fcf 100644 (file)
--- a/Network/HTTP/Lucu/RFC2231.hs
+++ b/Network/HTTP/Lucu/MIMEParams.hs
@@ -1,16 +1,17 @@
 {-# LANGUAGE
-    DoAndIfThenElse
+    DeriveDataTypeable
+  , DoAndIfThenElse
+  , GeneralizedNewtypeDeriving
   , OverloadedStrings
   , RecordWildCards
+  , TemplateHaskell
   , UnicodeSyntax
   #-}
--- |Provide functionalities to encode/decode MIME parameter values in
--- character sets other than US-ASCII. See:
--- <http://www.faqs.org/rfcs/rfc2231.html>
---
--- You usually don't have to use this module directly.
-module Network.HTTP.Lucu.RFC2231
-    ( printMIMEParams
+-- |Parsing and printing MIME parameter values
+-- (<http://tools.ietf.org/html/rfc2231>).
+module Network.HTTP.Lucu.MIMEParams
+    ( MIMEParams(..)
+    , printMIMEParams
     , mimeParams
     )
     where
@@ -23,9 +24,11 @@ import Data.Attoparsec.Char8 as P
 import Data.Bits
 import qualified Data.ByteString.Char8 as BS
 import Data.Char
+import Data.Data
 import Data.Foldable
 import Data.Map (Map)
 import qualified Data.Map as M
+import Data.Monoid
 import Data.Monoid.Unicode
 import Data.Sequence (Seq, ViewL(..))
 import qualified Data.Sequence as S
@@ -36,15 +39,29 @@ import Data.Text.Encoding
 import Data.Text.Encoding.Error
 import Data.Traversable
 import Data.Word
+import Language.Haskell.TH.Syntax
 import Network.HTTP.Lucu.Parser.Http
 import Network.HTTP.Lucu.Utils
 import Prelude hiding (concat, mapM, takeWhile)
 import Prelude.Unicode
 
+-- |A map from MIME parameter attributes to values. Attributes are
+-- always case-insensitive according to RFC 2045
+-- (<http://tools.ietf.org/html/rfc2045#section-5.1>).
+newtype MIMEParams
+    = MIMEParams (Map CIAscii Text)
+    deriving (Eq, Show, Read, Monoid, Typeable)
+
+instance Lift MIMEParams where
+    lift (MIMEParams m) = [| MIMEParams $(liftParams m) |]
+        where
+          liftParams ∷ Map CIAscii Text → Q Exp
+          liftParams = liftMap liftCIAscii liftText
+
 -- |Convert MIME parameter values to an 'AsciiBuilder'.
-printMIMEParams ∷ Map CIAscii Text → AsciiBuilder
+printMIMEParams ∷ MIMEParams → AsciiBuilder
 {-# INLINEABLE printMIMEParams #-}
-printMIMEParams m = M.foldlWithKey f (∅) m
+printMIMEParams (MIMEParams m) = M.foldlWithKey f (∅) m
     -- THINKME: Use foldlWithKey' for newer Data.Map
     where
       f ∷ AsciiBuilder → CIAscii → Text → AsciiBuilder
@@ -124,7 +141,7 @@ section (InitialEncodedParam {..}) = 0
 section ep                         = epSection ep
 
 -- |'Parser' for MIME parameter values.
-mimeParams ∷ Parser (Map CIAscii Text)
+mimeParams ∷ Parser MIMEParams
 {-# INLINEABLE mimeParams #-}
 mimeParams = decodeParams =≪ P.many (try paramP)
 
@@ -202,9 +219,9 @@ rawChars ∷ Parser BS.ByteString
 {-# INLINE rawChars #-}
 rawChars = takeWhile1 (\c → isToken c ∧ c ≢ '%')
 
-decodeParams ∷ Monad m ⇒ [ExtendedParam] → m (Map CIAscii Text)
+decodeParams ∷ (Functor m, Monad m) ⇒ [ExtendedParam] → m MIMEParams
 {-# INLINE decodeParams #-}
-decodeParams = (mapM decodeSections =≪) ∘ sortBySection
+decodeParams = (MIMEParams <$>) ∘ (mapM decodeSections =≪) ∘ sortBySection
 
 sortBySection ∷ Monad m
               ⇒ [ExtendedParam]