X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEParams.hs;h=fcfee9e36f43737b426e0f4e20d8b0ab03905908;hb=67f9e87;hp=f4b503ee6ddd176d3febb9e61aa0691967844070;hpb=bb121f1189d01b5089aa5c29f0d390fad36ade48;p=Lucu.git

diff --git a/Network/HTTP/Lucu/MIMEParams.hs b/Network/HTTP/Lucu/MIMEParams.hs
index f4b503e..fcfee9e 100644
--- a/Network/HTTP/Lucu/MIMEParams.hs
+++ b/Network/HTTP/Lucu/MIMEParams.hs
@@ -10,6 +10,8 @@
   , TypeSynonymInstances
   , UnicodeSyntax
   #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
 -- |Parsing and printing MIME parameter values
 -- (<http://tools.ietf.org/html/rfc2231>).
 module Network.HTTP.Lucu.MIMEParams
@@ -19,106 +21,39 @@ module Network.HTTP.Lucu.MIMEParams
     )
     where
 import Control.Applicative hiding (empty)
-import Control.Arrow
 import Control.Monad hiding (mapM)
 import Control.Monad.Unicode
 import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
 import qualified Data.Ascii as A
-import Data.Attoparsec.Char8 as P
+import Data.Attoparsec.Char8
 import Data.Bits
 import qualified Data.ByteString.Char8 as BS
 import Data.Char
 import Data.Collections
 import Data.Collections.BaseInstances ()
+import qualified Data.Collections.Newtype.TH as C
 import qualified Data.Map as M (Map)
-import Data.Monoid
 import Data.Monoid.Unicode
 import Data.Sequence (Seq)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding
 import Data.Text.Encoding.Error
-import Data.Typeable
 import Data.Word
-import Language.Haskell.TH.Syntax
+import Network.HTTP.Lucu.MIMEParams.Internal
 import Network.HTTP.Lucu.OrphanInstances ()
 import Network.HTTP.Lucu.Parser.Http
 import Network.HTTP.Lucu.Utils
-import Prelude hiding (concat, filter, foldr, lookup, mapM, null, takeWhile)
+import Prelude hiding (concat, lookup, 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 (M.Map CIAscii Text)
-    deriving (Eq, Show, Read, Monoid, Typeable)
-
-instance Lift MIMEParams where
-    lift (MIMEParams m) = [| MIMEParams $(lift m) |]
-
-instance Unfoldable MIMEParams (CIAscii, Text) where
-    {-# INLINE insert #-}
-    insert p (MIMEParams m)
-        = MIMEParams $ insert p m
-    {-# INLINE empty #-}
-    empty
-        = MIMEParams empty
-    {-# INLINE singleton #-}
-    singleton p
-        = MIMEParams $ singleton p
-    {-# INLINE insertMany #-}
-    insertMany f (MIMEParams m)
-        = MIMEParams $ insertMany f m
-    {-# INLINE insertManySorted #-}
-    insertManySorted f (MIMEParams m)
-        = MIMEParams $ insertManySorted f m
-
-instance Foldable MIMEParams (CIAscii, Text) where
-    {-# INLINE null #-}
-    null (MIMEParams m) = null m
-    {-# INLINE size #-}
-    size (MIMEParams m) = size m
-    {-# INLINE foldr #-}
-    foldr f b (MIMEParams m) = foldr f b m
-
-instance Collection MIMEParams (CIAscii, Text) where
-    {-# INLINE filter #-}
-    filter f (MIMEParams m) = MIMEParams $ filter f m
-
-instance Indexed MIMEParams CIAscii Text where
-    {-# INLINE index #-}
-    index k (MIMEParams m) = index k m
-    {-# INLINE adjust #-}
-    adjust f k (MIMEParams m) = MIMEParams $ adjust f k m
-    {-# INLINE inDomain #-}
-    inDomain k (MIMEParams m) = inDomain k m
-
-instance Map MIMEParams CIAscii Text where
-    {-# INLINE lookup #-}
-    lookup k (MIMEParams m) = lookup k m
-    {-# INLINE mapWithKey #-}
-    mapWithKey f (MIMEParams m)
-        = MIMEParams $ mapWithKey f m
-    {-# INLINE unionWith #-}
-    unionWith f (MIMEParams α) (MIMEParams β)
-        = MIMEParams $ unionWith f α β
-    {-# INLINE intersectionWith #-}
-    intersectionWith f (MIMEParams α) (MIMEParams β)
-        = MIMEParams $ intersectionWith f α β
-    {-# INLINE differenceWith #-}
-    differenceWith f (MIMEParams α) (MIMEParams β)
-        = MIMEParams $ differenceWith f α β
-    {-# INLINE isSubmapBy #-}
-    isSubmapBy f (MIMEParams α) (MIMEParams β)
-        = isSubmapBy f α β
-    {-# INLINE isProperSubmapBy #-}
-    isProperSubmapBy f (MIMEParams α) (MIMEParams β)
-        = isProperSubmapBy f α β
-
-instance SortingCollection MIMEParams (CIAscii, Text) where
-    {-# INLINE minView #-}
-    minView (MIMEParams m) = second MIMEParams <$> minView m
+C.derive [d| instance Unfoldable MIMEParams (CIAscii, Text)
+             instance Foldable   MIMEParams (CIAscii, Text)
+             instance Collection MIMEParams (CIAscii, Text)
+             instance Indexed    MIMEParams  CIAscii  Text
+             instance Map        MIMEParams  CIAscii  Text
+             instance SortingCollection MIMEParams (CIAscii, Text)
+           |]
 
 -- |Convert MIME parameter values to an 'AsciiBuilder'.
 printMIMEParams ∷ MIMEParams → AsciiBuilder
@@ -204,7 +139,7 @@ section ep                         = epSection ep
 -- |'Parser' for MIME parameter values.
 mimeParams ∷ Parser MIMEParams
 {-# INLINEABLE mimeParams #-}
-mimeParams = decodeParams =≪ P.many (try paramP)
+mimeParams = decodeParams =≪ many (try paramP)
 
 paramP ∷ Parser ExtendedParam
 paramP = do skipMany lws
@@ -251,7 +186,7 @@ initialEncodedValue
 
 encodedPayload ∷ Parser BS.ByteString
 {-# INLINE encodedPayload #-}
-encodedPayload = BS.concat <$> P.many (hexChar <|> rawChars)
+encodedPayload = BS.concat <$> many (hexChar <|> rawChars)
 
 hexChar ∷ Parser BS.ByteString
 {-# INLINEABLE hexChar #-}