X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHandleLike.hs;h=f38fa5b88057090f3014289790b0674a6a0dc07c;hb=ea2b783;hp=aa4dacbee7c3e00983c2f61afda2931fe10edb57;hpb=73b5fba4907604681d778d3bd54cd65fd84b4454;p=Lucu.git

diff --git a/Network/HTTP/Lucu/HandleLike.hs b/Network/HTTP/Lucu/HandleLike.hs
index aa4dacb..f38fa5b 100644
--- a/Network/HTTP/Lucu/HandleLike.hs
+++ b/Network/HTTP/Lucu/HandleLike.hs
@@ -1,32 +1,32 @@
+{-# LANGUAGE
+    UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.HandleLike
     ( HandleLike(..)
+    , hPutBuilder
     )
     where
-
+import Blaze.ByteString.Builder (Builder)
+import qualified Blaze.ByteString.Builder as BB
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified OpenSSL.Session as SSL
-import           OpenSSL.X509
+import OpenSSL.X509
+import Prelude.Unicode
 import qualified System.IO as I
 
-
 class HandleLike h where
-    hGetLBS :: h -> IO L.ByteString
-    hPutLBS :: h -> L.ByteString -> IO ()
-
-    hGetBS  :: h -> Int -> IO B.ByteString
-    hPutBS  :: h -> B.ByteString -> IO ()
+    hGetLBS ∷ h → IO L.ByteString
+    hPutLBS ∷ h → L.ByteString → IO ()
 
-    hPutChar  :: h -> Char -> IO ()
+    hGetBS  ∷ h → Int → IO B.ByteString
+    hPutBS  ∷ h → B.ByteString → IO ()
 
-    hPutStr   :: h -> String -> IO ()
-    hPutStrLn :: h -> String -> IO ()
-
-    hGetPeerCert :: h -> IO (Maybe X509)
+    hGetPeerCert ∷ h → IO (Maybe X509)
     hGetPeerCert = const $ return Nothing
 
-    hFlush  :: h -> IO ()
-    hClose  :: h -> IO ()
+    hFlush  ∷ h → IO ()
+    hClose  ∷ h → IO ()
 
 
 instance HandleLike I.Handle where
@@ -36,11 +36,6 @@ instance HandleLike I.Handle where
     hGetBS  = B.hGet
     hPutBS  = B.hPut
 
-    hPutChar  = I.hPutChar
-
-    hPutStr   = I.hPutStr
-    hPutStrLn = I.hPutStrLn
-
     hFlush  = I.hFlush
     hClose  = I.hClose
 
@@ -52,11 +47,6 @@ instance HandleLike SSL.SSL where
     hGetBS    = SSL.read
     hPutBS    = SSL.write
 
-    hPutChar  s = hPutLBS s . L.singleton
-
-    hPutStr   s = hPutLBS s . L.pack
-    hPutStrLn s = hPutLBS s . L.pack . (++ "\n")
-
     hGetPeerCert s
         = do isValid <- SSL.getVerifyResult s
              if isValid then
@@ -64,5 +54,9 @@ instance HandleLike SSL.SSL where
                else
                  return Nothing
 
-    hFlush _  = return () -- unneeded
+    hFlush _  = return () -- No need to do anything.
     hClose s  = SSL.shutdown s SSL.Bidirectional
+
+hPutBuilder ∷ HandleLike h ⇒ h → Builder → IO ()
+{-# INLINE hPutBuilder #-}
+hPutBuilder = BB.toByteStringIO ∘ hPutBS