{-# LANGUAGE DeriveDataTypeable #-}
module Data.Torrent
( Torrent(..)
, TorrentInfo(..)
, TorrentFile(..)
, readTorrent
, serializeTorrent
, torrentSize
, showTorrent
) where
import Data.BEncode
import Data.BEncode.Reader
import Data.Binary
import Data.Generics
import Data.Maybe
import Control.Applicative
import qualified Data.ByteString.Lazy as BS
import Data.ByteString.Lazy (ByteString)
import qualified Data.Map as Map
data Torrent
= Torrent
{ Torrent -> Maybe ByteString
tAnnounce :: Maybe ByteString
, Torrent -> [ByteString]
tAnnounceList :: [ByteString]
, :: ByteString
, Torrent -> Maybe ByteString
tCreatedBy :: Maybe ByteString
, Torrent -> TorrentInfo
tInfo :: TorrentInfo
}
deriving (Int -> Torrent -> ShowS
[Torrent] -> ShowS
Torrent -> String
(Int -> Torrent -> ShowS)
-> (Torrent -> String) -> ([Torrent] -> ShowS) -> Show Torrent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Torrent -> ShowS
showsPrec :: Int -> Torrent -> ShowS
$cshow :: Torrent -> String
show :: Torrent -> String
$cshowList :: [Torrent] -> ShowS
showList :: [Torrent] -> ShowS
Show, ReadPrec [Torrent]
ReadPrec Torrent
Int -> ReadS Torrent
ReadS [Torrent]
(Int -> ReadS Torrent)
-> ReadS [Torrent]
-> ReadPrec Torrent
-> ReadPrec [Torrent]
-> Read Torrent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Torrent
readsPrec :: Int -> ReadS Torrent
$creadList :: ReadS [Torrent]
readList :: ReadS [Torrent]
$creadPrec :: ReadPrec Torrent
readPrec :: ReadPrec Torrent
$creadListPrec :: ReadPrec [Torrent]
readListPrec :: ReadPrec [Torrent]
Read, Typeable, Typeable Torrent
Typeable Torrent =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Torrent -> c Torrent)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Torrent)
-> (Torrent -> Constr)
-> (Torrent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Torrent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Torrent))
-> ((forall b. Data b => b -> b) -> Torrent -> Torrent)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r)
-> (forall u. (forall d. Data d => d -> u) -> Torrent -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Torrent -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent)
-> Data Torrent
Torrent -> Constr
Torrent -> DataType
(forall b. Data b => b -> b) -> Torrent -> Torrent
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Torrent -> u
forall u. (forall d. Data d => d -> u) -> Torrent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Torrent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Torrent -> c Torrent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Torrent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Torrent)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Torrent -> c Torrent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Torrent -> c Torrent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Torrent
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Torrent
$ctoConstr :: Torrent -> Constr
toConstr :: Torrent -> Constr
$cdataTypeOf :: Torrent -> DataType
dataTypeOf :: Torrent -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Torrent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Torrent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Torrent)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Torrent)
$cgmapT :: (forall b. Data b => b -> b) -> Torrent -> Torrent
gmapT :: (forall b. Data b => b -> b) -> Torrent -> Torrent
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Torrent -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Torrent -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Torrent -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Torrent -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Torrent -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Torrent -> m Torrent
Data)
data TorrentInfo
= SingleFile
{ TorrentInfo -> Integer
tLength :: Integer
, TorrentInfo -> ByteString
tName :: ByteString
, TorrentInfo -> Integer
tPieceLength :: Integer
, TorrentInfo -> ByteString
tPieces :: ByteString }
| MultiFile
{ TorrentInfo -> [TorrentFile]
tFiles :: [TorrentFile]
, tName :: ByteString
, tPieceLength :: Integer
, tPieces :: ByteString
}
deriving (Int -> TorrentInfo -> ShowS
[TorrentInfo] -> ShowS
TorrentInfo -> String
(Int -> TorrentInfo -> ShowS)
-> (TorrentInfo -> String)
-> ([TorrentInfo] -> ShowS)
-> Show TorrentInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TorrentInfo -> ShowS
showsPrec :: Int -> TorrentInfo -> ShowS
$cshow :: TorrentInfo -> String
show :: TorrentInfo -> String
$cshowList :: [TorrentInfo] -> ShowS
showList :: [TorrentInfo] -> ShowS
Show, ReadPrec [TorrentInfo]
ReadPrec TorrentInfo
Int -> ReadS TorrentInfo
ReadS [TorrentInfo]
(Int -> ReadS TorrentInfo)
-> ReadS [TorrentInfo]
-> ReadPrec TorrentInfo
-> ReadPrec [TorrentInfo]
-> Read TorrentInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TorrentInfo
readsPrec :: Int -> ReadS TorrentInfo
$creadList :: ReadS [TorrentInfo]
readList :: ReadS [TorrentInfo]
$creadPrec :: ReadPrec TorrentInfo
readPrec :: ReadPrec TorrentInfo
$creadListPrec :: ReadPrec [TorrentInfo]
readListPrec :: ReadPrec [TorrentInfo]
Read, Typeable, Typeable TorrentInfo
Typeable TorrentInfo =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentInfo -> c TorrentInfo)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentInfo)
-> (TorrentInfo -> Constr)
-> (TorrentInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentInfo))
-> ((forall b. Data b => b -> b) -> TorrentInfo -> TorrentInfo)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> TorrentInfo -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> TorrentInfo -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo)
-> Data TorrentInfo
TorrentInfo -> Constr
TorrentInfo -> DataType
(forall b. Data b => b -> b) -> TorrentInfo -> TorrentInfo
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TorrentInfo -> u
forall u. (forall d. Data d => d -> u) -> TorrentInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentInfo -> c TorrentInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentInfo)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentInfo -> c TorrentInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentInfo -> c TorrentInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentInfo
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentInfo
$ctoConstr :: TorrentInfo -> Constr
toConstr :: TorrentInfo -> Constr
$cdataTypeOf :: TorrentInfo -> DataType
dataTypeOf :: TorrentInfo -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentInfo)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentInfo)
$cgmapT :: (forall b. Data b => b -> b) -> TorrentInfo -> TorrentInfo
gmapT :: (forall b. Data b => b -> b) -> TorrentInfo -> TorrentInfo
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentInfo -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TorrentInfo -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TorrentInfo -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TorrentInfo -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TorrentInfo -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentInfo -> m TorrentInfo
Data)
data TorrentFile
= TorrentFile
{ TorrentFile -> Integer
fileLength :: Integer
, TorrentFile -> [ByteString]
filePath :: [ByteString]
}
deriving (Int -> TorrentFile -> ShowS
[TorrentFile] -> ShowS
TorrentFile -> String
(Int -> TorrentFile -> ShowS)
-> (TorrentFile -> String)
-> ([TorrentFile] -> ShowS)
-> Show TorrentFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TorrentFile -> ShowS
showsPrec :: Int -> TorrentFile -> ShowS
$cshow :: TorrentFile -> String
show :: TorrentFile -> String
$cshowList :: [TorrentFile] -> ShowS
showList :: [TorrentFile] -> ShowS
Show, ReadPrec [TorrentFile]
ReadPrec TorrentFile
Int -> ReadS TorrentFile
ReadS [TorrentFile]
(Int -> ReadS TorrentFile)
-> ReadS [TorrentFile]
-> ReadPrec TorrentFile
-> ReadPrec [TorrentFile]
-> Read TorrentFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TorrentFile
readsPrec :: Int -> ReadS TorrentFile
$creadList :: ReadS [TorrentFile]
readList :: ReadS [TorrentFile]
$creadPrec :: ReadPrec TorrentFile
readPrec :: ReadPrec TorrentFile
$creadListPrec :: ReadPrec [TorrentFile]
readListPrec :: ReadPrec [TorrentFile]
Read, Typeable, Typeable TorrentFile
Typeable TorrentFile =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentFile -> c TorrentFile)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentFile)
-> (TorrentFile -> Constr)
-> (TorrentFile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentFile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentFile))
-> ((forall b. Data b => b -> b) -> TorrentFile -> TorrentFile)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r)
-> (forall u. (forall d. Data d => d -> u) -> TorrentFile -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> TorrentFile -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile)
-> Data TorrentFile
TorrentFile -> Constr
TorrentFile -> DataType
(forall b. Data b => b -> b) -> TorrentFile -> TorrentFile
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TorrentFile -> u
forall u. (forall d. Data d => d -> u) -> TorrentFile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentFile -> c TorrentFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentFile)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentFile -> c TorrentFile
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TorrentFile -> c TorrentFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentFile
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TorrentFile
$ctoConstr :: TorrentFile -> Constr
toConstr :: TorrentFile -> Constr
$cdataTypeOf :: TorrentFile -> DataType
dataTypeOf :: TorrentFile -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentFile)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TorrentFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentFile)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TorrentFile)
$cgmapT :: (forall b. Data b => b -> b) -> TorrentFile -> TorrentFile
gmapT :: (forall b. Data b => b -> b) -> TorrentFile -> TorrentFile
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TorrentFile -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TorrentFile -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TorrentFile -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TorrentFile -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TorrentFile -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TorrentFile -> m TorrentFile
Data)
instance Binary Torrent where
put :: Torrent -> Put
put = BEncode -> Put
forall t. Binary t => t -> Put
put (BEncode -> Put) -> (Torrent -> BEncode) -> Torrent -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Torrent -> BEncode
serializeTorrent
get :: Get Torrent
get = do
ByteString
e <- Get ByteString
forall t. Binary t => Get t
get
case ByteString -> Either String Torrent
readTorrent ByteString
e of
Left String
err -> String -> Get Torrent
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Torrent) -> String -> Get Torrent
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse torrent: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
Right Torrent
t -> Torrent -> Get Torrent
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Torrent
t
torrentSize :: Torrent -> Integer
torrentSize :: Torrent -> Integer
torrentSize Torrent
torrent = case Torrent -> TorrentInfo
tInfo Torrent
torrent of
s :: TorrentInfo
s@SingleFile{} -> TorrentInfo -> Integer
tLength TorrentInfo
s
MultiFile{tFiles :: TorrentInfo -> [TorrentFile]
tFiles=[TorrentFile]
files} -> [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((TorrentFile -> Integer) -> [TorrentFile] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map TorrentFile -> Integer
fileLength [TorrentFile]
files)
readTorrent :: ByteString -> Either String Torrent
readTorrent :: ByteString -> Either String Torrent
readTorrent ByteString
inp = case ByteString -> Maybe BEncode
bRead ByteString
inp of
Maybe BEncode
Nothing -> String -> Either String Torrent
forall a b. a -> Either a b
Left String
"Not BEncoded"
Just BEncode
be -> BReader Torrent -> BEncode -> Either String Torrent
forall a. BReader a -> BEncode -> Either String a
runBReader BReader Torrent
parseTorrent BEncode
be
parseTorrent :: BReader Torrent
parseTorrent :: BReader Torrent
parseTorrent = do
Maybe ByteString
announce <- BReader ByteString -> BReader (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (BReader ByteString -> BReader (Maybe ByteString))
-> BReader ByteString -> BReader (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ String -> BReader ByteString -> BReader ByteString
forall a. String -> BReader a -> BReader a
dict String
"announce" BReader ByteString
bbytestring
Maybe ByteString
creator <- BReader ByteString -> BReader (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (BReader ByteString -> BReader (Maybe ByteString))
-> BReader ByteString -> BReader (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ String -> BReader ByteString -> BReader ByteString
forall a. String -> BReader a -> BReader a
dict String
"created by" BReader ByteString
bbytestring
String -> BReader Torrent -> BReader Torrent
forall a. String -> BReader a -> BReader a
dict String
"info" (BReader Torrent -> BReader Torrent)
-> BReader Torrent -> BReader Torrent
forall a b. (a -> b) -> a -> b
$ do
ByteString
name <- String -> BReader ByteString -> BReader ByteString
forall a. String -> BReader a -> BReader a
dict String
"name" BReader ByteString
bbytestring
Integer
pLen <- String -> BReader Integer -> BReader Integer
forall a. String -> BReader a -> BReader a
dict String
"piece length" BReader Integer
bint
ByteString
pieces <- String -> BReader ByteString -> BReader ByteString
forall a. String -> BReader a -> BReader a
dict String
"pieces" BReader ByteString
bbytestring
TorrentInfo
torrentInfo <- ByteString -> Integer -> ByteString -> BReader TorrentInfo
parseTorrentInfo ByteString
name Integer
pLen ByteString
pieces
Torrent -> BReader Torrent
forall a. a -> BReader a
forall (m :: * -> *) a. Monad m => a -> m a
return (Torrent -> BReader Torrent) -> Torrent -> BReader Torrent
forall a b. (a -> b) -> a -> b
$ Maybe ByteString
-> [ByteString]
-> ByteString
-> Maybe ByteString
-> TorrentInfo
-> Torrent
Torrent Maybe ByteString
announce [] ByteString
BS.empty Maybe ByteString
creator TorrentInfo
torrentInfo
parseTorrentInfo :: ByteString -> Integer -> ByteString -> BReader TorrentInfo
parseTorrentInfo :: ByteString -> Integer -> ByteString -> BReader TorrentInfo
parseTorrentInfo ByteString
name Integer
pLen ByteString
pieces = BReader TorrentInfo
single BReader TorrentInfo -> BReader TorrentInfo -> BReader TorrentInfo
forall a. BReader a -> BReader a -> BReader a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BReader TorrentInfo
multi
where
single :: BReader TorrentInfo
single = do
Integer
len <- String -> BReader Integer -> BReader Integer
forall a. String -> BReader a -> BReader a
dict String
"length" BReader Integer
bint
TorrentInfo -> BReader TorrentInfo
forall a. a -> BReader a
forall (m :: * -> *) a. Monad m => a -> m a
return (TorrentInfo -> BReader TorrentInfo)
-> TorrentInfo -> BReader TorrentInfo
forall a b. (a -> b) -> a -> b
$ Integer -> ByteString -> Integer -> ByteString -> TorrentInfo
SingleFile Integer
len ByteString
name Integer
pLen ByteString
pieces
multi :: BReader TorrentInfo
multi = do
[TorrentFile]
files <- String -> BReader [TorrentFile] -> BReader [TorrentFile]
forall a. String -> BReader a -> BReader a
dict String
"files" (BReader [TorrentFile] -> BReader [TorrentFile])
-> BReader [TorrentFile] -> BReader [TorrentFile]
forall a b. (a -> b) -> a -> b
$ BReader TorrentFile -> BReader [TorrentFile]
forall a. BReader a -> BReader [a]
list (BReader TorrentFile -> BReader [TorrentFile])
-> BReader TorrentFile -> BReader [TorrentFile]
forall a b. (a -> b) -> a -> b
$ do
Integer
len <- String -> BReader Integer -> BReader Integer
forall a. String -> BReader a -> BReader a
dict String
"length" BReader Integer
bint
[ByteString]
filePaths <- String -> BReader [ByteString] -> BReader [ByteString]
forall a. String -> BReader a -> BReader a
dict String
"path" (BReader ByteString -> BReader [ByteString]
forall a. BReader a -> BReader [a]
list BReader ByteString
bbytestring)
TorrentFile -> BReader TorrentFile
forall a. a -> BReader a
forall (m :: * -> *) a. Monad m => a -> m a
return (TorrentFile -> BReader TorrentFile)
-> TorrentFile -> BReader TorrentFile
forall a b. (a -> b) -> a -> b
$ Integer -> [ByteString] -> TorrentFile
TorrentFile Integer
len [ByteString]
filePaths
TorrentInfo -> BReader TorrentInfo
forall a. a -> BReader a
forall (m :: * -> *) a. Monad m => a -> m a
return (TorrentInfo -> BReader TorrentInfo)
-> TorrentInfo -> BReader TorrentInfo
forall a b. (a -> b) -> a -> b
$ [TorrentFile] -> ByteString -> Integer -> ByteString -> TorrentInfo
MultiFile [TorrentFile]
files ByteString
name Integer
pLen ByteString
pieces
serializeTorrent :: Torrent -> BEncode
serializeTorrent :: Torrent -> BEncode
serializeTorrent Torrent
torrent = Map String BEncode -> BEncode
BDict (Map String BEncode -> BEncode) -> Map String BEncode -> BEncode
forall a b. (a -> b) -> a -> b
$ [(String, BEncode)] -> Map String BEncode
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, BEncode)] -> Map String BEncode)
-> [(String, BEncode)] -> Map String BEncode
forall a b. (a -> b) -> a -> b
$ [Maybe (String, BEncode)] -> [(String, BEncode)]
forall a. [Maybe a] -> [a]
catMaybes
[ (ByteString -> (String, BEncode))
-> Maybe ByteString -> Maybe (String, BEncode)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString
b -> (String
"announce", ByteString -> BEncode
BString ByteString
b)) (Torrent -> Maybe ByteString
tAnnounce Torrent
torrent)
, (String, BEncode) -> Maybe (String, BEncode)
forall a. a -> Maybe a
Just (String
"comment", ByteString -> BEncode
BString (ByteString -> BEncode) -> ByteString -> BEncode
forall a b. (a -> b) -> a -> b
$ Torrent -> ByteString
tComment Torrent
torrent)
, (String, BEncode) -> Maybe (String, BEncode)
forall a. a -> Maybe a
Just (String
"info", BEncode
info)
]
where
info :: BEncode
info = Map String BEncode -> BEncode
BDict (Map String BEncode -> BEncode) -> Map String BEncode -> BEncode
forall a b. (a -> b) -> a -> b
$ [(String, BEncode)] -> Map String BEncode
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, BEncode)] -> Map String BEncode)
-> [(String, BEncode)] -> Map String BEncode
forall a b. (a -> b) -> a -> b
$
[ (String
"name", ByteString -> BEncode
BString (ByteString -> BEncode) -> ByteString -> BEncode
forall a b. (a -> b) -> a -> b
$ TorrentInfo -> ByteString
tName (Torrent -> TorrentInfo
tInfo Torrent
torrent))
, (String
"pieces", ByteString -> BEncode
BString (ByteString -> BEncode) -> ByteString -> BEncode
forall a b. (a -> b) -> a -> b
$ TorrentInfo -> ByteString
tPieces (Torrent -> TorrentInfo
tInfo Torrent
torrent))
, (String
"piece length", Integer -> BEncode
BInt (Integer -> BEncode) -> Integer -> BEncode
forall a b. (a -> b) -> a -> b
$ TorrentInfo -> Integer
tPieceLength (Torrent -> TorrentInfo
tInfo Torrent
torrent))
] [(String, BEncode)] -> [(String, BEncode)] -> [(String, BEncode)]
forall a. [a] -> [a] -> [a]
++ case Torrent -> TorrentInfo
tInfo Torrent
torrent of
SingleFile Integer
len ByteString
_ Integer
_ ByteString
_ ->
[ (String
"length", Integer -> BEncode
BInt Integer
len) ]
MultiFile [TorrentFile]
files ByteString
_ Integer
_ ByteString
_ ->
[ (String
"files", [BEncode] -> BEncode
BList ([BEncode] -> BEncode) -> [BEncode] -> BEncode
forall a b. (a -> b) -> a -> b
$ (TorrentFile -> BEncode) -> [TorrentFile] -> [BEncode]
forall a b. (a -> b) -> [a] -> [b]
map TorrentFile -> BEncode
serfile [TorrentFile]
files) ]
serfile :: TorrentFile -> BEncode
serfile TorrentFile
file = Map String BEncode -> BEncode
BDict (Map String BEncode -> BEncode) -> Map String BEncode -> BEncode
forall a b. (a -> b) -> a -> b
$ [(String, BEncode)] -> Map String BEncode
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (String
"length", Integer -> BEncode
BInt (TorrentFile -> Integer
fileLength TorrentFile
file))
, (String
"path", [BEncode] -> BEncode
BList ((ByteString -> BEncode) -> [ByteString] -> [BEncode]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> BEncode
BString ([ByteString] -> [BEncode]) -> [ByteString] -> [BEncode]
forall a b. (a -> b) -> a -> b
$ TorrentFile -> [ByteString]
filePath TorrentFile
file))
]
showTorrent :: Torrent -> ByteString
showTorrent :: Torrent -> ByteString
showTorrent = BEncode -> ByteString
bPack (BEncode -> ByteString)
-> (Torrent -> BEncode) -> Torrent -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Torrent -> BEncode
serializeTorrent