Haskell Bencoded Dictionary Parser

Question

I have been working on a Bencoded string parser in order to improve my knowledge of Haskell. After running the code through hlint, I still have a few questions:

1. As I noted in the comments, the key value in the definition of BMapT should always be a Bstr. Is there any way to enforce a particular data constructor when pattern matching an algrebraic datatype?

2. Since Bencoded dictionaries are generally stored as human readable text, I made an instance of the Show typeclass so that I could take Bencode structures and turn them into text. I was wondering if this is the right thing to do, or if Haskell has another typeclass for storage/serialization a la Python's repr.

3. This question is kind of nebulous, but would you consider this code 'idiomatic'? Code without style isn't worth writing :)

Code:

-- This is an implementation of Bencoding for bittorrent as described at 
-- http://www.bittorrent.org/beps/bep_0003.html

module Bencode where

import Text.Parsec.ByteString
import Text.Parsec.Char
import Text.Parsec.Prim
import Text.Parsec.Combinator
import qualified Text.Parsec.Error as PE
import Data.Char
import qualified Data.Map as M
import qualified Control.Monad as Mon

-- Technically this first argument can only be a Bstr, but I don't know
-- how to express that
type BMapT = M.Map Bencode Bencode

-- I have no idea why Bstr is okay as a String when it's a ByteString
data Bencode =  Bint Integer
              | Bstr String
              | Blist [Bencode]
              | Bmap BMapT
              deriving (Eq, Ord)

instance Show Bencode where
    show (Bint i) = "i" ++ show i ++ "e"
    show (Bstr s) = (show . length) s ++ ":" ++ s
    show (Blist bs) = 'l':concatMap show bs ++ "e"
    show (Bmap bm) = M.foldlWithKey (\a k b -> a ++ show k ++ show b) "d" bm  ++ "e"

-- Parse a Bencoded Integer
bInt :: Parser Bencode
bInt = do char 'i'
          num <- validNum
          char 'e'
          return $ Bint num
       -- This parser parses valid integers in Bencodings 
       where validNum = do neg <- option ' ' (char '-')
                           d <- digit
                           case digitToInt d of
                                -- Only time the first digit == 0 is "i0e"
                                0 -> if neg == ' ' then 
                                        -- "i0e" allowed but NOT "i-0e" or zero padded integer
                                        lookAhead (char 'e') >> return 0 
                                     else
                                        parserFail "Can't have a negative zero"
                                _ -> many digit >>= \xs -> return $ read (neg:d:xs)

-- Parse a Bencoded String
bString :: Parser Bencode
bString = do ss <- many1 digit
             char ':'
             let size = read ss
             Mon.liftM Bstr $ count size anyChar

bList :: Parser Bencode
bList = do char 'l' 
           ls <- many (bInt <|> bString <|> bList <|> bMap)
           char 'e'
           return $ Blist ls

-- A parser which parses bencoded dictionaries 
bMap :: Parser Bencode
bMap = do char 'd'
          entries <- many dictEntry
          char 'e'
          return $ Bmap $ M.fromList entries

-- This parser will parse a key-value pair
dictEntry :: Parser (Bencode, Bencode)
dictEntry = do key <- bString
               value <- bString <|> bList <|> bInt <|> bMap
               return (key, value)

-- This function reads a torrent file. readBencodedFile "filename" reads
-- that filename and returns the parsed bencoded dictionary
readBencodedFile :: String -> IO (Either PE.ParseError Bencode)
readBencodedFile = parseFromFile bMap

Answer 1

Below is your code with some minor tweaks and the comments moved into standard Haddock form.

module Bencode (readBencodedFile, BencodedValue(..), bencode, bencodeBS) where

import qualified Control.Monad as Mon
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (pack)
import qualified Data.Map as M
import Text.Parsec.ByteString as ParseBS
import Text.Parsec.Char (anyChar, char, digit)
import Text.Parsec.Prim ((<|>), parserFail, runParser)
import Text.Parsec.Combinator (count, many1, option)
import qualified Text.Parsec.Error as PE


