module Data.Torrent.Layout
(
FileOffset
, FileSize
, FileInfo (..)
, fileLength
, filePath
, fileMD5Sum
, LayoutInfo (..)
, singleFile
, multiFile
, rootDirName
, isSingleFile
, isMultiFile
, contentLength
, fileCount
, blockCount
, Layout
, flatLayout
, accumOffsets
, fileOffset
, getLayoutInfo
, putLayoutInfo
) where
import Control.Applicative
import Control.DeepSeq
import Control.Lens
import Data.Aeson.TH
import Data.Aeson.Types (FromJSON, ToJSON)
import Data.BEncode
import Data.BEncode.Types
import Data.ByteString as BS
import Data.ByteString.Char8 as BC
import Data.Char
import Data.List as L
import Data.Typeable
import System.FilePath
import System.Posix.Types
import Data.Torrent.Block
type FileSize = FileOffset
deriving instance FromJSON FileOffset
deriving instance ToJSON FileOffset
deriving instance BEncode FileOffset
data FileInfo a = FileInfo {
fiLength :: !FileSize
, fiMD5Sum :: !(Maybe ByteString)
, fiName :: !a
} deriving (Show, Read, Eq, Typeable)
$(deriveJSON (L.map toLower . L.dropWhile isLower) ''FileInfo)
makeLensesFor
[ ("fiLength", "fileLength")
, ("fiMD5Sum", "fileMD5Sum")
, ("fiName" , "filePath" )
]
''FileInfo
instance NFData a => NFData (FileInfo a) where
rnf FileInfo {..} = rnf fiName
instance BEncode (FileInfo [ByteString]) where
toBEncode FileInfo {..} = toDict $
"length" .=! fiLength
.: "md5sum" .=? fiMD5Sum
.: "path" .=! fiName
.: endDict
fromBEncode = fromDict $ do
FileInfo <$>! "length"
<*>? "md5sum"
<*>! "path"
type Put a = a -> BDict -> BDict
putFileInfoSingle :: Put (FileInfo ByteString)
putFileInfoSingle FileInfo {..} cont =
"length" .=! fiLength
.: "md5sum" .=? fiMD5Sum
.: "name" .=! fiName
.: cont
getFileInfoSingle :: Get (FileInfo ByteString)
getFileInfoSingle = do
FileInfo <$>! "length"
<*>? "md5sum"
<*>! "name"
instance BEncode (FileInfo ByteString) where
toBEncode = toDict . (`putFileInfoSingle` endDict)
fromBEncode = fromDict getFileInfoSingle
data LayoutInfo
= SingleFile
{
liFile :: !(FileInfo ByteString)
}
| MultiFile
{
liFiles :: ![FileInfo [ByteString]]
, liDirName :: !ByteString
} deriving (Show, Read, Eq, Typeable)
$(deriveJSON (L.map toLower . L.dropWhile isLower) ''LayoutInfo)
makeLensesFor
[ ("liFile" , "singleFile" )
, ("liFiles" , "multiFile" )
, ("liDirName", "rootDirName")
]
''LayoutInfo
instance NFData LayoutInfo where
rnf SingleFile {..} = ()
rnf MultiFile {..} = rnf liFiles
getLayoutInfo :: Get LayoutInfo
getLayoutInfo = single <|> multi
where
single = SingleFile <$> getFileInfoSingle
multi = MultiFile <$>! "files" <*>! "name"
putLayoutInfo :: Put LayoutInfo
putLayoutInfo SingleFile {..} = putFileInfoSingle liFile
putLayoutInfo MultiFile {..} = \ cont ->
"files" .=! liFiles
.: "name" .=! liDirName
.: cont
instance BEncode LayoutInfo where
toBEncode = toDict . (`putLayoutInfo` endDict)
fromBEncode = fromDict getLayoutInfo
isSingleFile :: LayoutInfo -> Bool
isSingleFile SingleFile {} = True
isSingleFile _ = False
isMultiFile :: LayoutInfo -> Bool
isMultiFile MultiFile {} = True
isMultiFile _ = False
contentLength :: LayoutInfo -> FileSize
contentLength SingleFile { liFile = FileInfo {..} } = fiLength
contentLength MultiFile { liFiles = tfs } = sum (L.map fiLength tfs)
fileCount :: LayoutInfo -> Int
fileCount SingleFile {..} = 1
fileCount MultiFile {..} = L.length liFiles
blockCount :: BlockSize -> LayoutInfo -> Int
blockCount blkSize ci = contentLength ci `sizeInBase` blkSize
type Layout a = [(FilePath, a)]
flatLayout
:: FilePath
-> LayoutInfo
-> Layout FileSize
flatLayout prefixPath SingleFile { liFile = FileInfo {..} }
= [(prefixPath </> BC.unpack fiName, fiLength)]
flatLayout prefixPath MultiFile {..} = L.map mkPath liFiles
where
mkPath FileInfo {..} = (path, fiLength)
where
path = prefixPath </> BC.unpack liDirName
</> joinPath (L.map BC.unpack fiName)
accumOffsets :: Layout FileSize -> Layout FileOffset
accumOffsets = go 0
where
go !_ [] = []
go !offset ((n, s) : xs) = (n, offset) : go (offset + s) xs
fileOffset :: FilePath -> Layout FileOffset -> Maybe FileOffset
fileOffset = lookup
sizeInBase :: Integral a => a -> Int -> Int
sizeInBase n b = fromIntegral (n `div` fromIntegral b) + align
where
align = if n `mod` fromIntegral b == 0 then 0 else 1