Use pretty-class package

12 files changed, 77 insertions, 86 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 3c9c0d38..ff181ff8 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -73,6 +73,7 @@ library
   build-depends:       base       == 4.*
                      , bits-extras
                      , pretty
+                     , pretty-class
 
                        -- Control
                      , deepseq
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index dddd1832..fc0cb10b 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -26,7 +26,6 @@
 module Data.Torrent
        ( -- * Info dictionary
          InfoDict (..)
-       , ppInfoDict
 
          -- ** Lenses
        , infohash
@@ -36,7 +35,6 @@ module Data.Torrent
 
          -- * Torrent file
        , Torrent(..)
-       , ppTorrent
 
          -- ** Lenses
        , announce
@@ -66,12 +64,10 @@ module Data.Torrent
        ) where
 
 import Prelude hiding (sum)
-
 import Control.Applicative
 import Control.DeepSeq
 import Control.Exception
 import Control.Lens
-
 import Data.Aeson.Types (ToJSON(..), FromJSON(..), Value(..), withText)
 import Data.Aeson.TH
 import Data.BEncode as BE
@@ -88,6 +84,7 @@ import Data.Time.Clock.POSIX
 import Data.Typeable
 import Network.URI
 import Text.PrettyPrint as PP
+import Text.PrettyPrint.Class
 import System.FilePath
 
 import Data.Torrent.InfoHash as IH
@@ -156,18 +153,16 @@ instance BEncode InfoDict where
       ih = IH.hashlazy (encode dict)
 
 ppPrivacy :: Bool -> Doc
-ppPrivacy privacy =
-  "Privacy: " <> if privacy then "private" else "public"
+ppPrivacy privacy = "Privacy: " <> if privacy then "private" else "public"
 
 ppAdditionalInfo :: InfoDict -> Doc
 ppAdditionalInfo layout = PP.empty
 