type BMapT = M.Map BencodedValue BencodedValue

data BencodedValue = Bint Integer
                   | Bstr String
                   | Blist [BencodedValue]
                   | Bmap BMapT
                   deriving (Eq, Ord, Show)


-- |Transform a 'BencodedValue' back to an encoded string
bencode :: BencodedValue -> String
bencode (Bint i)   = "i" ++ show i ++ "e"
bencode (Bstr s)   = (show . length) s ++ ":" ++ s
bencode (Blist bs) = 'l':concatMap bencode bs ++ "e"
bencode (Bmap bm)  = M.foldlWithKey (\a k b -> a ++ bencode k ++ bencode b) "d" bm  ++ "e"


-- |Return a 'BencodedValue' value to it original encoded 'ByteString' form.
bencodeBS :: BencodedValue -> ByteString
bencodeBS = pack . bencode


{-|
  'readBencodedFile' reads data from a torrent file and returns the parsed
  result as a dictionary in a 'BencodedValue'.
  The 'String' is the filename of the torrent to read.
 -}
readBencodedFile :: String -> IO (Either PE.ParseError BencodedValue)
readBencodedFile = parseFromFile bMap

------------------------
-- Internal functions --
------------------------

-- |Parse a Bencoded Integer
bInt :: ParseBS.Parser BencodedValue
bInt = do char 'i'
          neg  <- option ' ' (char '-')
          nums <- many1 digit
          char 'e'
          mkBint neg nums
  where
    mkBint ' ' ['0']    = return $ Bint 0
    mkBint '-' ('0':ns) = parserFail "Can't have a negative zero"
    mkBint _   ('0':ns) = parserFail "Invalid number with a leading zero"
    mkBint '-' nums     = return $ Bint $ read ('-':nums)
    mkBint _   nums     = return $ Bint $ read nums


-- |Parse a Bencoded String
bString :: ParseBS.Parser BencodedValue
bString = do nums <- many1 digit
             char ':'
             mkBstring (read nums)
  where
    mkBstring size = do cs <- count size anyChar
                        return $ Bstr cs


-- |Parse a Bencoded List
bList :: ParseBS.Parser BencodedValue
bList = do char 'l'
           ls <- many1 (bInt <|> bString <|> bList <|> bMap)
           char 'e'
           mkBlist ls
  where
    mkBlist = return . Blist


-- |Parse a Bencoded dictionary
bMap :: ParseBS.Parser BencodedValue
bMap = do char 'd'
          entries <- many1 dictEntry
          char 'e'
          mkBmap entries
  where
    mkBmap = return . Bmap . M.fromList


-- |Parse a Bencoded dictionary entry.
-- This is an internal function declared outside of 'bMap' to
-- facilitate testing.
dictEntry :: ParseBS.Parser (BencodedValue, BencodedValue)
dictEntry = do key <- bString
               value <- bString <|> bList <|> bInt <|> bMap
               return (key, value)

Answers to your questions.

1. Without getting REAL fancy there is no good way limit the BMap argument to a Bstr while it is an member of algebraic type.
2. Your analogy to repr from Python is a good one. Typically if there is a Haskell Show instance there is also a Read instance so show . read . show is valid. In your case the result of show needs to be parsed again and you do not expose a parse from string/bytestring. I added a bencode and bencodeBS which takes a BencodedValue and outputs a String or ByteString.
3. Look at where I simplified or renamed your items to see suggestions on idiomatic usage. On the whole you did pretty well. If I had more time I would have liked to transform your parser functions into Applicative style. By transitioning to the mkFoo functions I started that process for you if you like.
4. In the code you ask about why this is a String when the ByteString is the input. It is because the parsers are returning Strings parsed from the ByteString. If the performance really matters you could transition over to Attoparsec.