~ Use pretty package for pretty print.

This is a bit faster and pretty!

8 files changed, 58 insertions, 35 deletions

diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index 3d5f669e..464bc5bb 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -52,6 +52,7 @@ import qualified Data.ByteString.Lazy as Lazy
 import qualified Data.List as L
 import           Data.Text (Text)
 import           Data.Serialize as S hiding (Result)
+import           Text.PrettyPrint
 import qualified Crypto.Hash.SHA1 as C
 import Network.URI
 import System.FilePath
@@ -307,9 +308,10 @@ newtype InfoHash = InfoHash { getInfoHash :: ByteString }
 
 instance BEncodable InfoHash where
   toBEncode = toBEncode . getInfoHash
+  fromBEncode be = InfoHash <$> fromBEncode be
 
 instance Show InfoHash where
-  show = BC.unpack . ppInfoHash
+  show = render . ppInfoHash
 
 instance Serialize InfoHash where
   put = putByteString . getInfoHash
@@ -329,9 +331,11 @@ hash = InfoHash . C.hash
 hashlazy :: Lazy.ByteString -> InfoHash
 hashlazy = InfoHash . C.hashlazy
 
-ppInfoHash :: InfoHash -> ByteString
-ppInfoHash = Lazy.toStrict . B.toLazyByteString .
-        foldMap (B.primFixed B.word8HexFixed) . B.unpack . getInfoHash
+ppInfoHash :: InfoHash -> Doc
+ppInfoHash = text . BC.unpack . Lazy.toStrict . ppHex . getInfoHash
+
+ppHex :: ByteString -> Lazy.ByteString
+ppHex = B.toLazyByteString . foldMap (B.primFixed B.word8HexFixed) . B.unpack
 
 addHashToURI :: URI -> InfoHash -> URI
 addHashToURI uri s = uri {
diff --git a/src/Network/BitTorrent/Extension.hs b/src/Network/BitTorrent/Extension.hs
index e37f3afb..4b71f91f 100644
--- a/src/Network/BitTorrent/Extension.hs
+++ b/src/Network/BitTorrent/Extension.hs
@@ -9,20 +9,21 @@
 --
 --   > See http://www.bittorrent.org/beps/bep_0004.html
 --
+{-# LANGUAGE OverloadedStrings #-}
 module Network.BitTorrent.Extension
        ( Capabilities, ppCaps, defaultCaps, enabledCaps
        , Extension, ppExtension, encodeExts, decodeExts
        ) where
 
 import Data.Bits
-import Data.List
 import Data.Word
+import Text.PrettyPrint
 
 
 type Capabilities = Word64
 
-ppCaps :: Capabilities -> String
-ppCaps = intercalate ", " . map ppExtension . decodeExts
+ppCaps :: Capabilities -> Doc
+ppCaps = hcat . punctuate ", " . map ppExtension . decodeExts
 
 defaultCaps :: Capabilities
 defaultCaps = 0
@@ -38,7 +39,7 @@ data Extension = ExtDHT  -- ^ BEP 5
                | ExtFast -- ^ BEP 6
                  deriving (Show, Eq, Ord, Enum, Bounded)
 
-ppExtension :: Extension -> String
+ppExtension :: Extension -> Doc
 ppExtension ExtDHT  = "DHT"
 ppExtension ExtFast = "Fast Extension"
 
diff --git a/src/Network/BitTorrent/Peer/Addr.hs b/src/Network/BitTorrent/Peer/Addr.hs
index 1c2ac2eb..5c05180a 100644
--- a/src/Network/BitTorrent/Peer/Addr.hs
+++ b/src/Network/BitTorrent/Peer/Addr.hs
@@ -6,6 +6,7 @@
 --   Portability :  non-portable
 --
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS  -fno-warn-orphans #-}
 module Network.BitTorrent.Peer.Addr
        ( PeerAddr(..)
@@ -17,6 +18,7 @@ import Control.Applicative
 import Data.BEncode
 import Data.Bits
 import Data.Word
+import Text.PrettyPrint
 import Network
 import Network.Socket
 
@@ -73,6 +75,9 @@ connectToPeer p = do
   connect sock (peerSockAddr p)
   return sock
 
-ppPeer :: PeerAddr -> String
-ppPeer p = maybe ""  (++ " at ") ((ppClientInfo . clientInfo) <$> peerID p)
-        ++ show (peerSockAddr p)
+ppPeer :: PeerAddr -> Doc
+ppPeer p @ PeerAddr {..} = case peerID of
+    Just pid -> ppClientInfo (clientInfo pid) <+> "at" <+> paddr
+    Nothing  -> paddr
+  where
+    paddr = text (show (peerSockAddr p))
diff --git a/src/Network/BitTorrent/Peer/ClientInfo.hs b/src/Network/BitTorrent/Peer/ClientInfo.hs
index ebbecbd7..bf7fcaab 100644
--- a/src/Network/BitTorrent/Peer/ClientInfo.hs
+++ b/src/Network/BitTorrent/Peer/ClientInfo.hs
@@ -12,6 +12,7 @@
 --  > See http://bittorrent.org/beps/bep_0020.html for more information.
 --
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 module Network.BitTorrent.Peer.ClientInfo
        ( -- * Info
          ClientInfo(..), clientInfo, ppClientInfo, unknownClient
@@ -30,6 +31,7 @@ import Control.Applicative
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BC
 import Data.Serialize.Get
+import Text.PrettyPrint
 
 import Network.BitTorrent.Peer.ID
 
@@ -163,8 +165,8 @@ parseImpl = f . BC.unpack
   f _    = IUnknown
 
 -- | Format client implementation info in human readable form.
-ppClientImpl :: ClientImpl -> String
-ppClientImpl = tail . show
+ppClientImpl :: ClientImpl -> Doc
+ppClientImpl = text . tail . show
 
 unknownImpl :: ClientImpl
 unknownImpl = IUnknown
@@ -174,8 +176,8 @@ unknownImpl = IUnknown
 type ClientVersion = ByteString
 
 -- | Format client implementation version in human readable form.
-ppClientVersion :: ClientVersion -> String
-ppClientVersion = BC.unpack
+ppClientVersion :: ClientVersion -> Doc
+ppClientVersion = text . BC.unpack
 
 unknownVersion :: ClientVersion
 unknownVersion = "0000"
@@ -189,9 +191,10 @@ data ClientInfo = ClientInfo {
   } deriving (Show, Eq, Ord)
 
 -- | Format client implementation in human readable form.
-ppClientInfo :: ClientInfo -> String
-ppClientInfo ci = ppClientImpl    (ciImpl ci) ++ " version "
-               ++ ppClientVersion (ciVersion ci)
+ppClientInfo :: ClientInfo -> Doc
+ppClientInfo ClientInfo {..} =
+  ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion
+
 
 -- | Unrecognized client implementation.
 unknownClient :: ClientInfo
diff --git a/src/Network/BitTorrent/Peer/ID.hs b/src/Network/BitTorrent/Peer/ID.hs
index f93409ed..9bf0ae31 100644
--- a/src/Network/BitTorrent/Peer/ID.hs
+++ b/src/Network/BitTorrent/Peer/ID.hs
@@ -44,6 +44,7 @@ import Data.URLEncoded
 import Data.Version     (Version(Version), versionBranch)
 import Data.Time.Clock  (getCurrentTime)
 import Data.Time.Format (formatTime)
+import Text.PrettyPrint (text, Doc)
 import System.Locale    (defaultTimeLocale)
 
 
@@ -64,8 +65,8 @@ instance Serialize PeerID where
 instance URLShow PeerID where
   urlShow = BC.unpack . getPeerID
 
-ppPeerID :: PeerID -> String
-ppPeerID = BC.unpack . getPeerID
+ppPeerID :: PeerID -> Doc
+ppPeerID = text . BC.unpack . getPeerID
 
 
 -- | Azureus-style encoding have the following layout:
diff --git a/src/Network/BitTorrent/PeerWire/Block.hs b/src/Network/BitTorrent/PeerWire/Block.hs
index fbc65338..dea37321 100644
--- a/src/Network/BitTorrent/PeerWire/Block.hs
+++ b/src/Network/BitTorrent/PeerWire/Block.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Network.BitTorrent.PeerWire.Block
        ( BlockIx(..)
        , Block(..), blockSize
@@ -16,6 +18,7 @@ import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import Data.Int
 import Data.Serialize
+import Text.PrettyPrint
 
 
 type BlockLIx = Int
@@ -51,10 +54,11 @@ instance Serialize BlockIx where
               putInt (ixLength ix)
   {-# INLINE put #-}
 
-ppBlockIx :: BlockIx -> String
-ppBlockIx ix = "piece = "  ++ show (ixPiece ix)  ++ ", "
-            ++ "offset = " ++ show (ixOffset ix) ++ ", "
-            ++ "length = " ++ show (ixLength ix)
+ppBlockIx :: BlockIx -> Doc
+ppBlockIx BlockIx {..} =
+  "piece  = " <> int ixPiece  <> "," <+>
+  "offset = " <> int ixOffset <> "," <+>
+  "length = " <> int ixLength
 
 data Block = Block {
     -- | Zero-based piece index.
@@ -67,7 +71,7 @@ data Block = Block {
   , blkData   :: ByteString
   } deriving (Show, Eq)
 
-ppBlock :: Block -> String
+ppBlock :: Block -> Doc
 ppBlock = ppBlockIx . blockIx
 
 blockSize :: Block -> Int
diff --git a/src/Network/BitTorrent/PeerWire/Handshake.hs b/src/Network/BitTorrent/PeerWire/Handshake.hs
index 6f4598ae..ff768cae 100644
--- a/src/Network/BitTorrent/PeerWire/Handshake.hs
+++ b/src/Network/BitTorrent/PeerWire/Handshake.hs
@@ -11,6 +11,7 @@
 --   peer.
 --
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 module Network.BitTorrent.PeerWire.Handshake
        ( Handshake(..), handshakeCaps
        , handshake
@@ -27,6 +28,8 @@ import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import Data.Serialize as S
+import Text.PrettyPrint
+
 import Network
 import Network.Socket.ByteString
 
@@ -77,9 +80,9 @@ handshakeCaps :: Handshake -> Capabilities
 handshakeCaps = hsReserved
 
 -- | Format handshake in human readable form.
-ppHandshake :: Handshake -> String
-ppHandshake hs = BC.unpack (hsProtocol hs) ++ " "
-              ++ ppClientInfo (clientInfo (hsPeerID hs))
+ppHandshake :: Handshake -> Doc
+ppHandshake Handshake {..} =
+  text (BC.unpack hsProtocol) <+> ppClientInfo (clientInfo hsPeerID)
 
 -- | Get handshake message size in bytes from the length of protocol string.
 handshakeSize :: Word8 -> Int
diff --git a/src/Network/BitTorrent/PeerWire/Message.hs b/src/Network/BitTorrent/PeerWire/Message.hs
index f5ad2693..6515fdf2 100644
--- a/src/Network/BitTorrent/PeerWire/Message.hs
+++ b/src/Network/BitTorrent/PeerWire/Message.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Network.BitTorrent.PeerWire.Message
        ( Message(..)
        , Bitfield
@@ -7,6 +8,7 @@ module Network.BitTorrent.PeerWire.Message
 import Control.Applicative
 import qualified Data.ByteString as B
 import Data.Serialize
+import Text.PrettyPrint
 import Network
 
 import Network.BitTorrent.PeerWire.Block
@@ -141,10 +143,10 @@ instance Serialize Message where
 --   compact and suitable for logging: only useful information but not
 --   payload bytes.
 --
-ppMessage :: Message -> String
-ppMessage (Bitfield _)       = "Bitfield "
-ppMessage (Piece blk)        = "Piece "    ++ ppBlock blk
-ppMessage (Cancel ix)        = "Cancel "   ++ ppBlockIx ix
-ppMessage (SuggestPiece pix) = "Suggest"   ++ show pix
-ppMessage (RejectRequest ix) = "Reject"    ++ ppBlockIx ix
-ppMessage msg = show msg
\ No newline at end of file
+ppMessage :: Message -> Doc
+ppMessage (Bitfield _)       = "Bitfield"
+ppMessage (Piece blk)        = "Piece"    <+> ppBlock blk
+ppMessage (Cancel ix)        = "Cancel"   <+> ppBlockIx ix
+ppMessage (SuggestPiece pix) = "Suggest"  <+> int pix
+ppMessage (RejectRequest ix) = "Reject"   <+> ppBlockIx ix
+ppMessage msg = text (show msg)
\ No newline at end of file