From: Ramakrishnan Muthukrishnan Date: Sun, 16 Jul 2017 10:06:50 +0000 (+0530) Subject: magneturi: parsing functions X-Git-Url: https://git.rkrishnan.org/pf/content/en/seg/about/htmlfontify-example.html?a=commitdiff_plain;h=cbd20378040719573cbc8c24650673197f9db935;p=functorrent.git magneturi: parsing functions --- diff --git a/src/FuncTorrent/MagnetURI.hs b/src/FuncTorrent/MagnetURI.hs index 4c695b5..e0fd545 100644 --- a/src/FuncTorrent/MagnetURI.hs +++ b/src/FuncTorrent/MagnetURI.hs @@ -17,6 +17,8 @@ You should have received a copy of the GNU General Public License along with FuncTorrent; if not, see -} +{-# LANGUAGE OverloadedStrings #-} + -- | Parse magnet URI -- The spec for magnetURI: https://en.wikipedia.org/wiki/Magnet_URI_scheme -- An example from tpb: @@ -40,4 +42,46 @@ along with FuncTorrent; if not, see module FuncTorrent.MagnetURI where +import Text.ParserCombinators.Parsec +import qualified Text.Parsec.ByteString as ParsecBS +import Data.ByteString.Char8 (ByteString, pack) + +data Magnetinfo = Magnetinfo { infoHash :: ByteString + , trackerlist :: [String] + , name :: String + , xlen :: Maybe Integer + } + deriving (Eq, Show) + +magnetHdr :: ParsecBS.Parser String +magnetHdr = string "magnet:?" + +kvpair :: ParsecBS.Parser (String, String) +kvpair = do + k <- many1 letter + _ <- char '=' + v <- many1 (letter <|> digit <|> (char ':')) + return (k, v) + +magnetBody :: ParsecBS.Parser Magnetinfo +magnetBody = do + pairs <- kvpair `sepBy1` (char '&') + -- walk through pairs, populate Magnetinfo (fold?) + return $ foldl f magnetInfo pairs + where f magnetRecord pair = let (k, v) = pair in + case k of + "xt" -> magnetRecord { infoHash = pack v } + "tr" -> let trVal = trackerlist magnetRecord in + magnetRecord { trackerlist = trVal ++ [v] } + "dn" -> magnetRecord { name = v } + "xl" -> magnetRecord { xlen = Just (read v :: Integer) } + magnetInfo = Magnetinfo { infoHash = mempty + , trackerlist = mempty + , name = mempty + , xlen = Nothing } + +magnetUri :: ParsecBS.Parser Magnetinfo +magnetUri = magnetHdr >> magnetBody +parseMagneturi :: ByteString -> Either ParseError Magnetinfo +parseMagneturi input = parse magnetUri "magnetParse" input