Add smart constructors for magnets

2 files changed, 36 insertions, 2 deletions

diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs
index ea8fa894..4be108c2 100644
--- a/src/Data/Torrent/Layout.hs
+++ b/src/Data/Torrent/Layout.hs
@@ -39,7 +39,8 @@ module Data.Torrent.Layout
        , isSingleFile
        , isMultiFile
 
-         -- ** Folds
+         -- ** Query
+       , suggestedName
        , contentLength
        , fileCount
        , blockCount
@@ -227,6 +228,12 @@ isMultiFile MultiFile {} = True
 isMultiFile _            = False
 {-# INLINE isMultiFile #-}
 
+-- | Get name of the torrent based on the root path piece.
+suggestedName :: LayoutInfo -> ByteString
+suggestedName (SingleFile FileInfo {..}) = fiName
+suggestedName  MultiFile           {..}  = liDirName
+{-# INLINE suggestedName #-}
+
 -- | Find sum of sizes of the all torrent files.
 contentLength :: LayoutInfo -> FileSize
 contentLength SingleFile { liFile  = FileInfo {..} } = fiLength
diff --git a/src/Data/Torrent/Magnet.hs b/src/Data/Torrent/Magnet.hs
index 34a7bbc5..01f28a76 100644
--- a/src/Data/Torrent/Magnet.hs
+++ b/src/Data/Torrent/Magnet.hs
@@ -13,10 +13,17 @@
 --   Bittorrent specific info:
 --   <http://www.bittorrent.org/beps/bep_0009.html>
 --
+{-# LANGUAGE NamedFieldPuns #-}
 module Data.Torrent.Magnet
        ( -- * Magnet
          Magnet(..)
+
+         -- * Construction
        , nullMagnet
+       , simpleMagnet
+       , detailedMagnet
+
+         -- * Conversion
        , parseMagnet
        , renderMagnet
 
@@ -33,11 +40,13 @@ import Data.List as L
 import Data.URLEncoded as URL
 import Data.String
 import Data.Text as T
+import Data.Text.Encoding as T
 import Network.URI
 import Text.Read
 
+import Data.Torrent
 import Data.Torrent.InfoHash
-
+import Data.Torrent.Layout
 
 {-----------------------------------------------------------------------
 -- URN
@@ -153,6 +162,24 @@ nullMagnet u = Magnet
     , supplement = M.empty
     }
 
+-- | A simple magnet link including infohash ('xt' param) and display
+-- name ('dn' param).
+--
+simpleMagnet :: Torrent -> Magnet
+simpleMagnet Torrent {tInfoDict = InfoDict {..}}
+  = (nullMagnet idInfoHash)
+    { displayName = Just $ T.decodeUtf8 $ suggestedName idLayoutInfo
+    }
+
+-- | Like 'simpleMagnet' but also include exactLength ('xl' param) and
+-- tracker ('tr' param).
+detailedMagnet :: Torrent -> Magnet
+detailedMagnet t @ Torrent {tInfoDict = InfoDict {..}, tAnnounce}
+  = (simpleMagnet t)
+    { exactLength = Just $ fromIntegral $ contentLength idLayoutInfo
+    , tracker     = Just tAnnounce
+    }
+
 fromQuery :: URLEncoded -> Either String Magnet
 fromQuery q
   | Just urnStr   <- URL.lookup ("xt" :: String) q