--- | Format info dictionary in human-readable form.
-ppInfoDict :: InfoDict -> Doc
-ppInfoDict InfoDict {..} =
-  ppLayoutInfo idLayoutInfo $$
-  ppPieceInfo  idPieceInfo  $$
-  ppPrivacy    idPrivate
+instance Pretty InfoDict where
+  pretty InfoDict {..} =
+    pretty idLayoutInfo $$
+    pretty  idPieceInfo  $$
+    ppPrivacy    idPrivate
 
 {-----------------------------------------------------------------------
 --  Torrent info
@@ -290,13 +285,13 @@ name <:>   v       = name <> ":" <+> v
 _    <:>?  Nothing = PP.empty
 name <:>? (Just d) = name <:> d
 
-ppTorrent :: Torrent -> Doc
-ppTorrent Torrent {..} =
-       "InfoHash: " <> ppInfoHash (idInfoHash tInfoDict)
+instance Pretty Torrent where
+  pretty Torrent {..} =
+       "InfoHash: " <> pretty (idInfoHash tInfoDict)
     $$ hang "General" 4 generalInfo
     $$ hang "Tracker" 4 trackers
-    $$ ppInfoDict tInfoDict
-  where
+    $$ pretty tInfoDict
+   where
     trackers = case tAnnounceList of
         Nothing  -> text (show tAnnounce)
         Just xxs -> vcat $ L.map ppTier $ L.zip [1..] xxs
diff --git a/src/Data/Torrent/Block.hs b/src/Data/Torrent/Block.hs
index cb50302c..987de653 100644
--- a/src/Data/Torrent/Block.hs
+++ b/src/Data/Torrent/Block.hs
@@ -9,6 +9,7 @@
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE FlexibleInstances          #-}
 module Data.Torrent.Block
        ( -- * Piece attributes
          PieceIx
@@ -22,31 +23,26 @@ module Data.Torrent.Block
 
          -- * Block index
        , BlockIx(..)
-       , ppBlockIx
        , blockIxRange
 
          -- * Block data
        , Block(..)
-       , ppBlock
        , blockIx
        , blockSize
        , blockRange
        ) where
 
 import Control.Applicative
-
 import Data.Aeson.TH
 import qualified Data.ByteString.Lazy as Lazy
 import Data.Char
 import Data.List as L
-
 import Data.Binary as B
 import Data.Binary.Get as B
 import Data.Binary.Put as B
 import Data.Serialize as S
-
 import Text.PrettyPrint
-
+import Text.PrettyPrint.Class
 
 {-----------------------------------------------------------------------
 --  Piece attributes
@@ -147,12 +143,11 @@ instance Binary BlockIx where
     putIntB ixOffset
     putIntB ixLength
 
--- | Format block index in human readable form.
-ppBlockIx :: BlockIx -> Doc
-ppBlockIx BlockIx {..} =
-  "piece  = " <> int ixPiece  <> "," <+>
-  "offset = " <> int ixOffset <> "," <+>
-  "length = " <> int ixLength
+instance Pretty BlockIx where
+  pretty BlockIx {..} =
+    "piece  = " <> int ixPiece  <> "," <+>
+    "offset = " <> int ixOffset <> "," <+>
+    "length = " <> int ixLength
 
 -- | Get location of payload bytes in the torrent content.
 blockIxRange :: (Num a, Integral a) => PieceSize -> BlockIx -> (a, a)
@@ -178,10 +173,10 @@ data Block payload = Block {
   , blkData   :: !payload
   } deriving (Show, Eq)
 
--- | Format block in human readable form. Payload is ommitted.
-ppBlock :: Block Lazy.ByteString -> Doc
-ppBlock = ppBlockIx . blockIx
-{-# INLINE ppBlock #-}
+-- | Payload is ommitted.
+instance Pretty (Block Lazy.ByteString) where
+  pretty = pretty . blockIx
+  {-# INLINE pretty #-}
 
 -- | Get size of block /payload/ in bytes.
 blockSize :: Block Lazy.ByteString -> BlockSize
diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs
index f38f7a5c..0fd6722b 100644
--- a/src/Data/Torrent/Client.hs
+++ b/src/Data/Torrent/Client.hs
@@ -22,10 +22,7 @@
 --
 module Data.Torrent.Client
        ( ClientImpl (..)
-       , ppClientImpl
-       , ppVersion
        , ClientInfo (..)
-       , ppClientInfo
        , libClientInfo
        ) where
 
@@ -41,6 +38,7 @@ import Data.String
 import Data.Text as T
 import Data.Version
 import Text.PrettyPrint hiding ((<>))
+import Text.PrettyPrint.Class
 import Text.Read (readMaybe)
 import Paths_bittorrent (version)
 
@@ -125,9 +123,8 @@ instance IsString ClientImpl where
       alist = L.map mk [minBound..maxBound]
       mk  x = (L.tail $ show x, x)
 
--- | Format client implementation info in human-readable form.
-ppClientImpl :: ClientImpl -> Doc
-ppClientImpl = text . L.tail . show
+instance Pretty ClientImpl where
+  pretty = text . L.tail . show
 
 -- | Just the '0' version.
 instance Default Version where
@@ -141,9 +138,8 @@ instance IsString Version where
     where
       chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==)
 
--- | Format client implementation version in human-readable form.
-ppVersion :: Version -> Doc
-ppVersion = text . showVersion
+instance Pretty Version where
+  pretty = text . showVersion
 
 -- | The all sensible infomation that can be obtained from a peer
 -- identifier or torrent /createdBy/ field.
@@ -164,10 +160,8 @@ instance IsString ClientInfo where
     where
       (impl, _ver) = L.span ((/=) '-') str
 
--- | Format client info in human-readable form.
-ppClientInfo :: ClientInfo -> Doc
-ppClientInfo ClientInfo {..} =
-  ppClientImpl ciImpl <+> "version" <+> ppVersion ciVersion
+instance Pretty ClientInfo where
+  pretty ClientInfo {..} = pretty ciImpl <+> "version" <+> pretty ciVersion
 
 -- | Client info of this (the bittorrent library) package. Normally,
 -- applications should introduce its own idenitifiers, otherwise they
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs
index 2e3946eb..e15fdbb3 100644
--- a/src/Data/Torrent/InfoHash.hs
+++ b/src/Data/Torrent/InfoHash.hs
@@ -19,11 +19,9 @@ module Data.Torrent.InfoHash
          -- * Rendering
        , longHex
        , shortHex
-       , ppInfoHash
 
        , addHashToURI
 
-
        , Data.Torrent.InfoHash.hash
        , Data.Torrent.InfoHash.hashlazy
        ) where
@@ -52,6 +50,7 @@ import Network.URI
 import Numeric
 import Text.ParserCombinators.ReadP as P
 import Text.PrettyPrint
+import Text.PrettyPrint.Class
 
 
 -- | Exactly 20 bytes long SHA1 hash of the info part of torrent file.
@@ -60,7 +59,7 @@ newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString }
 
 -- | for hex encoded strings
 instance Show InfoHash where
-  show = render . ppInfoHash
+  show = render . pretty
 
 -- | for hex encoded strings
 instance Read InfoHash where
@@ -106,6 +105,10 @@ instance FromJSON InfoHash where
 instance URLShow InfoHash where
   urlShow = show
 
+-- | base16 encoded.
+instance Pretty InfoHash where
+  pretty = text . BC.unpack . ppHex . getInfoHash
+
 -- | Tries both base16 and base32 while decoding info hash.
 textToInfoHash :: Text -> Maybe InfoHash
 textToInfoHash text
@@ -127,10 +130,6 @@ longHex = T.decodeUtf8 . Base16.encode . getInfoHash
 shortHex :: InfoHash -> Text
 shortHex = T.take 7 . longHex
 
--- | Pretty print info hash in hexadecimal format.
-ppInfoHash :: InfoHash -> Doc
-ppInfoHash = text . BC.unpack . ppHex . getInfoHash
-
 ppHex :: BS.ByteString -> BS.ByteString
 ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed
 
diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs
index 84085a92..70908c4e 100644
--- a/src/Data/Torrent/Layout.hs
+++ b/src/Data/Torrent/Layout.hs
@@ -24,7 +24,6 @@ module Data.Torrent.Layout
 
          -- * Single file info
        , FileInfo (..)
-       , ppFileInfo
 
          -- ** Lens
        , fileLength
@@ -33,7 +32,6 @@ module Data.Torrent.Layout
 
          -- * File layout
        , LayoutInfo (..)
-       , ppLayoutInfo
        , joinFilePath
 
          -- ** Lens
@@ -78,6 +76,7 @@ import Data.Text as T
 import Data.Text.Encoding as T
 import Data.Typeable
 import Text.PrettyPrint as PP
+import Text.PrettyPrint.Class
 import System.FilePath
 import System.Posix.Types
 
@@ -175,13 +174,12 @@ instance BEncode (FileInfo ByteString) where
   fromBEncode = fromDict getFileInfoSingle
   {-# INLINE fromBEncode #-}
 
--- | Format 'FileInfo' in human-readable form.
-ppFileInfo :: FileInfo ByteString -> Doc
-ppFileInfo FileInfo {..} =
+instance Pretty (FileInfo BS.ByteString) where
+  pretty FileInfo {..} =
        "Path: " <> text (T.unpack (T.decodeUtf8 fiName))
     $$ "Size: " <> text (show fiLength)
     $$ maybe PP.empty ppMD5 fiMD5Sum
-  where
+   where
     ppMD5 md5 = "MD5 : " <> text (show (InfoHash md5))
 
 -- | Join file path.
@@ -242,10 +240,9 @@ instance BEncode LayoutInfo where
   toBEncode   = toDict . (`putLayoutInfo` endDict)
   fromBEncode = fromDict getLayoutInfo
 
--- | Format 'LayoutInfo' in human readable form.
-ppLayoutInfo :: LayoutInfo -> Doc
-ppLayoutInfo SingleFile {..} = ppFileInfo liFile
-ppLayoutInfo MultiFile  {..} = vcat $ L.map (ppFileInfo . joinFilePath) liFiles
+instance Pretty LayoutInfo where
+  pretty SingleFile {..} = pretty liFile
+  pretty MultiFile  {..} = vcat $ L.map (pretty . joinFilePath) liFiles
 
 -- | Test if this is single file torrent.
 isSingleFile :: LayoutInfo -> Bool
diff --git a/src/Data/Torrent/Magnet.hs b/src/Data/Torrent/Magnet.hs
index 01f28a76..791537b1 100644
--- a/src/Data/Torrent/Magnet.hs
+++ b/src/Data/Torrent/Magnet.hs
@@ -43,6 +43,8 @@ import Data.Text as T
 import Data.Text.Encoding as T
 import Network.URI
 import Text.Read
+import Text.PrettyPrint as PP
+import Text.PrettyPrint.Class
 
 import Data.Torrent
 import Data.Torrent.InfoHash
@@ -148,6 +150,9 @@ instance URLEncode Magnet where
   urlEncode = toQuery
   {-# INLINE urlEncode #-}
 
+instance Pretty Magnet where
+  pretty = PP.text . renderMagnet
+
 -- | Set exact topic only, other params are empty.
 nullMagnet :: InfoHash -> Magnet
 nullMagnet u = Magnet
diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs
index c8727a65..6cff53d6 100644
--- a/src/Data/Torrent/Piece.hs
+++ b/src/Data/Torrent/Piece.hs
@@ -21,13 +21,11 @@ module Data.Torrent.Piece
 
          -- * Piece data
        , Piece (..)
-       , ppPiece
        , pieceSize
        , isPiece
 
          -- * Piece control
        , PieceInfo (..)
-       , ppPieceInfo
        , pieceCount
 
          -- * Lens
@@ -61,6 +59,7 @@ import Data.List as L
 import Data.Text.Encoding as T
 import Data.Typeable
 import Text.PrettyPrint
+import Text.PrettyPrint.Class
 
 import Data.Torrent.Block
 
@@ -121,10 +120,9 @@ $(deriveJSON (L.map toLower . L.dropWhile isLower) ''Piece)
 
 instance NFData (Piece a)
 
--- | Format piece in human readable form. Payload bytes are omitted.
-ppPiece :: Piece a -> Doc
-ppPiece Piece {..}
-  = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)
+-- | Payload bytes are omitted.
+instance Pretty (Piece a) where
+  pretty Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)
 
 -- | Get size of piece in bytes.
 pieceSize :: Piece BL.ByteString -> PieceSize
@@ -192,10 +190,9 @@ instance BEncode PieceInfo where
   toBEncode   = toDict . (`putPieceInfo` endDict)
   fromBEncode = fromDict getPieceInfo
 
--- | Format piece info in human readable form. Hashes are omitted.
-ppPieceInfo :: PieceInfo -> Doc
-ppPieceInfo PieceInfo {..} =
-  "Piece size: " <> int piPieceLength
+-- | Hashes are omitted.
+instance Pretty PieceInfo where
+  pretty  PieceInfo {..} = "Piece size: " <> int piPieceLength
 
 hashsize :: Int
 hashsize = 20
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs
index 18a9cd7d..d0aa75c6 100644
--- a/src/Data/Torrent/Progress.hs
+++ b/src/Data/Torrent/Progress.hs
@@ -43,6 +43,8 @@ import Data.Serialize as S
 import Data.Ratio
 import Data.URLEncoded
 import Data.Word
+import Text.PrettyPrint as PP
+import Text.PrettyPrint.Class
 
 
 -- | Progress data is considered as dynamic within one client
@@ -100,6 +102,12 @@ instance URLEncode Progress where
     ]
     where s :: String -> String;  s = id; {-# INLINE s #-}
 
+instance Pretty Progress where
+  pretty Progress {..} =
+    "/\\"  <+> PP.text (show _uploaded)   $$
+    "\\/"  <+> PP.text (show _downloaded) $$
+    "left" <+> PP.text (show _left)
+
 -- | Initial progress is used when there are no session before.
 --
 -- Please note that tracker might penalize client some way if the do
diff --git a/src/Data/Torrent/Tree.hs b/src/Data/Torrent/Tree.hs
index cf71c2ec..102f4dff 100644
--- a/src/Data/Torrent/Tree.hs
+++ b/src/Data/Torrent/Tree.hs
@@ -55,6 +55,8 @@ build MultiFile {..} = Dir $ M.singleton liDirName files
 --decompress :: DirTree () -> [FileInfo ()]
 --decompress = undefined
 
+-- TODO pretty print
+
 -- | Lookup file by path.
 lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a)
 lookup []        t      = Just t
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index 5570bfc1..b145c0d9 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -19,7 +19,6 @@ module Network.BitTorrent.Core.PeerAddr
        , defaultPorts
        , peerSockAddr
        , connectToPeer
