TNetstring parser

gistfile1.hs

module TParser where

import Text.ParserCombinators.Parsec
import qualified Data.Map as Map
import Control.Applicative hiding (many)

data TNetString = N
                | B Bool
                | S String
                | I Integer
                | F Float
                | L [TNetString]
                | D (Map.Map String TNetString)
                deriving (Eq, Show)

tnetstring = do
  size <- readSize
  char ':'
  choice (map try [ parseNull size
                  , parseBool size
                  , parseString size
                  , parseInteger size
                  , parseFloat size
                  , parseDict size
                  , parseList size
                  ]) <?> "tnetstring format suffix"

parseNull 0 = char '~' >> return N
parseNull _ = pzero

parseBool 4 = string "true!" >> return (B True)
parseBool 5 = string "false!" >> return (B False)
parseBool _ = pzero

parseString l = S <$> readContents l <* char ','

parseInteger l = I . read <$> readContents l <* char '#'

parseFloat l = F . read <$> readContents l <* char '^'

parseList _ = L <$> many tnetstring <* char ']'

parseDict _ = D . Map.fromList <$> many pair <* char '}'

pair = do
  S key_string <- tnetstring
  contents <- tnetstring

  return (key_string, contents)

readSize = fmap read $ many1 digit

readContents size = count size anyChar

parseTnetstring :: String -> Either ParseError TNetString
parseTnetstring = parse tnetstring "(unknown)"