Parser.hs

-- |
-- Module: Data.AttoBencode.Parser
-- Copyright: Florian Hartwig
-- License: BSD3
-- Maintainer: Florian Hartwig <florian.j.hartwig@gmail.com>
-- Stability: experimental
-- Portability: GHC

{-# LANGUAGE BangPatterns #-}
module Data.AttoBencode.Parser 
    ( decode
    , bValue
    ) where

import Data.AttoBencode.Types
import Prelude hiding (take)
import Data.Attoparsec (maybeResult, parse, Parser)
import Data.Attoparsec.Char8 (char, decimal, signed, take)
import Control.Applicative (many, (<$>), (<|>), (*>), (<*))
import Data.Map (fromList)
import qualified Data.ByteString as B

-- | Deserialise a bencoded ByteString.
-- If parsing or conversion fails, Nothing is returned.
decode :: (FromBencode a) => B.ByteString -> Maybe a
decode bs = maybeResult (parse bValue bs) >>= fromBencode

-- | Parser for Bencode values
bValue :: Parser BValue
bValue = stringParser <|> intParser <|> listParser <|> dictParser

bsParser :: Parser B.ByteString
bsParser =
 do l <- decimal
    _ <- char ':'
    take l
{-# INLINE bsParser #-}

stringParser :: Parser BValue
stringParser = BString <$> bsParser

intParser :: Parser BValue
intParser = BInt <$> (char 'i' *> signed decimal <* char 'e')

listParser :: Parser BValue
listParser = BList <$> (char 'l' *> many bValue <* char 'e')

pairParser :: Parser (B.ByteString, BValue)
pairParser = 
 do !key <- bsParser
    !value <- bValue
    return (key, value)

dictParser :: Parser BValue
dictParser = 
 do _ <- char 'd'
    !pairs <- many pairParser
    _ <- char 'e'
    return $ BDict $ fromList pairs -- TODO: fromAscList?