From: PHO Date: Sat, 5 Nov 2011 03:51:34 +0000 (+0900) Subject: Make use of mimeType quasi-quoter. X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=commitdiff_plain;h=b1fac0a2cb1cafa008c0efa8ae4e14afbee0927f Make use of mimeType quasi-quoter. Ditz-issue: c566a8433e8af700655680f53e99cfe9f563ed32 --- diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs index d45beaf..58cb486 100644 --- 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 9c34c50..d60b70e 100644 --- a/Network/HTTP/Lucu/MIMEType.hs +++ b/Network/HTTP/Lucu/MIMEType.hs @@ -9,7 +9,6 @@ -- (). 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 1aae0b4..7cdf244 100644 --- 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 fd85eaf..a28a804 100644 --- 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 e6a03ac..704feda 100644 --- 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.