From ed25a297094b483dce06e14d52ced2f93f6dca41 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Sat, 23 Nov 2013 03:37:15 +0400 Subject: Use pretty-class package --- src/Data/Torrent.hs | 29 ++++++++++++----------------- src/Data/Torrent/Block.hs | 27 +++++++++++---------------- src/Data/Torrent/Client.hs | 20 +++++++------------- src/Data/Torrent/InfoHash.hs | 13 ++++++------- src/Data/Torrent/Layout.hs | 17 +++++++---------- src/Data/Torrent/Magnet.hs | 5 +++++ src/Data/Torrent/Piece.hs | 17 +++++++---------- src/Data/Torrent/Progress.hs | 8 ++++++++ src/Data/Torrent/Tree.hs | 2 ++ 9 files changed, 65 insertions(+), 73 deletions(-) (limited to 'src/Data') 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 -- cgit v1.2.3