From 97295ba748af07f3b0b609f32aabdd52167d9799 Mon Sep 17 00:00:00 2001 From: PHO Date: Mon, 19 Dec 2011 14:34:59 +0900 Subject: [PATCH] Code clean-up using convertible-text Ditz-issue: 0a2a377be55430e655ab42fdc4902fa56a058b26 --- Network/HTTP/Lucu/ETag.hs | 1 - Network/HTTP/Lucu/Headers.hs | 37 ++++++++++++------- Network/HTTP/Lucu/HttpVersion.hs | 47 +++++++++++++++--------- Network/HTTP/Lucu/Implant.hs | 5 ++- Network/HTTP/Lucu/Implant/PrettyPrint.hs | 6 +-- Network/HTTP/Lucu/MIMEParams.hs | 43 ++++++++++++---------- Network/HTTP/Lucu/MIMEType.hs | 5 ++- Network/HTTP/Lucu/Response.hs | 7 +++- 8 files changed, 92 insertions(+), 59 deletions(-) diff --git a/Network/HTTP/Lucu/ETag.hs b/Network/HTTP/Lucu/ETag.hs index 3ebfc1d..6d09aee 100644 --- a/Network/HTTP/Lucu/ETag.hs +++ b/Network/HTTP/Lucu/ETag.hs @@ -10,7 +10,6 @@ -- |An internal module for entity tags. module Network.HTTP.Lucu.ETag ( ETag(..) - , strongETag , weakETag , eTag diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index ff3213b..d4c51d5 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -12,9 +12,7 @@ module Network.HTTP.Lucu.Headers ( Headers , HasHeaders(..) - , headers - , printHeaders ) where import Control.Applicative hiding (empty) @@ -24,6 +22,9 @@ import Data.Ascii (Ascii, AsciiBuilder, CIAscii) import qualified Data.Ascii as A import Data.Attoparsec.Char8 import qualified Data.Collections.Newtype.TH as C +import Data.Convertible.Base +import Data.Convertible.Instances.Ascii () +import Data.Convertible.Utils import Data.List (intersperse) import qualified Data.Map as M (Map) import Data.Collections @@ -105,6 +106,26 @@ merge a b {-# INLINE nullA #-} nullA = null ∘ A.toByteString +instance ConvertSuccess Headers Ascii where + {-# INLINE convertSuccess #-} + convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder) + +instance ConvertSuccess Headers AsciiBuilder where + {-# INLINE convertSuccess #-} + convertSuccess (Headers m) + = mconcat (header <$> fromFoldable m) ⊕ cs ("\x0D\x0A" ∷ Ascii) + where + header ∷ (CIAscii, Ascii) → AsciiBuilder + header (name, value) + = cs name ⊕ + cs (": " ∷ Ascii) ⊕ + cs value ⊕ + cs ("\x0D\x0A" ∷ Ascii) + +deriveAttempts [ ([t| Headers |], [t| Ascii |]) + , ([t| Headers |], [t| AsciiBuilder |]) + ] + {- message-header = field-name ":" [ field-value ] field-name = token @@ -143,15 +164,3 @@ headers = do xs ← many header ∘ mconcat ∘ intersperse (A.toAsciiBuilder "\x20") ∘ (A.toAsciiBuilder <$>) - -printHeaders ∷ Headers → AsciiBuilder -printHeaders (Headers m) - = mconcat (printHeader <$> fromFoldable m) ⊕ - A.toAsciiBuilder "\x0D\x0A" - where - printHeader ∷ (CIAscii, Ascii) → AsciiBuilder - printHeader (name, value) - = A.toAsciiBuilder (A.fromCIAscii name) ⊕ - A.toAsciiBuilder ": " ⊕ - A.toAsciiBuilder value ⊕ - A.toAsciiBuilder "\x0D\x0A" diff --git a/Network/HTTP/Lucu/HttpVersion.hs b/Network/HTTP/Lucu/HttpVersion.hs index 4466f1e..8890427 100644 --- a/Network/HTTP/Lucu/HttpVersion.hs +++ b/Network/HTTP/Lucu/HttpVersion.hs @@ -1,21 +1,26 @@ {-# LANGUAGE - OverloadedStrings + FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings + , TemplateHaskell , UnicodeSyntax #-} -- |An internal module for HTTP version numbers. module Network.HTTP.Lucu.HttpVersion ( HttpVersion(..) - , printHttpVersion , httpVersion ) where import Control.Applicative import Control.Applicative.Unicode -import Data.Ascii (AsciiBuilder) -import qualified Data.Ascii as A +import Data.Ascii (Ascii, AsciiBuilder) import Data.Attoparsec.Char8 +import Data.Convertible.Base +import Data.Convertible.Instances.Ascii () +import Data.Convertible.Utils import Data.Monoid.Unicode import Prelude hiding (min) +import Prelude.Unicode -- |An HTTP version consists of major and minor versions. data HttpVersion @@ -30,19 +35,27 @@ instance Ord HttpVersion where | minA < minB = LT | otherwise = EQ --- |Convert an 'HttpVersion' to 'AsciiBuilder'. -printHttpVersion ∷ HttpVersion → AsciiBuilder -printHttpVersion v - = case v of - -- Optimisation for special cases. - HttpVersion 1 0 → A.toAsciiBuilder "HTTP/1.0" - HttpVersion 1 1 → A.toAsciiBuilder "HTTP/1.1" - -- General (but almost never stumbling) cases. - HttpVersion maj min - → A.toAsciiBuilder "HTTP/" ⊕ - A.toAsciiBuilder (A.unsafeFromString $ show maj) ⊕ - A.toAsciiBuilder "." ⊕ - A.toAsciiBuilder (A.unsafeFromString $ show min) +instance ConvertSuccess HttpVersion Ascii where + {-# INLINE convertSuccess #-} + convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder) + +instance ConvertSuccess HttpVersion AsciiBuilder where + {-# INLINE convertSuccess #-} + convertSuccess v + = case v of + -- Optimisation for special cases. + HttpVersion 1 0 → cs ("HTTP/1.0" ∷ Ascii) + HttpVersion 1 1 → cs ("HTTP/1.1" ∷ Ascii) + -- General (but almost never occuring) cases. + HttpVersion maj min + → cs ("HTTP/" ∷ Ascii) ⊕ + convertUnsafe (show maj) ⊕ + cs ("." ∷ Ascii) ⊕ + convertUnsafe (show min) + +deriveAttempts [ ([t| HttpVersion |], [t| Ascii |]) + , ([t| HttpVersion |], [t| AsciiBuilder |]) + ] -- |'Parser' for an 'HttpVersion'. httpVersion ∷ Parser HttpVersion diff --git a/Network/HTTP/Lucu/Implant.hs b/Network/HTTP/Lucu/Implant.hs index 90c83f2..58e2b2e 100644 --- a/Network/HTTP/Lucu/Implant.hs +++ b/Network/HTTP/Lucu/Implant.hs @@ -17,8 +17,9 @@ module Network.HTTP.Lucu.Implant where import Codec.Compression.GZip import Control.Applicative -import qualified Data.Ascii as A import qualified Data.ByteString.Lazy as L +import Data.Convertible.Base +import Data.Convertible.Instances.Ascii () import Data.Digest.Pure.SHA import Data.Maybe import Data.Time @@ -87,5 +88,5 @@ guessType = guessTypeByFileName defaultExtensionMap mkETagFromInput ∷ L.ByteString → ETag mkETagFromInput input - = strongETag $ A.unsafeFromString + = strongETag $ convertUnsafe $ "SHA-1:" ⧺ showDigest (sha1 input) diff --git a/Network/HTTP/Lucu/Implant/PrettyPrint.hs b/Network/HTTP/Lucu/Implant/PrettyPrint.hs index 51c2de1..5bbc36d 100644 --- a/Network/HTTP/Lucu/Implant/PrettyPrint.hs +++ b/Network/HTTP/Lucu/Implant/PrettyPrint.hs @@ -14,12 +14,12 @@ module Network.HTTP.Lucu.Implant.PrettyPrint where import Codec.Compression.GZip import Control.Monad -import Data.Ascii (CIAscii) +import Data.Ascii (Ascii, CIAscii) import qualified Data.Ascii as A import qualified Data.ByteString.Lazy as L import Data.Char import Data.Collections -import Data.Convertible.Base +import Data.Convertible.Utils import Data.List (intersperse) import Data.Monoid import Data.Ratio @@ -69,7 +69,7 @@ header i@(Input {..}) ] where eTagToDoc ∷ ETag → Doc - eTagToDoc = text ∘ A.toString ∘ A.fromAsciiBuilder ∘ cs + eTagToDoc = text ∘ convertSuccessVia ((⊥) ∷ Ascii) mimeTypeToDoc ∷ MIMEType → Doc mimeTypeToDoc = text ∘ A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType diff --git a/Network/HTTP/Lucu/MIMEParams.hs b/Network/HTTP/Lucu/MIMEParams.hs index fcfee9e..a2b9341 100644 --- a/Network/HTTP/Lucu/MIMEParams.hs +++ b/Network/HTTP/Lucu/MIMEParams.hs @@ -16,7 +16,6 @@ -- (). module Network.HTTP.Lucu.MIMEParams ( MIMEParams - , printMIMEParams , mimeParams ) where @@ -32,6 +31,9 @@ import Data.Char import Data.Collections import Data.Collections.BaseInstances () import qualified Data.Collections.Newtype.TH as C +import Data.Convertible.Base +import Data.Convertible.Instances.Ascii () +import Data.Convertible.Utils import qualified Data.Map as M (Map) import Data.Monoid.Unicode import Data.Sequence (Seq) @@ -55,14 +57,17 @@ C.derive [d| instance Unfoldable MIMEParams (CIAscii, Text) instance SortingCollection MIMEParams (CIAscii, Text) |] --- |Convert MIME parameter values to an 'AsciiBuilder'. -printMIMEParams ∷ MIMEParams → AsciiBuilder -{-# INLINEABLE printMIMEParams #-} -printMIMEParams = foldl' f (∅) - where - f ∷ AsciiBuilder → (CIAscii, Text) → AsciiBuilder - {-# INLINE f #-} - f ab (k, v) = ab ⊕ A.toAsciiBuilder "; " ⊕ printPair k v +instance ConvertSuccess MIMEParams Ascii where + {-# INLINE convertSuccess #-} + convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder) + +instance ConvertSuccess MIMEParams AsciiBuilder where + {-# INLINE convertSuccess #-} + convertSuccess = foldl' f (∅) + where + f ∷ AsciiBuilder → (CIAscii, Text) → AsciiBuilder + {-# INLINE f #-} + f ab (k, v) = ab ⊕ cs ("; " ∷ Ascii) ⊕ printPair k v printPair ∷ CIAscii → Text → AsciiBuilder {-# INLINEABLE printPair #-} @@ -75,19 +80,19 @@ printPair name value printPairInUTF8 ∷ CIAscii → Text → AsciiBuilder {-# INLINEABLE printPairInUTF8 #-} printPairInUTF8 name value - = A.toAsciiBuilder (A.fromCIAscii name) ⊕ - A.toAsciiBuilder "*=utf-8''" ⊕ + = cs name ⊕ + cs ("*=utf-8''" ∷ Ascii) ⊕ escapeUnsafeChars (encodeUtf8 value) (∅) printPairInAscii ∷ CIAscii → Ascii → AsciiBuilder {-# INLINEABLE printPairInAscii #-} printPairInAscii name value - = A.toAsciiBuilder (A.fromCIAscii name) ⊕ - A.toAsciiBuilder "=" ⊕ - if BS.any ((¬) ∘ isToken) (A.toByteString value) then + = cs name ⊕ + cs ("=" ∷ Ascii) ⊕ + if BS.any ((¬) ∘ isToken) (cs value) then quoteStr value else - A.toAsciiBuilder value + cs value escapeUnsafeChars ∷ BS.ByteString → AsciiBuilder → AsciiBuilder {-# INLINEABLE escapeUnsafeChars #-} @@ -96,15 +101,15 @@ escapeUnsafeChars bs b Nothing → b Just (c, bs') | isToken c → escapeUnsafeChars bs' $ - b ⊕ A.toAsciiBuilder (A.unsafeFromString [c]) + b ⊕ cs (A.unsafeFromString [c]) | otherwise → escapeUnsafeChars bs' $ b ⊕ toHex (fromIntegral $ fromEnum c) toHex ∷ Word8 → AsciiBuilder {-# INLINEABLE toHex #-} -toHex o = A.toAsciiBuilder "%" ⊕ - A.toAsciiBuilder (A.unsafeFromString [ toHex' (o `shiftR` 8) - , toHex' (o .&. 0x0F) ]) +toHex o = cs ("%" ∷ Ascii) ⊕ + cs (A.unsafeFromString [ toHex' (o `shiftR` 8) + , toHex' (o .&. 0x0F) ]) where toHex' ∷ Word8 → Char {-# INLINEABLE toHex' #-} diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs index 2861d26..68e9b25 100644 --- a/Network/HTTP/Lucu/MIMEType.hs +++ b/Network/HTTP/Lucu/MIMEType.hs @@ -21,6 +21,9 @@ import Control.Applicative import Data.Ascii (Ascii, AsciiBuilder, CIAscii) import qualified Data.Ascii as A import Data.Attoparsec.Char8 as P +import Data.Convertible.Base +import Data.Convertible.Instances.Ascii () +import Data.Convertible.Utils import Data.Monoid.Unicode import Data.Typeable import Language.Haskell.TH.Syntax @@ -55,7 +58,7 @@ printMIMEType (MIMEType {..}) = A.toAsciiBuilder (A.fromCIAscii mtMedia) ⊕ A.toAsciiBuilder "/" ⊕ A.toAsciiBuilder (A.fromCIAscii mtSub) ⊕ - printMIMEParams mtParams + cs mtParams -- |Parse 'MIMEType' from an 'Ascii'. This function throws an -- exception for parse error. For literals consider using diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index c18819f..e9da057 100644 --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -32,6 +32,9 @@ module Network.HTTP.Lucu.Response where import Data.Ascii (AsciiBuilder) import qualified Data.Ascii as A +import Data.Convertible.Base +import Data.Convertible.Instances.Ascii () +import Data.Convertible.Utils import Data.Monoid.Unicode import Network.HTTP.Lucu.Headers import Network.HTTP.Lucu.HttpVersion @@ -86,11 +89,11 @@ resCanHaveBody (Response {..}) printResponse ∷ Response → AsciiBuilder {-# INLINEABLE printResponse #-} printResponse (Response {..}) - = printHttpVersion resVersion ⊕ + = cs resVersion ⊕ A.toAsciiBuilder " " ⊕ printStatusCode resStatus ⊕ A.toAsciiBuilder "\x0D\x0A" ⊕ - printHeaders resHeaders + cs resHeaders -- |@'isInformational' sc@ returns 'True' iff @sc '<' 200@. isInformational ∷ StatusCode sc ⇒ sc → Bool -- 2.40.0