From 09fbfdacd0b160459baf7827c0d7342bd2ca5983 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Fri, 1 Nov 2013 11:04:42 +0400 Subject: Add documentation to Layout module --- src/Data/Torrent/Block.hs | 33 ++++++++++++++++---------------- src/Data/Torrent/Layout.hs | 47 ++++++++++++++++++++++++++++++++-------------- src/Data/Torrent/Piece.hs | 2 +- src/Data/Torrent/Tree.hs | 16 ++++++++-------- 4 files changed, 58 insertions(+), 40 deletions(-) (limited to 'src/Data/Torrent') diff --git a/src/Data/Torrent/Block.hs b/src/Data/Torrent/Block.hs index ca3bef45..17907a39 100644 --- a/src/Data/Torrent/Block.hs +++ b/src/Data/Torrent/Block.hs @@ -7,12 +7,14 @@ -- -- TODO -- -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} module Data.Torrent.Block ( -- * Block attributes BlockLIx , PieceLIx - , BlockSize (..) + , BlockSize + , defaultTransferSize -- * Block index , BlockIx(..) @@ -50,17 +52,14 @@ import Text.PrettyPrint -- Block attributes -----------------------------------------------------------------------} -newtype BlockSize = BlockSize { unBlockSize :: Int } - deriving (Show, Eq, Num, ToJSON, FromJSON) - --- | Widely used semi-official block size. -instance Default BlockSize where - def = 16 * 1024 - {-# INLINE def #-} - +type BlockSize = Int type BlockLIx = Int type PieceLIx = Int +-- | Widely used semi-official block size. +defaultTransferSize :: BlockSize +defaultTransferSize = 16 * 1024 + {----------------------------------------------------------------------- Block Index -----------------------------------------------------------------------} @@ -98,33 +97,33 @@ instance Serialize BlockIx where {-# SPECIALIZE instance Serialize BlockIx #-} get = BlockIx <$> getInt <*> getInt - <*> (BlockSize <$> getInt) + <*> getInt {-# INLINE get #-} put BlockIx {..} = do putInt ixPiece putInt ixOffset - putInt (unBlockSize ixLength) + putInt ixLength {-# INLINE put #-} instance Binary BlockIx where {-# SPECIALIZE instance Binary BlockIx #-} get = BlockIx <$> getIntB <*> getIntB - <*> (BlockSize <$> getIntB) + <*> getIntB {-# INLINE get #-} put BlockIx {..} = do putIntB ixPiece putIntB ixOffset - putIntB (unBlockSize ixLength) + putIntB ixLength -- | Format block index in human readable form. ppBlockIx :: BlockIx -> Doc ppBlockIx BlockIx {..} = "piece = " <> int ixPiece <> "," <+> "offset = " <> int ixOffset <> "," <+> - "length = " <> int (unBlockSize ixLength) + "length = " <> int ixLength {----------------------------------------------------------------------- Block @@ -158,7 +157,7 @@ isPiece pieceSize (Block i offset bs) = {-# INLINE isPiece #-} pieceIx :: Int -> Int -> BlockIx -pieceIx i = BlockIx i 0 . BlockSize +pieceIx i = BlockIx i 0 {-# INLINE pieceIx #-} blockIx :: Block Lazy.ByteString -> BlockIx @@ -177,5 +176,5 @@ ixRange pieceSize i = (offset, offset + len) where offset = fromIntegral pieceSize * fromIntegral (ixPiece i) + fromIntegral (ixOffset i) - len = fromIntegral (unBlockSize (ixLength i)) + len = fromIntegral (ixLength i) {-# INLINE ixRange #-} diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs index 409426be..6f0668f2 100644 --- a/src/Data/Torrent/Layout.hs +++ b/src/Data/Torrent/Layout.hs @@ -5,6 +5,8 @@ -- Stability : experimental -- Portability : portable -- +-- +-- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} @@ -13,25 +15,33 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS -fno-warn-orphans #-} module Data.Torrent.Layout - ( -- * File attribytes + ( -- * File attributes FileOffset , FileSize -- * Single file info , FileInfo (..) + + -- ** Lens , fileLength , filePath , fileMD5Sum -- * File layout , LayoutInfo (..) + + -- ** Lens , singleFile , multiFile , rootDirName + + -- ** Predicates , isSingleFile , isMultiFile - , fileNumber + + -- ** Folds , contentLength + , fileCount , blockCount -- * Flat file layout @@ -60,11 +70,14 @@ import Data.Typeable import System.FilePath import System.Posix.Types +import Data.Torrent.Block + {----------------------------------------------------------------------- -- File attribytes -----------------------------------------------------------------------} +-- | Size of a file in bytes. type FileSize = FileOffset deriving instance FromJSON FileOffset @@ -75,7 +88,7 @@ deriving instance BEncode FileOffset -- File info both either from info dict or file list -----------------------------------------------------------------------} --- | Contain info about one single file. +-- | Contain metainfo about one single file. data FileInfo a = FileInfo { fiLength :: {-# UNPACK #-} !FileSize -- ^ Length of the file in bytes. @@ -87,9 +100,9 @@ data FileInfo a = FileInfo { , fiName :: !a -- ^ One or more string elements that together represent the - -- path and filename. Each element in the list corresponds to - -- either a directory name or (in the case of the last - -- element) the filename. For example, the file: + -- path and filename. Each element in the list corresponds to + -- either a directory name or (in the case of the last element) + -- the filename. For example, the file: -- -- > "dir1/dir2/file.ext" -- @@ -152,9 +165,16 @@ instance BEncode (FileInfo ByteString) where -- Original torrent file layout info -----------------------------------------------------------------------} +-- | Original (found in torrent file) layout info is either: +-- +-- * Single file with its /name/. +-- +-- * Multiple files with its relative file /paths/. +-- data LayoutInfo = SingleFile - { liFile :: !(FileInfo ByteString) + { -- | Single file info. + liFile :: !(FileInfo ByteString) } | MultiFile { -- | List of the all files that torrent contains. @@ -212,16 +232,14 @@ contentLength :: LayoutInfo -> FileSize contentLength SingleFile { liFile = FileInfo {..} } = fiLength contentLength MultiFile { liFiles = tfs } = sum (L.map fiLength tfs) --- | Get count of all files in torrent. -fileNumber :: LayoutInfo -> Int -fileNumber SingleFile {..} = 1 -fileNumber MultiFile {..} = L.length liFiles +-- | Get number of all files in torrent. +fileCount :: LayoutInfo -> Int +fileCount SingleFile {..} = 1 +fileCount MultiFile {..} = L.length liFiles -- | Find number of blocks of the specified size. If torrent size is -- not a multiple of block size then the count is rounded up. -blockCount :: Int -- ^ Block size. - -> LayoutInfo -- ^ Torrent content info. - -> Int -- ^ Number of blocks. +blockCount :: BlockSize -> LayoutInfo -> Int blockCount blkSize ci = contentLength ci `sizeInBase` blkSize {----------------------------------------------------------------------- @@ -249,6 +267,7 @@ flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles path = prefixPath BC.unpack liDirName joinPath (L.map BC.unpack fiName) +-- | Calculate offset of each file based on its length, incrementally. accumOffsets :: Layout FileSize -> Layout FileOffset accumOffsets = go 0 where diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs index 96624729..27bc4879 100644 --- a/src/Data/Torrent/Piece.hs +++ b/src/Data/Torrent/Piece.hs @@ -85,7 +85,7 @@ maxPieceSize = 4 * 1024 * 1024 {-# INLINE maxPieceSize #-} minPieceSize :: Int -minPieceSize = unBlockSize def * 4 +minPieceSize = defaultTransferSize * 4 {-# INLINE minPieceSize #-} -- | NOTE: Have max and min size constrained to wide used diff --git a/src/Data/Torrent/Tree.hs b/src/Data/Torrent/Tree.hs index e9a337a1..8c18041a 100644 --- a/src/Data/Torrent/Tree.hs +++ b/src/Data/Torrent/Tree.hs @@ -15,8 +15,8 @@ module Data.Torrent.Tree , Data.Torrent.Tree.lookup , lookupDir - , fileCount - , dirCount + , fileNumber + , dirNumber ) where import Control.Arrow @@ -62,10 +62,10 @@ lookupDir ps d File _ -> Nothing Dir es -> Just $ M.toList es -fileCount :: DirTree a -> Sum Int -fileCount File {..} = Sum 1 -fileCount Dir {..} = foldMap fileCount children +fileNumber :: DirTree a -> Sum Int +fileNumber File {..} = Sum 1 +fileNumber Dir {..} = foldMap fileNumber children -dirCount :: DirTree a -> Sum Int -dirCount File {..} = Sum 0 -dirCount Dir {..} = Sum 1 <> foldMap dirCount children +dirNumber :: DirTree a -> Sum Int +dirNumber File {..} = Sum 0 +dirNumber Dir {..} = Sum 1 <> foldMap dirNumber children -- cgit v1.2.3