-       , ppPeer
        ) where
 
 import Control.Applicative
@@ -34,6 +33,7 @@ import Data.Typeable
 import Data.Word
 import Network.Socket
 import Text.PrettyPrint
+import Text.PrettyPrint.Class
 
 import Data.Torrent.Client
 import Network.BitTorrent.Core.PeerId
@@ -89,6 +89,13 @@ instance Serialize PeerAddr where
   get = PeerAddr Nothing <$> get <*> get
   {-# INLINE get #-}
 
+instance Pretty PeerAddr where
+  pretty p @ PeerAddr {..}
+    | Just pid <- peerID = pretty (clientInfo pid) <+> "at" <+> paddr
+    |     otherwise      = paddr
+    where
+      paddr = text (show (peerSockAddr p))
+
 -- | Ports typically reserved for bittorrent P2P listener.
 defaultPorts :: [PortNumber]
 defaultPorts =  [6881..6889]
@@ -117,11 +124,3 @@ connectToPeer p = do
   sock <- socket AF_INET Stream Network.Socket.defaultProtocol
   connect sock (peerSockAddr p)
   return sock
-
--- | Pretty print peer address in human readable form.
-ppPeer :: PeerAddr -> Doc
-ppPeer p @ PeerAddr {..}
-  | Just pid <- peerID = ppClientInfo (clientInfo pid) <+> "at" <+> paddr
-  |     otherwise      = paddr
-  where
-    paddr = text (show (peerSockAddr p))
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
index a212df3d..6aebe8d4 100644
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ b/src/Network/BitTorrent/Core/PeerId.hs
@@ -16,7 +16,6 @@
 module Network.BitTorrent.Core.PeerId
        ( -- * PeerId
          PeerId (getPeerId)
-       , ppPeerId
 
          -- * Generation
        , genPeerId
@@ -57,6 +56,7 @@ import Data.Version     (Version(Version), versionBranch)
 import System.Entropy   (getEntropy)
 import System.Locale    (defaultTimeLocale)
 import Text.PrettyPrint hiding ((<>))
+import Text.PrettyPrint.Class
 import Text.Read        (readMaybe)
 import Paths_bittorrent (version)
 
@@ -83,9 +83,8 @@ instance IsString PeerId where
     where
       bs = fromString str
 
--- | Format peer id in human readable form.
-ppPeerId :: PeerId -> Doc
-ppPeerId = text . BC.unpack . getPeerId
+instance Pretty PeerId where
+  pretty = text . BC.unpack . getPeerId
 
 {-----------------------------------------------------------------------
 --  Encoding