From: PHO <pho@cielonegro.org>
Date: Tue, 15 Nov 2011 07:33:03 +0000 (+0900)
Subject: MIMEParams is now an instance of collections-api's type classes.
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=bb121f1;hp=fc6b68927991072aeb36fe6cd28d2e6c5193427b;p=Lucu.git

MIMEParams is now an instance of collections-api's type classes.

Ditz-issue: e0312227f40a0fa92d4c5d69a64dad473f54389a
---

diff --git a/Lucu.cabal b/Lucu.cabal
index 1c71aa8..bdc0b71 100644
--- a/Lucu.cabal
+++ b/Lucu.cabal
@@ -61,7 +61,6 @@ Library
         collections-api            == 1.0.*,
         collections-base-instances == 1.0.*,
         containers                 == 0.4.*,
-        containers-unicode-symbols == 0.3.*,
         directory                  == 1.1.*,
         filepath                   == 1.2.*,
         hxt                        == 9.1.*,
@@ -120,6 +119,7 @@ Library
         Network.HTTP.Lucu.ContentCoding
         Network.HTTP.Lucu.DefaultPage
         Network.HTTP.Lucu.Interaction
+        Network.HTTP.Lucu.OrphanInstances
         Network.HTTP.Lucu.Postprocess
         Network.HTTP.Lucu.Preprocess
         Network.HTTP.Lucu.RequestReader
diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs
index 682e91f..5a1a950 100644
--- a/Network/HTTP/Lucu.hs
+++ b/Network/HTTP/Lucu.hs
@@ -57,7 +57,7 @@ module Network.HTTP.Lucu
 
       -- *** MIME Type
     , MIMEType(..)
-    , MIMEParams(..)
+    , MIMEParams
     , parseMIMEType
     , mimeType
 
diff --git a/Network/HTTP/Lucu/ETag.hs b/Network/HTTP/Lucu/ETag.hs
index 1335738..08c1060 100644
--- a/Network/HTTP/Lucu/ETag.hs
+++ b/Network/HTTP/Lucu/ETag.hs
@@ -25,6 +25,7 @@ import Data.Attoparsec.Char8
 import Data.Data
 import Data.Monoid.Unicode
 import Language.Haskell.TH.Syntax
+import Network.HTTP.Lucu.OrphanInstances ()
 import Network.HTTP.Lucu.Parser
 import Network.HTTP.Lucu.Parser.Http hiding (token)
 import Network.HTTP.Lucu.Utils
