Make use of mimeType quasi-quoter.

Ditz-issue: c566a8433e8af700655680f53e99cfe9f563ed32

diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs
index d45beaf81f196b06203aa9a1f4eb770ccb014b68..58cb486f0b6832d6abd314c093b7e2b826b0253b 100644 (file)
--- a/Network/HTTP/Lucu.hs
+++ b/Network/HTTP/Lucu.hs
@@ -57,8 +57,8 @@ module Network.HTTP.Lucu
 
       -- *** MIME Type
     , MIMEType(..)
-    , mkMIMEType
     , parseMIMEType
+    , mimeType
 
       -- *** Authentication
     , AuthChallenge(..)
@@ -74,7 +74,8 @@ import Network.HTTP.Lucu.Authentication
 import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.ETag
 import Network.HTTP.Lucu.Httpd
-import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.MIMEType hiding (mimeType)
+import Network.HTTP.Lucu.MIMEType.TH
 import Network.HTTP.Lucu.Resource
 import Network.HTTP.Lucu.Resource.Tree
 import Network.HTTP.Lucu.Response

diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs
index 9c34c50e634cdd1360d26d221ada577c49b64aa2..d60b70e5d5f21d4704ee6bb269f271692d35e58e 100644 (file)
--- a/Network/HTTP/Lucu/MIMEType.hs
+++ b/Network/HTTP/Lucu/MIMEType.hs
@@ -9,7 +9,6 @@
 -- (<http://tools.ietf.org/html/rfc2046>).
 module Network.HTTP.Lucu.MIMEType
     ( MIMEType(..)
-    , mkMIMEType
 
     , parseMIMEType
     , printMIMEType
@@ -49,12 +48,6 @@ instance Lift MIMEType where
              }
            |]
 
--- |@'mkMIMEType' media sub@ returns a 'MIMEType' with the given
--- @media@ and @sub@ types but without any parameters.
-mkMIMEType ∷ CIAscii → CIAscii → MIMEType
-{-# INLINE mkMIMEType #-}
-mkMIMEType = flip flip (∅) ∘ MIMEType
-
 -- |Convert a 'MIMEType' to an 'AsciiBuilder'.
 printMIMEType ∷ MIMEType → AsciiBuilder
 {-# INLINEABLE printMIMEType #-}

diff --git a/Network/HTTP/Lucu/MIMEType/TH.hs b/Network/HTTP/Lucu/MIMEType/TH.hs
index 1aae0b4a1accfadcf4e6b24dcd98ff831be541a3..7cdf24497637c4ef081749f9ed88466de307ff56 100644 (file)
--- a/Network/HTTP/Lucu/MIMEType/TH.hs
+++ b/Network/HTTP/Lucu/MIMEType/TH.hs
@@ -2,6 +2,7 @@
     UnicodeSyntax
   , ViewPatterns
   #-}
+-- |A module to provide 'QuasiQuoter' for 'MIMEType' literals.
 module Network.HTTP.Lucu.MIMEType.TH
     ( mimeType
     )
@@ -15,11 +16,11 @@ import Network.HTTP.Lucu.MIMEType hiding (mimeType)
 import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 
--- |A 'QuasiQuoter' for 'MIMEType' literals.
+-- |'QuasiQuoter' for 'MIMEType' literals.
 --
 -- @
 --   textPlain :: 'MIMEType'
---   textPlain = ['mimeType'| text/plain; charset="UTF-8" |]
+--   textPlain = ['mimeType'| text/plain; charset=\"UTF-8\" |]
 -- @
 mimeType ∷ QuasiQuoter
 mimeType = QuasiQuoter {

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index fd85eaf8f907bd506df0042b79dece95c386f85d..a28a80461ede0d502d4de626121731c232c940cc 100644 (file)
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -2,6 +2,7 @@
     DoAndIfThenElse
   , FlexibleContexts
   , OverloadedStrings
+  , QuasiQuotes
   , RecordWildCards
   , ScopedTypeVariables
   , UnicodeSyntax
@@ -38,7 +39,9 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.MIMEParams
-import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.MIMEType (MIMEType)
+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 Prelude.Unicode
@@ -155,7 +158,7 @@ parsePart boundary src
                          ⧺ e
       where
         defaultCType ∷ MIMEType
-        defaultCType = parseMIMEType "text/plain"
+        defaultCType = [mimeType| text/plain |]
 
 partHeader ∷ Parser Headers
 partHeader = crlf *> headers
@@ -187,7 +190,7 @@ getContType hdrs
         Nothing
             → return Nothing
         Just str
-            → case parseOnly (finishOff mimeType) $ A.toByteString str of
+            → case parseOnly (finishOff MT.mimeType) $ A.toByteString str of
                  Right  d → return $ Just d
                  Left err → throwError $ "malformed Content-Type: "
                                        ⧺ A.toString str

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index e6a03aca748a539c048c4b720be3de2a162db9eb..704feda9c79ca2e5ab4619b1550166bdd8023f4c 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -3,6 +3,7 @@
   , GeneralizedNewtypeDeriving
   , DoAndIfThenElse
   , OverloadedStrings
+  , QuasiQuotes
   , RecordWildCards
   , UnicodeSyntax
   #-}
@@ -174,7 +175,9 @@ 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
+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)
@@ -236,7 +239,7 @@ toPairWithFormData ∷ (ByteString, ByteString) → (Strict.ByteString, FormData
 toPairWithFormData (name, value)
     = let fd = FormData {
                  fdFileName = Nothing
-               , fdMIMEType = parseMIMEType "text/plain"
+               , fdMIMEType = [mimeType| text/plain |]
                , fdContent  = Lazy.fromChunks [value]
                }
       in (name, fd)
@@ -258,7 +261,7 @@ getAccept
            Nothing
                → return []
            Just accept
-               → case P.parseOnly (finishOff mimeTypeList) (A.toByteString accept) of
+               → case P.parseOnly (finishOff MT.mimeTypeList) (A.toByteString accept) of
                     Right xs → return xs
                     Left  _  → abort $ mkAbortion' BadRequest
                                      $ "Unparsable Accept: " ⊕ A.toText accept
@@ -310,7 +313,7 @@ getContentType
            Nothing
                → return Nothing
            Just cType
-               → case P.parseOnly (finishOff mimeType) (A.toByteString cType) of
+               → case P.parseOnly (finishOff MT.mimeType) (A.toByteString cType) of
                     Right t → return $ Just t
                     Left  _ → abort $ mkAbortion' BadRequest
                                     $ "Unparsable Content-Type: " ⊕ A.toText cType
@@ -580,7 +583,7 @@ getForm limit
                        $ A.toText
                        $ A.fromAsciiBuilder
                        $ A.toAsciiBuilder "Unsupported media type: "
-                       ⊕ printMIMEType cType
+                       ⊕ MT.printMIMEType cType
     where
       readWWWFormURLEncoded
           = (map toPairWithFormData ∘ parseWWWFormURLEncoded)
@@ -626,7 +629,7 @@ redirect code uri
 -- mandatory for sending a response body.
 setContentType ∷ MIMEType → Resource ()
 setContentType
-    = setHeader "Content-Type" ∘ A.fromAsciiBuilder ∘ printMIMEType
+    = setHeader "Content-Type" ∘ A.fromAsciiBuilder ∘ MT.printMIMEType
 
 -- |@'setLocation' uri@ declares the response header \"Location\" as
 -- @uri@. You usually don't need to call this function directly.