Code clean-up using convertible-text

[Lucu.git] / Network / HTTP / Lucu / Headers.hs

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index ff3213bc20860e98f18db7a3a89c8e96385cf797..d4c51d5e24ae7681e91aff273ae9c5bbc29b2e70 100644 (file)
--- 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"