using blaze-builder.

3 files changed, 48 insertions, 48 deletions

diff --git a/Network/DNS/Query.hs b/Network/DNS/Query.hs
index a431dbd..3c4852e 100644
--- a/Network/DNS/Query.hs
+++ b/Network/DNS/Query.hs
@@ -4,6 +4,10 @@ import qualified Data.ByteString.Lazy.Char8 as L
 import Data.Char
 import Network.DNS.StateBinary
 import Network.DNS.Internal
+import Data.Monoid
+
+(+++) :: Monoid a => a -> a -> a
+(+++) = mappend
 
 ----------------------------------------------------------------
 
@@ -22,52 +26,47 @@ composeQuery idt qs = runSPut (encodeQuery qry)
 ----------------------------------------------------------------
 
 encodeQuery :: DNSFormat -> SPut
-encodeQuery fmt = do
-  let hdr = header fmt
-      qs = question fmt
-  encodeHeader hdr
-  encodeQuestion qs
-  return ()
+encodeQuery fmt = encodeHeader hdr
+              +++ encodeQuestion qs
+  where
+    hdr = header fmt
+    qs = question fmt
 
 encodeHeader :: DNSHeader -> SPut
-encodeHeader hdr = do
-    encodeIdentifier $ identifier hdr
-    encodeFlags $ flags hdr
-    decodeQdCount $ qdCount hdr
-    decodeAnCount $ anCount hdr
-    decodeNsCount $ nsCount hdr
-    decodeArCount $ arCount hdr
+encodeHeader hdr = encodeIdentifier (identifier hdr)
+               +++ encodeFlags (flags hdr)
+               +++ decodeQdCount (qdCount hdr)
+               +++ decodeAnCount (anCount hdr)
+               +++ decodeNsCount (nsCount hdr)
+               +++ decodeArCount (arCount hdr)
   where
-    encodeIdentifier = putInt16
-    decodeQdCount = putInt16
-    decodeAnCount = putInt16
-    decodeNsCount = putInt16
-    decodeArCount = putInt16
+    encodeIdentifier = putInt16 . fromIntegral
+    decodeQdCount = putInt16 . fromIntegral
+    decodeAnCount = putInt16 . fromIntegral
+    decodeNsCount = putInt16 . fromIntegral
+    decodeArCount = putInt16 . fromIntegral
 
 encodeFlags :: DNSFlags -> SPut
 encodeFlags _ = put16 0x0100 -- xxx
 
 encodeQuestion :: [Question] -> SPut
-encodeQuestion qs = do
-  let q = head qs
-      dom = qname q
-      typ = qtype q
-  encodeDomain dom
-  putInt16 . typeToInt $ typ
-  put16 1
+encodeQuestion qs = encodeDomain dom
+                +++ putInt16 (fromIntegral (typeToInt typ))
+                +++ put16 1
+  where
+    q = head qs
+    dom = qname q
+    typ = qtype q
 
 ----------------------------------------------------------------
 
 encodeDomain :: Domain -> SPut
-encodeDomain dom = do
-    let ss = split '.' dom
-        ls = map length ss
-    mapM_ encodeSubDomain $ zip ls ss
-    put8 0
+encodeDomain dom = foldr (+++) (put8 0) (map encodeSubDomain $ zip ls ss)
   where
-    encodeSubDomain (len,sub) = do
-      putInt8 len
-      mapM_ (putInt8 . ord) sub
+    ss = split '.' dom
+    ls = map length ss
+    encodeSubDomain (len,sub) = putInt8 (fromIntegral len)
+                            +++ foldr (+++) mempty (map (putInt8 . fromIntegral . ord) sub)
 
 split :: Char -> String -> [String]
 split _ "" = []
diff --git a/Network/DNS/StateBinary.hs b/Network/DNS/StateBinary.hs
index ffbf728..5099104 100644
--- a/Network/DNS/StateBinary.hs
+++ b/Network/DNS/StateBinary.hs
@@ -1,10 +1,11 @@
 module Network.DNS.StateBinary where
 
+import Blaze.ByteString.Builder
 import Control.Monad.State
 import Data.Binary.Get
-import Data.Binary.Put
 import qualified Data.ByteString.Lazy.Char8 as L
 import Data.Char
+import Data.Int
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IM (insert, lookup, empty)
 import Data.Word
@@ -36,25 +37,25 @@ x <$ y = y >> return x
 
 ----------------------------------------------------------------
 
-type SPut = Put
+type SPut = Write
 
 put8 :: Word8 -> SPut
-put8  = putWord8
+put8  = writeWord8
 
 put16 :: Word16 -> SPut
-put16 = putWord16be
+put16 = writeWord16be
 
 put32 :: Word32 -> SPut
-put32 = putWord32be
+put32 = writeWord32be
 
-putInt8 :: Int -> SPut
-putInt8  = put8  . fromIntegral
+putInt8 :: Int8 -> SPut
+putInt8  = writeInt8
 
-putInt16 :: Int -> SPut
-putInt16 = put16 . fromIntegral
+putInt16 :: Int16 -> SPut
+putInt16 = writeInt16be
 
-putInt32 :: Int -> SPut
-putInt32 = put32 . fromIntegral
+putInt32 :: Int32 -> SPut
+putInt32 = writeInt32be
 
 ----------------------------------------------------------------
 
@@ -105,5 +106,5 @@ initialState = IM.empty
 runSGet :: SGet DNSFormat -> L.ByteString -> DNSFormat
 runSGet res bs = fst $ runGet (runStateT res initialState) bs
 
-runSPut :: Put -> L.ByteString
-runSPut = runPut
+runSPut :: SPut -> L.ByteString
+runSPut = toLazyByteString . fromWrite
diff --git a/dns.cabal b/dns.cabal
index 7f71d37..316dcac 100644
--- a/dns.cabal
+++ b/dns.cabal
@@ -30,12 +30,12 @@ library
     Build-Depends:      base >= 4 && < 5,
                         binary, iproute,
                         containers, mtl, bytestring, random,
-                        network >= 2.3
+                        network >= 2.3, blaze-builder
   else
     Build-Depends:      base >= 4 && < 5,
                         binary, iproute,
                         containers, mtl, bytestring, random,
-                        network, network-bytestring
+                        network, network-bytestring, blaze-builder
 Source-Repository head
   Type:                 git
   Location:             git://github.com/kazu-yamamoto/dns.git