From c88a76cb1c6ee7e54628b78a56f1a25415a39c30 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 29 Mar 2015 01:06:34 -0400 Subject: Updates to build against newer libraries: * prettyclass instead of deprecated pretty-class * use pPrint instead of pretty * backported to iproute-1.2.11 (convenient for debian jessie) --- src/Network/BitTorrent/Address.hs | 48 +++++++------- src/Network/BitTorrent/DHT/Query.hs | 4 +- src/Network/BitTorrent/DHT/Routing.hs | 4 +- src/Network/BitTorrent/DHT/Session.hs | 12 ++-- src/Network/BitTorrent/Exchange/Block.hs | 12 ++-- src/Network/BitTorrent/Exchange/Connection.hs | 32 +++++----- src/Network/BitTorrent/Exchange/Message.hs | 92 +++++++++++++-------------- src/Network/BitTorrent/Exchange/Session.hs | 20 ++++-- src/Network/BitTorrent/Internal/Progress.hs | 4 +- 9 files changed, 117 insertions(+), 111 deletions(-) (limited to 'src/Network') diff --git a/src/Network/BitTorrent/Address.hs b/src/Network/BitTorrent/Address.hs index eeb04c74..3159fab0 100644 --- a/src/Network/BitTorrent/Address.hs +++ b/src/Network/BitTorrent/Address.hs @@ -110,7 +110,7 @@ import Text.Read (readMaybe) import Network.HTTP.Types.QueryLike import Network.Socket import Text.PrettyPrint as PP hiding ((<>)) -import Text.PrettyPrint.Class +import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) import System.Locale (defaultTimeLocale) import System.Entropy @@ -121,7 +121,7 @@ import System.Entropy -----------------------------------------------------------------------} instance Pretty UTCTime where - pretty = PP.text . show + pPrint = PP.text . show class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a) => Address a where @@ -216,7 +216,7 @@ instance IsString PeerId where bs = fromString str instance Pretty PeerId where - pretty = text . BC.unpack . getPeerId + pPrint = text . BC.unpack . getPeerId instance Convertible BS.ByteString PeerId where safeConvert bs @@ -373,8 +373,8 @@ instance Hashable PortNumber where {-# INLINE hashWithSalt #-} instance Pretty PortNumber where - pretty = PP.int . fromEnum - {-# INLINE pretty #-} + pPrint = PP.int . fromEnum + {-# INLINE pPrint #-} {----------------------------------------------------------------------- -- IP addr @@ -451,16 +451,16 @@ instance Serialize IPv6 where get = fromHostAddress6 <$> get instance Pretty IPv4 where - pretty = PP.text . show - {-# INLINE pretty #-} + pPrint = PP.text . show + {-# INLINE pPrint #-} instance Pretty IPv6 where - pretty = PP.text . show - {-# INLINE pretty #-} + pPrint = PP.text . show + {-# INLINE pPrint #-} instance Pretty IP where - pretty = PP.text . show - {-# INLINE pretty #-} + pPrint = PP.text . show + {-# INLINE pPrint #-} instance Hashable IPv4 where hashWithSalt = hashUsing toHostAddress @@ -569,11 +569,11 @@ instance IsString (PeerAddr IP) where -- | fingerprint + "at" + dotted.host.inet.addr:port -- TODO: instances for IPv6, HostName instance Pretty a => Pretty (PeerAddr a) where - pretty PeerAddr {..} - | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr + pPrint PeerAddr {..} + | Just pid <- peerId = pPrint (fingerprint pid) <+> "at" <+> paddr | otherwise = paddr where - paddr = pretty peerHost <> ":" <> text (show peerPort) + paddr = pPrint peerHost <> ":" <> text (show peerPort) instance Hashable a => Hashable (PeerAddr a) where hashWithSalt s PeerAddr {..} = @@ -649,7 +649,7 @@ instance IsString NodeId where -- | base16 encoded. instance Pretty NodeId where - pretty (NodeId nid) = PP.text $ BC.unpack $ Base16.encode nid + pPrint (NodeId nid) = PP.text $ BC.unpack $ Base16.encode nid -- | Test if the nth bit is set. testIdBit :: NodeId -> Word -> Bool @@ -675,7 +675,7 @@ newtype NodeDistance = NodeDistance BS.ByteString deriving (Eq, Ord) instance Pretty NodeDistance where - pretty (NodeDistance bs) = foldMap bitseq $ BS.unpack bs + pPrint (NodeDistance bs) = foldMap bitseq $ BS.unpack bs where listBits w = L.map (testBit w) (L.reverse [0..bitSize w - 1]) bitseq = foldMap (int . fromEnum) . listBits @@ -721,7 +721,7 @@ instance Hashable a => Hashable (NodeAddr a) where {-# INLINE hashWithSalt #-} instance Pretty ip => Pretty (NodeAddr ip) where - pretty NodeAddr {..} = pretty nodeHost <> ":" <> pretty nodePort + pPrint NodeAddr {..} = pPrint nodeHost <> ":" <> pPrint nodePort -- | Example: -- @@ -755,10 +755,10 @@ instance Serialize a => Serialize (NodeInfo a) where put NodeInfo {..} = put nodeId >> put nodeAddr instance Pretty ip => Pretty (NodeInfo ip) where - pretty NodeInfo {..} = pretty nodeId <> "@(" <> pretty nodeAddr <> ")" + pPrint NodeInfo {..} = pPrint nodeId <> "@(" <> pPrint nodeAddr <> ")" instance Pretty ip => Pretty [NodeInfo ip] where - pretty = PP.vcat . PP.punctuate "," . L.map pretty + pPrint = PP.vcat . PP.punctuate "," . L.map pPrint -- | Order by closeness: nearest nodes first. rank :: Eq ip => NodeId -> [NodeInfo ip] -> [NodeInfo ip] @@ -952,9 +952,9 @@ instance IsString Software where alist = L.map mk [minBound..maxBound] mk x = (L.tail $ show x, x) --- | Example: @pretty 'IBitLet' == \"IBitLet\"@ +-- | Example: @pPrint 'IBitLet' == \"IBitLet\"@ instance Pretty Software where - pretty = text . L.tail . show + pPrint = text . L.tail . show -- | Just the '0' version. instance Default Version where @@ -972,7 +972,7 @@ instance IsString Version where chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==) instance Pretty Version where - pretty = text . showVersion + pPrint = text . showVersion -- | The all sensible infomation that can be obtained from a peer -- identifier or torrent /createdBy/ field. @@ -993,7 +993,7 @@ instance IsString Fingerprint where (impl, _ver) = L.span ((/=) '-') str instance Pretty Fingerprint where - pretty (Fingerprint s v) = pretty s <+> "version" <+> pretty v + pPrint (Fingerprint s v) = pPrint s <+> "version" <+> pPrint v -- | Fingerprint of this (the bittorrent library) package. Normally, -- applications should introduce its own fingerprints, otherwise they @@ -1005,7 +1005,7 @@ libFingerprint = Fingerprint IlibHSbittorrent version -- | HTTP user agent of this (the bittorrent library) package. Can be -- used in HTTP tracker requests. libUserAgent :: String -libUserAgent = render (pretty IlibHSbittorrent <> "/" <> pretty version) +libUserAgent = render (pPrint IlibHSbittorrent <> "/" <> pPrint version) {----------------------------------------------------------------------- -- For torrent file diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs index f7657490..ac53bd91 100644 --- a/src/Network/BitTorrent/DHT/Query.hs +++ b/src/Network/BitTorrent/DHT/Query.hs @@ -53,7 +53,7 @@ import Data.Monoid import Data.Text as T import Network import Text.PrettyPrint as PP hiding ((<>), ($$)) -import Text.PrettyPrint.Class +import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) import Network.KRPC hiding (Options, def) import Data.Torrent @@ -132,7 +132,7 @@ getPeersQ topic NodeInfo {..} = do GotPeers {..} <- GetPeers topic <@> nodeAddr let dist = distance (toNodeId topic) nodeId $(logInfoS) "getPeersQ" $ T.pack - $ "distance: " <> render (pretty dist) <> " , result: " + $ "distance: " <> render (pPrint dist) <> " , result: " <> case peers of { Left _ -> "NODES"; Right _ -> "PEERS" } return peers diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs index ee295125..cb3cf273 100644 --- a/src/Network/BitTorrent/DHT/Routing.hs +++ b/src/Network/BitTorrent/DHT/Routing.hs @@ -71,7 +71,7 @@ import Data.Time.Clock.POSIX import Data.Word import GHC.Generics import Text.PrettyPrint as PP hiding ((<>)) -import Text.PrettyPrint.Class +import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) import Data.Torrent import Network.BitTorrent.Address @@ -325,7 +325,7 @@ instance (Eq ip, Serialize ip) => Serialize (Table ip) -- | Shape of the table. instance Pretty (Table ip) where - pretty t + pPrint t | bucketCount < 6 = hcat $ punctuate ", " $ L.map PP.int ss | otherwise = brackets $ PP.int (L.sum ss) <> " nodes, " <> diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs index 208f8ec8..0c806db2 100644 --- a/src/Network/BitTorrent/DHT/Session.hs +++ b/src/Network/BitTorrent/DHT/Session.hs @@ -90,7 +90,7 @@ import Network (PortNumber) import System.Log.FastLogger import System.Random (randomIO) import Text.PrettyPrint as PP hiding ((<>), ($$)) -import Text.PrettyPrint.Class +import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) import Data.Torrent as Torrent import Network.KRPC hiding (Options, def) @@ -340,7 +340,7 @@ routing = runRouting probeNode refreshNodes getTimestamp probeNode :: Address ip => NodeAddr ip -> DHT ip Bool probeNode addr = do - $(logDebugS) "routing.questionable_node" (T.pack (render (pretty addr))) + $(logDebugS) "routing.questionable_node" (T.pack (render (pPrint addr))) result <- try $ Ping <@> addr let _ = result :: Either SomeException Ping return $ either (const False) (const True) result @@ -351,7 +351,7 @@ probeNode addr = do -- FIXME do not use getClosest sinse we should /refresh/ them refreshNodes :: Address ip => NodeId -> DHT ip [NodeInfo ip] refreshNodes nid = do - $(logDebugS) "routing.refresh_bucket" (T.pack (render (pretty nid))) + $(logDebugS) "routing.refresh_bucket" (T.pack (render (pPrint nid))) nodes <- getClosest nid nss <- forM (nodeAddr <$> nodes) $ \ addr -> do NodeFound ns <- FindNode nid <@> addr @@ -361,7 +361,7 @@ refreshNodes nid = do getTimestamp :: DHT ip Timestamp getTimestamp = do utcTime <- liftIO $ getCurrentTime - $(logDebugS) "routing.make_timestamp" (T.pack (render (pretty utcTime))) + $(logDebugS) "routing.make_timestamp" (T.pack (render (pPrint utcTime))) return $ utcTimeToPOSIXSeconds utcTime {----------------------------------------------------------------------- @@ -419,11 +419,11 @@ insertNode info = fork $ do case result of Nothing -> do $(logDebugS) "insertNode" $ "Routing table is full: " - <> T.pack (show (pretty t)) + <> T.pack (show (pPrint t)) return t Just t' -> do let logMsg = "Routing table updated: " - <> pretty t <> " -> " <> pretty t' + <> pPrint t <> " -> " <> pPrint t' $(logDebugS) "insertNode" (T.pack (render logMsg)) return t' diff --git a/src/Network/BitTorrent/Exchange/Block.hs b/src/Network/BitTorrent/Exchange/Block.hs index ccc7a0a9..bc9a3d24 100644 --- a/src/Network/BitTorrent/Exchange/Block.hs +++ b/src/Network/BitTorrent/Exchange/Block.hs @@ -67,7 +67,7 @@ import Data.Serialize as S import Data.Typeable import Numeric import Text.PrettyPrint as PP hiding ((<>)) -import Text.PrettyPrint.Class +import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) import Data.Torrent @@ -138,7 +138,7 @@ instance Serialize BlockIx where {-# INLINE put #-} instance Pretty BlockIx where - pretty BlockIx {..} = + pPrint BlockIx {..} = ("piece = " <> int ixPiece <> ",") <+> ("offset = " <> int ixOffset <> ",") <+> ("length = " <> int ixLength) @@ -169,8 +169,8 @@ data Block payload = Block { -- | Payload is ommitted. instance Pretty (Block BL.ByteString) where - pretty = pretty . blockIx - {-# INLINE pretty #-} + pPrint = pPrint . blockIx + {-# INLINE pPrint #-} -- | Get size of block /payload/ in bytes. blockSize :: Block BL.ByteString -> BlockSize @@ -241,8 +241,8 @@ valid = check Nothing check (Just False) xs instance Pretty Bucket where - pretty Nil = nilInvFailed - pretty bkt = go bkt + pPrint Nil = nilInvFailed + pPrint bkt = go bkt where go Nil = PP.empty go (Span sz xs) = "Span" <+> PP.int sz <+> go xs diff --git a/src/Network/BitTorrent/Exchange/Connection.hs b/src/Network/BitTorrent/Exchange/Connection.hs index 2d5f39bf..d65d322e 100644 --- a/src/Network/BitTorrent/Exchange/Connection.hs +++ b/src/Network/BitTorrent/Exchange/Connection.hs @@ -131,7 +131,7 @@ import Network import Network.Socket hiding (Connected) import Network.Socket.ByteString as BS import Text.PrettyPrint as PP hiding ((<>)) -import Text.PrettyPrint.Class +import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) import Text.Show.Functions () import System.Log.FastLogger (ToLogStr(..)) import System.Timeout @@ -161,7 +161,7 @@ instance Default ChannelSide where def = ThisPeer instance Pretty ChannelSide where - pretty = PP.text . show + pPrint = PP.text . show -- | A protocol errors occur when a peer violates protocol -- specification. @@ -213,7 +213,7 @@ data ProtocolError deriving Show instance Pretty ProtocolError where - pretty = PP.text . show + pPrint = PP.text . show errorPenalty :: ProtocolError -> Int errorPenalty (InvalidProtocol _) = 1 @@ -256,7 +256,7 @@ data WireFailure instance Exception WireFailure instance Pretty WireFailure where - pretty = PP.text . show + pPrint = PP.text . show -- TODO -- data Penalty = Ban | Penalty Int @@ -288,9 +288,9 @@ data FlowStats = FlowStats } deriving Show instance Pretty FlowStats where - pretty FlowStats {..} = + pPrint FlowStats {..} = PP.int messageCount <+> "messages" $+$ - pretty messageBytes + pPrint messageBytes -- | Zeroed stats. instance Default FlowStats where @@ -328,10 +328,10 @@ data ConnectionStats = ConnectionStats } deriving Show instance Pretty ConnectionStats where - pretty ConnectionStats {..} = vcat - [ "Recv:" <+> pretty incomingFlow - , "Sent:" <+> pretty outcomingFlow - , "Both:" <+> pretty (incomingFlow <> outcomingFlow) + pPrint ConnectionStats {..} = vcat + [ "Recv:" <+> pPrint incomingFlow + , "Sent:" <+> pPrint outcomingFlow + , "Both:" <+> pPrint (incomingFlow <> outcomingFlow) ] -- | Zeroed stats. @@ -493,8 +493,8 @@ data PeerStatus = PeerStatus $(makeLenses ''PeerStatus) instance Pretty PeerStatus where - pretty PeerStatus {..} = - pretty (Choking _choking) <+> "and" <+> pretty (Interested _interested) + pPrint PeerStatus {..} = + pPrint (Choking _choking) <+> "and" <+> pPrint (Interested _interested) -- | Connections start out choked and not interested. instance Default PeerStatus where @@ -535,9 +535,9 @@ data ConnectionStatus = ConnectionStatus $(makeLenses ''ConnectionStatus) instance Pretty ConnectionStatus where - pretty ConnectionStatus {..} = - "this " PP.<+> pretty _clientStatus PP.$$ - "remote" PP.<+> pretty _remoteStatus + pPrint ConnectionStatus {..} = + "this " PP.<+> pPrint _clientStatus PP.$$ + "remote" PP.<+> pPrint _remoteStatus -- | Connections start out choked and not interested. instance Default ConnectionStatus where @@ -646,7 +646,7 @@ data Connection s = Connection } instance Pretty (Connection s) where - pretty Connection {..} = "Connection" + pPrint Connection {..} = "Connection" instance ToLogStr (Connection s) where toLogStr Connection {..} = mconcat diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs index f8b76186..74232b47 100644 --- a/src/Network/BitTorrent/Exchange/Message.hs +++ b/src/Network/BitTorrent/Exchange/Message.hs @@ -115,7 +115,7 @@ import Data.IP import Network import Network.Socket hiding (KeepAlive) import Text.PrettyPrint as PP hiding ((<>)) -import Text.PrettyPrint.Class +import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) import Data.Torrent hiding (Piece (..)) import qualified Data.Torrent as P (Piece (..)) @@ -141,7 +141,7 @@ class Capabilities caps where allowed :: Ext caps -> caps -> Bool ppCaps :: Capabilities caps => Pretty (Ext caps) => caps -> Doc -ppCaps = hcat . punctuate ", " . L.map pretty . fromCaps +ppCaps = hcat . punctuate ", " . L.map pPrint . fromCaps {----------------------------------------------------------------------- -- Extensions @@ -159,9 +159,9 @@ data Extension -- | Full extension names, suitable for logging. instance Pretty Extension where - pretty ExtDHT = "Distributed Hash Table Protocol" - pretty ExtFast = "Fast Extension" - pretty ExtExtended = "Extension Protocol" + pPrint ExtDHT = "Distributed Hash Table Protocol" + pPrint ExtFast = "Fast Extension" + pPrint ExtExtended = "Extension Protocol" -- | Extension bitmask as specified by BEP 4. extMask :: Extension -> Word64 @@ -180,8 +180,8 @@ newtype Caps = Caps Word64 -- | Render set of extensions as comma separated list. instance Pretty Caps where - pretty = ppCaps - {-# INLINE pretty #-} + pPrint = ppCaps + {-# INLINE pPrint #-} -- | The empty set. instance Default Caps where @@ -235,7 +235,7 @@ instance Show ProtocolName where show (ProtocolName bs) = show bs instance Pretty ProtocolName where - pretty (ProtocolName bs) = PP.text $ BC.unpack bs + pPrint (ProtocolName bs) = PP.text $ BC.unpack bs instance IsString ProtocolName where fromString str @@ -287,10 +287,10 @@ instance Serialize Handshake where -- | Show handshake protocol string, caps and fingerprint. instance Pretty Handshake where - pretty Handshake {..} - = pretty hsProtocol $$ - pretty hsReserved $$ - pretty (fingerprint hsPeerId) + pPrint Handshake {..} + = pPrint hsProtocol $$ + pPrint hsReserved $$ + pPrint (fingerprint hsPeerId) -- | Get handshake message size in bytes from the length of protocol -- string. @@ -334,7 +334,7 @@ data ByteStats = ByteStats } deriving Show instance Pretty ByteStats where - pretty s @ ByteStats {..} = fsep + pPrint s @ ByteStats {..} = fsep [ PP.int overhead, "overhead" , PP.int control, "control" , PP.int payload, "payload" @@ -408,10 +408,10 @@ data StatusUpdate deriving (Show, Eq, Ord, Typeable) instance Pretty StatusUpdate where - pretty (Choking False) = "not choking" - pretty (Choking True ) = "choking" - pretty (Interested False) = "not interested" - pretty (Interested True ) = "interested" + pPrint (Choking False) = "not choking" + pPrint (Choking True ) = "choking" + pPrint (Interested False) = "not interested" + pPrint (Interested True ) = "interested" instance PeerMessage StatusUpdate where envelop _ = Status @@ -439,8 +439,8 @@ data Available = deriving (Show, Eq) instance Pretty Available where - pretty (Have ix ) = "Have" <+> int ix - pretty (Bitfield _ ) = "Bitfield" + pPrint (Have ix ) = "Have" <+> int ix + pPrint (Bitfield _ ) = "Bitfield" instance PeerMessage Available where envelop _ = Available @@ -472,9 +472,9 @@ data Transfer deriving (Show, Eq) instance Pretty Transfer where - pretty (Request ix ) = "Request" <+> pretty ix - pretty (Piece blk) = "Piece" <+> pretty blk - pretty (Cancel i ) = "Cancel" <+> pretty i + pPrint (Request ix ) = "Request" <+> pPrint ix + pPrint (Piece blk) = "Piece" <+> pPrint blk + pPrint (Cancel i ) = "Cancel" <+> pPrint i instance PeerMessage Transfer where envelop _ = Transfer @@ -519,11 +519,11 @@ data FastMessage = deriving (Show, Eq) instance Pretty FastMessage where - pretty (HaveAll ) = "Have all" - pretty (HaveNone ) = "Have none" - pretty (SuggestPiece pix) = "Suggest" <+> int pix - pretty (RejectRequest bix) = "Reject" <+> pretty bix - pretty (AllowedFast pix) = "Allowed fast" <+> int pix + pPrint (HaveAll ) = "Have all" + pPrint (HaveNone ) = "Have none" + pPrint (SuggestPiece pix) = "Suggest" <+> int pix + pPrint (RejectRequest bix) = "Reject" <+> pPrint bix + pPrint (AllowedFast pix) = "Allowed fast" <+> int pix instance PeerMessage FastMessage where envelop _ = Fast @@ -556,7 +556,7 @@ instance IsString ExtendedExtension where msg = "fromString: could not parse ExtendedExtension" instance Pretty ExtendedExtension where - pretty ExtMetadata = "Extension for Peers to Send Metadata Files" + pPrint ExtMetadata = "Extension for Peers to Send Metadata Files" fromKey :: BKey -> Maybe ExtendedExtension fromKey "ut_metadata" = Just ExtMetadata @@ -582,8 +582,8 @@ newtype ExtendedCaps = ExtendedCaps { extendedCaps :: ExtendedMap } deriving (Show, Eq) instance Pretty ExtendedCaps where - pretty = ppCaps - {-# INLINE pretty #-} + pPrint = ppCaps + {-# INLINE pPrint #-} -- | The empty set. instance Default ExtendedCaps where @@ -738,7 +738,7 @@ getYourIp f = _ -> fail "" instance Pretty ExtendedHandshake where - pretty = PP.text . show + pPrint = PP.text . show -- | NOTE: Approximated 'stats'. instance PeerMessage ExtendedHandshake where @@ -760,7 +760,7 @@ nullExtendedHandshake caps = ExtendedHandshake , ehsMetadataSize = Nothing , ehsPort = Nothing , ehsQueueLength = Just defaultQueueLength - , ehsVersion = Just $ T.pack $ render $ pretty libFingerprint + , ehsVersion = Just $ T.pack $ render $ pPrint libFingerprint , ehsYourIp = Nothing } @@ -843,10 +843,10 @@ instance BEncode ExtendedMetadata where -- | Piece data bytes are omitted. instance Pretty ExtendedMetadata where - pretty (MetadataRequest pix ) = "Request" <+> PP.int pix - pretty (MetadataData p t) = "Data" <+> pretty p <+> PP.int t - pretty (MetadataReject pix ) = "Reject" <+> PP.int pix - pretty (MetadataUnknown bval ) = "Unknown" <+> ppBEncode bval + pPrint (MetadataRequest pix ) = "Request" <+> PP.int pix + pPrint (MetadataData p t) = "Data" <+> pPrint p <+> PP.int t + pPrint (MetadataReject pix ) = "Reject" <+> PP.int pix + pPrint (MetadataUnknown bval ) = "Unknown" <+> ppBEncode bval -- | NOTE: Approximated 'stats'. instance PeerMessage ExtendedMetadata where @@ -957,9 +957,9 @@ data ExtendedMessage deriving (Show, Eq, Typeable) instance Pretty ExtendedMessage where - pretty (EHandshake ehs) = pretty ehs - pretty (EMetadata _ msg) = "Metadata" <+> pretty msg - pretty (EUnknown mid _ ) = "Unknown" <+> PP.text (show mid) + pPrint (EHandshake ehs) = pPrint ehs + pPrint (EMetadata _ msg) = "Metadata" <+> pPrint msg + pPrint (EUnknown mid _ ) = "Unknown" <+> PP.text (show mid) instance PeerMessage ExtendedMessage where envelop _ = Extended @@ -1010,13 +1010,13 @@ instance Default Message where -- | Payload bytes are omitted. instance Pretty Message where - pretty (KeepAlive ) = "Keep alive" - pretty (Status m) = "Status" <+> pretty m - pretty (Available m) = pretty m - pretty (Transfer m) = pretty m - pretty (Port p) = "Port" <+> int (fromEnum p) - pretty (Fast m) = pretty m - pretty (Extended m) = pretty m + pPrint (KeepAlive ) = "Keep alive" + pPrint (Status m) = "Status" <+> pPrint m + pPrint (Available m) = pPrint m + pPrint (Transfer m) = pPrint m + pPrint (Port p) = "Port" <+> int (fromEnum p) + pPrint (Fast m) = pPrint m + pPrint (Extended m) = pPrint m instance PeerMessage Message where envelop _ = id diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs index 2bd275bd..ca849c23 100644 --- a/src/Network/BitTorrent/Exchange/Session.hs +++ b/src/Network/BitTorrent/Exchange/Session.hs @@ -1,7 +1,9 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} module Network.BitTorrent.Exchange.Session ( -- * Session Session @@ -43,7 +45,7 @@ import Data.Set as S import Data.Text as T import Data.Typeable import Text.PrettyPrint hiding ((<>)) -import Text.PrettyPrint.Class +import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) import System.Log.FastLogger (LogStr, ToLogStr (..)) import Data.BEncode as BE @@ -57,6 +59,10 @@ import Network.BitTorrent.Exchange.Download as D import Network.BitTorrent.Exchange.Message as Message import System.Torrent.Storage +#if !MIN_VERSION_iproute(1,2,12) +deriving instance Ord IP +#endif + {----------------------------------------------------------------------- -- Exceptions -----------------------------------------------------------------------} @@ -222,11 +228,11 @@ instance MonadLogger (Connected Session) where conn <- ask ses <- asks connSession addr <- asks connRemoteAddr - let addrSrc = src <> " @ " <> T.pack (render (pretty addr)) + let addrSrc = src <> " @ " <> T.pack (render (pPrint addr)) liftIO $ sessionLogger ses loc addrSrc lvl (toLogStr msg) logMessage :: MonadLogger m => Message -> m () -logMessage msg = logDebugN $ T.pack (render (pretty msg)) +logMessage msg = logDebugN $ T.pack (render (pPrint msg)) logEvent :: MonadLogger m => Text -> m () logEvent = logInfoN diff --git a/src/Network/BitTorrent/Internal/Progress.hs b/src/Network/BitTorrent/Internal/Progress.hs index 9aff9935..6ac889e2 100644 --- a/src/Network/BitTorrent/Internal/Progress.hs +++ b/src/Network/BitTorrent/Internal/Progress.hs @@ -45,7 +45,7 @@ import Data.Ratio import Data.Word import Network.HTTP.Types.QueryLike import Text.PrettyPrint as PP -import Text.PrettyPrint.Class +import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) -- | Progress data is considered as dynamic within one client @@ -104,7 +104,7 @@ instance QueryLike Progress where ] instance Pretty Progress where - pretty Progress {..} = + pPrint Progress {..} = "/\\" <+> PP.text (show _uploaded) $$ "\\/" <+> PP.text (show _downloaded) $$ "left" <+> PP.text (show _left) -- cgit v1.2.3