magneturi: parsing functions

diff --git a/src/FuncTorrent/MagnetURI.hs b/src/FuncTorrent/MagnetURI.hs
index 4c695b584b6d85826de49aa2b04954bb2a3ff392..e0fd5450b47f07614eebef7360356cbbbfd0bace 100644 (file)
--- 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 <http://www.gnu.org/licenses/>
 -}
 
+{-# 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 <http://www.gnu.org/licenses/>
 
 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