@@ -32,8 +33,8 @@ import Prelude.Unicode
 
 -- |An entity tag consists of a weakness flag and an opaque string.
 data ETag = ETag {
-      -- |The weakness flag. Weak tags looks like W\/\"blahblah\" and
-      -- strong tags are like \"blahblah\". See:
+      -- |The weakness flag. Weak tags looks like @W\/\"blahblah\"@
+      -- and strong tags are like @\"blahblah\"@. See:
       -- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec13.html#sec13.3.3>
       etagIsWeak ∷ !Bool
       -- |An opaque string. Only characters from 0x20 (sp) to 0x7e (~)
@@ -45,7 +46,7 @@ instance Lift ETag where
     lift (ETag {..})
         = [| ETag {
                etagIsWeak = $(lift etagIsWeak)
-             , etagToken  = $(liftAscii etagToken)
+             , etagToken  = $(lift etagToken )
              }
            |]
 
diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index 2ee9cbb..97a7603 100644
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -23,7 +23,7 @@ import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
 import qualified Data.Ascii as A
 import Data.Attoparsec.Char8 as P
 import Data.List (intersperse)
-import qualified Data.Map as M
+import qualified Data.Map as M (Map)
 import Data.Collections
 import Data.Collections.BaseInstances ()
 import Data.Monoid
@@ -77,8 +77,8 @@ instance Unfoldable Headers (CIAscii, Ascii) where
     empty
         = Headers empty
     {-# INLINE singleton #-}
-    singleton v
-        = Headers $ singleton v
+    singleton p
+        = Headers $ singleton p
     {-# INLINE insertMany #-}
     insertMany f (Headers m)
         = Headers $ insertMany f m
@@ -87,6 +87,10 @@ instance Unfoldable Headers (CIAscii, Ascii) where
         = Headers $ insertManySorted f m
 
 instance Foldable Headers (CIAscii, Ascii) where
+    {-# INLINE null #-}
+    null (Headers m) = null m
+    {-# INLINE size #-}
+    size (Headers m) = size m
     {-# INLINE foldr #-}
     foldr f b (Headers m) = foldr f b m
 
diff --git a/Network/HTTP/Lucu/Implant/PrettyPrint.hs b/Network/HTTP/Lucu/Implant/PrettyPrint.hs
index 85af3cb..fa842a1 100644
--- a/Network/HTTP/Lucu/Implant/PrettyPrint.hs
+++ b/Network/HTTP/Lucu/Implant/PrettyPrint.hs
@@ -30,8 +30,8 @@ import Network.HTTP.Lucu.ETag
 import Network.HTTP.Lucu.Implant
 import Network.HTTP.Lucu.Implant.Rewrite
 import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.OrphanInstances ()
 import Network.HTTP.Lucu.Resource
-import Network.HTTP.Lucu.Utils
 import Prelude hiding (head)
 import Prelude.Unicode
 
@@ -146,7 +146,7 @@ resourceDecl i symName
       decls ∷ [Q Dec]
       decls | useGZip i
                 = [ sigD gzipEncoding [t| CIAscii |]
-                  , valD (varP gzipEncoding) (normalB (liftCIAscii "gzip")) []
+                  , valD (varP gzipEncoding) (normalB (lift ("gzip" ∷ CIAscii))) []
                   ]
             | otherwise
                 = []
@@ -204,7 +204,7 @@ eTagDecl (Input {..})
 lastModDecl ∷ Input → Q [Dec]
 lastModDecl (Input {..})
     = sequence [ sigD lastModified [t| UTCTime |]
-               , valD (varP lastModified) (normalB (liftUTCTime iLastMod)) []
+               , valD (varP lastModified) (normalB (lift iLastMod)) []
                ]
 
 contTypeDecl ∷ Input → Q [Dec]
@@ -217,11 +217,11 @@ binDecl ∷ Input → Q [Dec]
 binDecl i@(Input {..})
     | useGZip i
         = sequence [ sigD gzippedData [t| L.ByteString |]
-                   , valD (varP gzippedData) (normalB (liftLazyByteString iGZipped)) []
+                   , valD (varP gzippedData) (normalB (lift iGZipped)) []
                    ]
     | otherwise
         = sequence [ sigD rawData [t| L.ByteString |]
-                   , valD (varP rawData) (normalB (liftLazyByteString iRawData)) []
+                   , valD (varP rawData) (normalB (lift iRawData)) []
                    ]
 
 rules ∷ Rules
diff --git a/Network/HTTP/Lucu/Implant/Rewrite.hs b/Network/HTTP/Lucu/Implant/Rewrite.hs
index 69b8aee..9abf628 100644
--- a/Network/HTTP/Lucu/Implant/Rewrite.hs
+++ b/Network/HTTP/Lucu/Implant/Rewrite.hs
@@ -33,7 +33,7 @@ import Data.Generics.Aliases hiding (GT)
 import Data.Generics.Schemes
 import Data.Monoid
 import Data.Monoid.Unicode
-import qualified Data.Set as S
+import qualified Data.Set as S (Set)
 import Language.Haskell.TH.Syntax
 import Prelude hiding (filter, foldr, lookup)
 import Prelude.Unicode
diff --git a/Network/HTTP/Lucu/MIMEParams.hs b/Network/HTTP/Lucu/MIMEParams.hs
index 9e5b938..f4b503e 100644
--- a/Network/HTTP/Lucu/MIMEParams.hs
+++ b/Network/HTTP/Lucu/MIMEParams.hs
@@ -1,22 +1,25 @@
 {-# LANGUAGE
-    CPP
-  , DeriveDataTypeable
+    DeriveDataTypeable
   , DoAndIfThenElse
+  , FlexibleInstances
   , GeneralizedNewtypeDeriving
+  , MultiParamTypeClasses
   , OverloadedStrings
   , RecordWildCards
   , TemplateHaskell
+  , TypeSynonymInstances
   , UnicodeSyntax
   #-}
 -- |Parsing and printing MIME parameter values
 -- (<http://tools.ietf.org/html/rfc2231>).
 module Network.HTTP.Lucu.MIMEParams
-    ( MIMEParams(..)
+    ( MIMEParams
     , printMIMEParams
     , mimeParams
     )
     where
-import Control.Applicative
+import Control.Applicative hiding (empty)
+import Control.Arrow
 import Control.Monad hiding (mapM)
 import Control.Monad.Unicode
 import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
@@ -25,52 +28,106 @@ 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.Collections
+import Data.Collections.BaseInstances ()
+import qualified Data.Map as M (Map)
 import Data.Monoid
 import Data.Monoid.Unicode
-import Data.Sequence (Seq, ViewL(..))
-import qualified Data.Sequence as S
-import Data.Sequence.Unicode hiding ((∅))
+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.Traversable
+import Data.Typeable
 import Data.Word
 import Language.Haskell.TH.Syntax
+import Network.HTTP.Lucu.OrphanInstances ()
 import Network.HTTP.Lucu.Parser.Http
 import Network.HTTP.Lucu.Utils
-import Prelude hiding (concat, mapM, takeWhile)
+import Prelude hiding (concat, filter, foldr, lookup, mapM, null, 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)
+    = MIMEParams (M.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
+    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
 
 -- |Convert MIME parameter values to an 'AsciiBuilder'.
 printMIMEParams ∷ MIMEParams → AsciiBuilder
 {-# INLINEABLE printMIMEParams #-}
-#if MIN_VERSION_containers(0, 4, 1)
-printMIMEParams (MIMEParams m) = M.foldlWithKey' f (∅) m
-#else
-printMIMEParams (MIMEParams m) = M.foldlWithKey f (∅) m
-#endif
+printMIMEParams = foldl' f (∅)
     where
-      f ∷ AsciiBuilder → CIAscii → Text → AsciiBuilder
+      f ∷ AsciiBuilder → (CIAscii, Text) → AsciiBuilder
       {-# INLINE f #-}
-      f ab k v = ab ⊕ A.toAsciiBuilder "; " ⊕ printPair k v
+      f ab (k, v) = ab ⊕ A.toAsciiBuilder "; " ⊕ printPair k v
 
 printPair ∷ CIAscii → Text → AsciiBuilder
 {-# INLINEABLE printPair #-}
@@ -224,30 +281,32 @@ rawChars = takeWhile1 (\c → isToken c ∧ c ≢ '%')
 
 decodeParams ∷ (Functor m, Monad m) ⇒ [ExtendedParam] → m MIMEParams
 {-# INLINE decodeParams #-}
-decodeParams = (MIMEParams <$>) ∘ (mapM decodeSections =≪) ∘ sortBySection
+decodeParams = (MIMEParams <$>)
+               ∘ (mapM (\(k, v) → ((,) k) <$> decodeSections v) =≪)
+               ∘ sortBySection
 
 sortBySection ∷ Monad m
               ⇒ [ExtendedParam]
-              → m (Map CIAscii (Map Integer ExtendedParam))
+              → m (M.Map CIAscii (M.Map Integer ExtendedParam))
 sortBySection = flip go (∅)
     where
       go ∷ Monad m
          ⇒ [ExtendedParam]
-         → Map CIAscii (Map Integer ExtendedParam)
-         → m (Map CIAscii (Map Integer ExtendedParam))
+         → M.Map CIAscii (M.Map Integer ExtendedParam)
+         → m (M.Map CIAscii (M.Map Integer ExtendedParam))
       go []     m = return m
       go (x:xs) m
-          = case M.lookup (epName x) m of
+          = case lookup (epName x) m of
               Nothing
-                  → let s  = M.singleton (section x) x
-                        m' = M.insert (epName x) s m
+                  → let s  = singleton (section x, x)
+                        m' = insert (epName x, s) m
                     in
                       go xs m'
               Just s
-                  → case M.lookup (section x) s of
+                  → case lookup (section x) s of
                        Nothing
-                           → let s' = M.insert (section x) x  s
-                                 m' = M.insert (epName  x) s' m
+                           → let s' = insert (section x, x ) s
+                                 m' = insert (epName  x, s') m
                              in
                                go xs m'
                        Just _
@@ -258,16 +317,16 @@ sortBySection = flip go (∅)
                                           , "'"
                                           ])
 
-decodeSections ∷ Monad m ⇒ Map Integer ExtendedParam → m Text
+decodeSections ∷ Monad m ⇒ M.Map Integer ExtendedParam → m Text
 decodeSections = (decodeSeq =≪) ∘ flip (flip toSeq 0) (∅)
     where
       toSeq ∷ Monad m
-            ⇒ Map Integer ExtendedParam
+            ⇒ M.Map Integer ExtendedParam
             → Integer
             → Seq ExtendedParam
             → m (Seq ExtendedParam)
       toSeq m expectedSect sects
-          = case M.minViewWithKey m of
+          = case minView m of
               Nothing
                   → return sects
               Just ((sect, p), m')
@@ -283,19 +342,19 @@ decodeSections = (decodeSeq =≪) ∘ flip (flip toSeq 0) (∅)
 
       decodeSeq ∷ Monad m ⇒ Seq ExtendedParam → m Text
       decodeSeq sects
-          = case S.viewl sects of
-              EmptyL
+          = case front sects of
+              Nothing
                   → fail "decodeSeq: internal error: empty seq"
-              InitialEncodedParam {..} :< xs
+              Just (InitialEncodedParam {..}, xs)
                   → do d ← getDecoder epCharset
                        t ← decodeStr d epPayload
-                       decodeSeq' (Just d) xs $ S.singleton t
-              ContinuedEncodedParam {..} :< _
+                       decodeSeq' (Just d) xs $ singleton t
+              Just (ContinuedEncodedParam {..}, _)
                   → fail "decodeSeq: internal error: CEP at section 0"
-              AsciiParam {..} :< xs
+              Just (AsciiParam {..}, xs)
                   → let t = A.toText apPayload
                     in
-                      decodeSeq' Nothing xs $ S.singleton t
+                      decodeSeq' Nothing xs $ singleton t
 
       decodeSeq' ∷ Monad m
                  ⇒ Maybe Decoder
@@ -303,12 +362,12 @@ decodeSections = (decodeSeq =≪) ∘ flip (flip toSeq 0) (∅)
                  → Seq Text
                  → m Text
       decodeSeq' decoder sects chunks
-          = case S.viewl sects of
-              EmptyL
+          = case front sects of
+              Nothing
                   → return $ T.concat $ toList chunks
-              InitialEncodedParam {..} :< _
+              Just (InitialEncodedParam {}, _)
                   → fail "decodeSeq': internal error: IEP at section > 0"
-              ContinuedEncodedParam {..} :< xs
+              Just (ContinuedEncodedParam {..}, xs)
                   → case decoder of
                        Just d
                            → do t ← decodeStr d epPayload
@@ -320,7 +379,7 @@ decodeSections = (decodeSeq =≪) ∘ flip (flip toSeq 0) (∅)
                                           , A.toString $ A.fromCIAscii epName
                                           , "' is encoded but its first section is not"
                                           ])
-              AsciiParam {..} :< xs
+              Just (AsciiParam {..}, xs)
                   → let t = A.toText apPayload
                     in
                       decodeSeq' decoder xs $ chunks ⊳ t
diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs
index 88bd5e7..2861d26 100644
--- a/Network/HTTP/Lucu/MIMEType.hs
+++ b/Network/HTTP/Lucu/MIMEType.hs
@@ -25,9 +25,9 @@ import Data.Monoid.Unicode
 import Data.Typeable
 import Language.Haskell.TH.Syntax
 import Network.HTTP.Lucu.MIMEParams
+import Network.HTTP.Lucu.OrphanInstances ()
 import Network.HTTP.Lucu.Parser
 import Network.HTTP.Lucu.Parser.Http
-import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 
 -- |A media type, subtype, and parameters.
@@ -42,8 +42,8 @@ data MIMEType
 instance Lift MIMEType where
     lift (MIMEType {..})
         = [| MIMEType {
-               mtMedia  = $(liftCIAscii mtMedia)
-             , mtSub    = $(liftCIAscii mtSub)
+               mtMedia  = $(lift mtMedia )
+             , mtSub    = $(lift mtSub   )
              , mtParams = $(lift mtParams)
              }
            |]
diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs
index edf1772..7c3c64d 100644
--- a/Network/HTTP/Lucu/MIMEType/Guess.hs
+++ b/Network/HTTP/Lucu/MIMEType/Guess.hs
@@ -32,8 +32,8 @@ import Data.Text.Encoding
 import Language.Haskell.TH.Syntax
 import Language.Haskell.TH.Quote
 import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.OrphanInstances ()
 import Network.HTTP.Lucu.Parser
-import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 import System.FilePath
 
@@ -43,8 +43,7 @@ newtype ExtMap
     deriving (Eq, Show, Read, Monoid, Typeable)
 
 instance Lift ExtMap where
-    lift (ExtMap m)
-        = [| ExtMap $(liftMap liftText lift m) |]
+    lift (ExtMap m) = [| ExtMap $(lift m) |]
 
 -- |'QuasiQuoter' for 'ExtMap' reading Apache @mime.types@.
 --
diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index 1550030..a5280c0 100644
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -17,7 +17,7 @@ module Network.HTTP.Lucu.MultipartForm
     where
 import Control.Applicative hiding (many)
 import Control.Applicative.Unicode hiding ((∅))
-import Control.Monad.Error
+import Control.Monad.Error (MonadError, throwError)
 import Control.Monad.Unicode
 import Data.Ascii (Ascii, CIAscii)
 import qualified Data.Ascii as A
@@ -26,13 +26,11 @@ import qualified Data.Attoparsec.Lazy as LP
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LS
 import Data.ByteString.Lazy.Search
-import Data.Foldable
-import Data.List
-import qualified Data.Map as M
+import Data.Collections
+import Data.List (intercalate)
 import Data.Maybe
 import Data.Monoid.Unicode
 import Data.Sequence (Seq)
-import Data.Sequence.Unicode hiding ((∅))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Network.HTTP.Lucu.Headers
@@ -42,6 +40,8 @@ import qualified Network.HTTP.Lucu.MIMEType as MT
 import Network.HTTP.Lucu.MIMEType.TH
 import Network.HTTP.Lucu.Parser
 import Network.HTTP.Lucu.Parser.Http
+import Network.HTTP.Lucu.Utils
+import Prelude hiding (lookup, mapM)
 import Prelude.Unicode
 
 -- |'FormData' represents a form value and possibly an uploaded file
@@ -229,7 +229,7 @@ partToFormPair pt@(Part {..})
 partName ∷ MonadError String m ⇒ Part → m Ascii
 {-# INLINEABLE partName #-}
 partName (Part {..})
-    = case M.lookup "name" params of
+    = case lookup "name" $ dParams ptContDispo of
         Just name
             → case A.fromText name of
                  Just a  → return a
@@ -238,10 +238,7 @@ partName (Part {..})
         Nothing
             → throwError $ "form-data without name: "
                          ⧺ A.toString (printContDispo ptContDispo)
-    where
-      params = case dParams ptContDispo of
-                 MIMEParams m → m
 
 partFileName ∷ Part → Maybe Text
-partFileName (dParams ∘ ptContDispo → MIMEParams m)
-    = M.lookup "filename" m
+partFileName (ptContDispo → ContDispo {..})
+    = lookup "filename" dParams
diff --git a/Network/HTTP/Lucu/OrphanInstances.hs b/Network/HTTP/Lucu/OrphanInstances.hs
new file mode 100644
index 0000000..a7e7b7e
--- /dev/null
+++ b/Network/HTTP/Lucu/OrphanInstances.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE
+    RecordWildCards
+  , TemplateHaskell
+  , UnicodeSyntax
+  #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Network.HTTP.Lucu.OrphanInstances
+    (
+    )
+    where
+import Data.Ascii (Ascii)
+import qualified Data.Ascii as A
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as Strict
+import qualified Data.ByteString.Lazy.Internal as Lazy
+import Data.CaseInsensitive (CI, FoldCase)
+import qualified Data.CaseInsensitive as CI
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Ratio
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Syntax
+import Prelude hiding (last, mapM, null, reverse)
+import Prelude.Unicode
+
+instance Lift ByteString where
+    lift bs = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |]
+
+instance Lift Lazy.ByteString where
+    lift = Lazy.foldrChunks f [| Lazy.Empty |]
+        where
+          f ∷ ByteString → Q Exp → Q Exp
+          f bs e = [| Lazy.Chunk $(lift bs) $e |]
+
+instance Lift Ascii where
+    lift a = [| A.unsafeFromByteString $(lift $ A.toByteString a) |]
+
+instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
+    lift s = [| CI.mk $(lift $ CI.original s) |]
+
+instance Lift Text where
+    lift t = [| T.pack $(litE $ stringL $ T.unpack t) |]
+
+instance (Lift k, Lift v) ⇒ Lift (Map k v) where
+    lift m
+        | M.null m = [| M.empty |]
+        | otherwise = [| M.fromDistinctAscList $(liftPairs (M.toAscList m)) |]
+        where
+          liftPairs       = listE ∘ map liftPair
+          liftPair (k, v) = tupE [lift k, lift v]
+
+instance Lift UTCTime where
+    lift (UTCTime {..})
+        = [| UTCTime $(lift utctDay) $(lift utctDayTime) |]
+
+instance Lift Day where
+    lift (ModifiedJulianDay {..})
+        = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]
+
+instance Lift DiffTime where
+    lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
+        where
+          n, d ∷ Q Exp
+          n = lift $ numerator   $ toRational dt
+          d = lift $ denominator $ toRational dt
diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 5ef7acc..ab70998 100644
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -21,7 +21,6 @@ import Data.List
 import Data.Maybe
 import Data.Monoid.Unicode
 import qualified Data.Sequence as S
-import Data.Sequence.Unicode hiding ((∅))
 import qualified Data.Text as T
 import Network.HTTP.Lucu.Abortion
 import Network.HTTP.Lucu.Config
@@ -33,6 +32,7 @@ import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Resource.Tree
+import Network.HTTP.Lucu.Utils
 import Network.Socket
 import Prelude.Unicode
 import System.IO (hPutStrLn, stderr)
diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index ec3447e..4cf43e0 100644
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -155,8 +155,8 @@ import qualified Data.Attoparsec.Char8 as P
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as Strict
 import qualified Data.ByteString.Lazy as Lazy
-import Data.List
-import qualified Data.Map as M
+import Data.Collections
+import Data.List (intersperse, sort)
 import Data.Maybe
 import Data.Monoid
 import Data.Monoid.Unicode
@@ -177,13 +177,13 @@ import Network.HTTP.Lucu.Parser
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Response
-import Network.HTTP.Lucu.MIMEParams
 import Network.HTTP.Lucu.MIMEType (MIMEType(..))
 import qualified Network.HTTP.Lucu.MIMEType as MT
 import Network.HTTP.Lucu.MIMEType.TH
 import Network.HTTP.Lucu.Utils
 import Network.Socket hiding (accept)
 import Network.URI hiding (path)
+import Prelude hiding (any, drop, lookup, reverse)
 import Prelude.Unicode
 
 -- |Get the string representation of the address of remote host. If
@@ -598,8 +598,8 @@ getForm limit
               Just a  → return a
               Nothing → abort $ mkAbortion' BadRequest "Malformed x-www-form-urlencoded"
 
-      readMultipartFormData (MIMEParams m)
-          = case M.lookup "boundary" m of
+      readMultipartFormData m
+          = case lookup "boundary" m of
               Nothing
                   → abort $ mkAbortion' BadRequest "Missing boundary of multipart/form-data"
               Just boundary
diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs
index f3fca16..9434cfb 100644
--- a/Network/HTTP/Lucu/Resource/Tree.hs
+++ b/Network/HTTP/Lucu/Resource/Tree.hs
@@ -25,7 +25,6 @@ import Data.Map (Map)
 import Data.Maybe
 import Data.Monoid.Unicode
 import Data.Sequence (Seq)
-import Data.Sequence.Unicode hiding ((∅))
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Utils
 import Network.URI hiding (path)
diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs
index c07c9c9..8722ecb 100644
--- a/Network/HTTP/Lucu/Utils.hs
+++ b/Network/HTTP/Lucu/Utils.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE
-    OverloadedStrings
-  , RecordWildCards
-  , TemplateHaskell
+    FlexibleContexts
+  , OverloadedStrings
   , UnicodeSyntax
   #-}
 -- |Utility functions used internally in this package.
@@ -12,38 +11,29 @@ module Network.HTTP.Lucu.Utils
     , splitPathInfo
     , trim
 
-    , getLastModified
+    , (⊲)
+    , (⊳)
+    , (⋈)
+    , mapM
 
-    , liftByteString
-    , liftLazyByteString
-    , liftAscii
-    , liftCIAscii
-    , liftText
-    , liftMap
-    , liftUTCTime
+    , getLastModified
     )
     where
-import Control.Applicative
-import Control.Monad
-import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
+import Control.Applicative hiding (empty)
+import Control.Monad hiding (mapM)
+import Data.Ascii (Ascii, AsciiBuilder)
 import qualified Data.Ascii as A
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as Strict
-import qualified Data.ByteString.Lazy.Internal as Lazy
 import Data.Char
-import Data.List hiding (last)
-import Data.Map (Map)
-import qualified Data.Map as M
+import Data.Collections
+import Data.Collections.BaseInstances ()
 import Data.Monoid.Unicode
 import Data.Ratio
-import Data.Text (Text)
-import qualified Data.Text as T
 import Data.Time
 import Data.Time.Clock.POSIX
-import Language.Haskell.TH.Lib
-import Language.Haskell.TH.Syntax
 import Network.URI
-import Prelude hiding (last)
+import Prelude hiding (last, mapM, null, reverse)
 import Prelude.Unicode
 import System.Directory
 import System.Time (ClockTime(..))
@@ -118,6 +108,34 @@ trim = reverse ∘ f ∘ reverse ∘ f
     where
       f = dropWhile isSpace
 
+infixr 5 ⊲
+-- | (&#22B2;) = ('<|')
+--
+-- U+22B2, NORMAL SUBGROUP OF
+(⊲) ∷ Sequence α a ⇒ a → α → α
+(⊲) = (<|)
+
+infixl 5 ⊳
+-- | (&#22B3;) = ('|>')
+--
+-- U+22B3, CONTAINS AS NORMAL SUBGROUP
+(⊳) ∷ Sequence α a ⇒ α → a → α
+(⊳) = (|>)
+
+infixr 5 ⋈
+-- | (&#22C8;) = ('><')
+--
+-- U+22C8, BOWTIE
+(⋈) ∷ Sequence α a ⇒ α → α → α
+(⋈) = (><)
+
+-- |Generalised @mapM@ from any 'Foldable' to 'Unfoldable'. Why isn't
+-- this in the @collections-api@?
+mapM ∷ (Foldable α a, Unfoldable β b, Functor m, Monad m)
+     ⇒ (a → m b) → α → m β
+{-# INLINE mapM #-}
+mapM = flip foldrM empty ∘ (flip ((<$>) ∘ flip insert) ∘)
+
 -- |Get the modification time of a given file.
 getLastModified ∷ FilePath → IO UTCTime
 getLastModified = (clockTimeToUTC <$>) ∘ getModificationTime
@@ -127,54 +145,3 @@ getLastModified = (clockTimeToUTC <$>) ∘ getModificationTime
           = posixSecondsToUTCTime
             $ fromRational
             $ sec % 1 + picoSec % (1000 ⋅ 1000 ⋅ 1000 ⋅ 1000)
-
--- |Convert a 'ByteString' to an 'Exp' representing it as a literal.
-liftByteString ∷ ByteString → Q Exp
-liftByteString bs
-    = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |]
-
--- |Convert a 'Lazy.ByteString' to an 'Exp' representing it as a
--- literal.
-liftLazyByteString ∷ Lazy.ByteString → Q Exp
-liftLazyByteString = Lazy.foldrChunks f [| Lazy.Empty |]
-    where
-      f ∷ ByteString → Q Exp → Q Exp
-      f bs e = [| Lazy.Chunk $(liftByteString bs) $e |]
-
--- |Convert an 'Ascii' to an 'Exp' representing it as a literal.
-liftAscii ∷ Ascii → Q Exp
-liftAscii a = [| A.unsafeFromByteString $(liftByteString $ A.toByteString a) |]
-
--- |Convert a 'CIAscii' to an 'Exp' representing it as a literal.
-liftCIAscii ∷ CIAscii → Q Exp
-liftCIAscii a = [| A.toCIAscii $(liftAscii $ A.fromCIAscii a) |]
-
--- |Convert a 'Text' to an 'Exp' representing it as a literal.
-liftText ∷ Text → Q Exp
-liftText t = [| T.pack $(litE $ stringL $ T.unpack t) |]
-
--- |Convert an arbitrary 'Map' to an 'Exp' representing it as a
--- literal, using a given key lifter and a value lifter.
-liftMap ∷ Eq k ⇒ (k → Q Exp) → (v → Q Exp) → Map k v → Q Exp
-liftMap liftK liftV m
-    | M.null m  = [| M.empty |]
-    | otherwise = [| M.fromDistinctAscList $(liftPairs (M.toAscList m)) |]
-    where
-      liftPairs       = listE ∘ map liftPair
-      liftPair (k, v) = tupE [liftK k, liftV v]
-
--- |Convert an 'UTCTime' to an 'Exp' representing it as a literal.
-liftUTCTime ∷ UTCTime → Q Exp
-liftUTCTime (UTCTime {..})
-    = [| UTCTime $(liftDay utctDay) $(liftDiffTime utctDayTime) |]
-
-liftDay ∷ Day → Q Exp
-liftDay (ModifiedJulianDay {..})
-    = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]
-
-liftDiffTime ∷ DiffTime → Q Exp
-liftDiffTime dt = [| fromRational ($n % $d) ∷ DiffTime |]
-    where
-      n, d ∷ Q Exp
-      n = lift $ numerator   $ toRational dt
-      d = lift $ denominator $ toRational dt