]> gitweb @ CieloNegro.org - Lucu.git/commitdiff
Code clean-up using convertible-text
authorPHO <pho@cielonegro.org>
Mon, 19 Dec 2011 05:34:59 +0000 (14:34 +0900)
committerPHO <pho@cielonegro.org>
Mon, 19 Dec 2011 05:34:59 +0000 (14:34 +0900)
Ditz-issue: 0a2a377be55430e655ab42fdc4902fa56a058b26

Network/HTTP/Lucu/ETag.hs
Network/HTTP/Lucu/Headers.hs
Network/HTTP/Lucu/HttpVersion.hs
Network/HTTP/Lucu/Implant.hs
Network/HTTP/Lucu/Implant/PrettyPrint.hs
Network/HTTP/Lucu/MIMEParams.hs
Network/HTTP/Lucu/MIMEType.hs
Network/HTTP/Lucu/Response.hs

index 3ebfc1d91b35b3f7e676571d0ed981a813b67dbf..6d09aee5673634d273d0296623404b5f29704761 100644 (file)
@@ -10,7 +10,6 @@
 -- |An internal module for entity tags.
 module Network.HTTP.Lucu.ETag
     ( ETag(..)
-
     , strongETag
     , weakETag
     , eTag
index ff3213bc20860e98f18db7a3a89c8e96385cf797..d4c51d5e24ae7681e91aff273ae9c5bbc29b2e70 100644 (file)
@@ -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"
index 4466f1ecda8959aa102e76e6137cd57c8b53e420..889042728fcdd310811bdfce67659430d1cbab32 100644 (file)
@@ -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
index 90c83f2f151c6c7d3563697d1ef0b921d18d683f..58e2b2e97e618f92dc77027ef1ba033edb9e9894 100644 (file)
@@ -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)
index 51c2de104cf807d4bf44712e337c2fdaef405567..5bbc36d8d470508904ce8247485d9ef0947ce72b 100644 (file)
@@ -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
index fcfee9e36f43737b426e0f4e20d8b0ab03905908..a2b93412a7eecb6d9be0eb5ccd77b7e13e02507a 100644 (file)
@@ -16,7 +16,6 @@
 -- (<http://tools.ietf.org/html/rfc2231>).
 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' #-}
index 2861d2670e15e55d00881a6ac69d34731abf0803..68e9b255e54b0d1fdac608b97cd54ccbb28b5481 100644 (file)
@@ -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
index c18819f8f8ceb782a7e1938f3121c7a5d887beab..e9da057c4bdb07415ccc944bd6bcd902f81354d1 100644 (file)
@@ -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