Parsing PPM images in Haskell

Question

I'm starting to learn Haskell and wish to parse a PPM image for execrsice. The structure of the PPM format is rather simple, but it is tricky. It's described here. First of all, I defined a type for a PPM Image:

data Pixel = Pixel { red :: Int, green :: Int, blue :: Int} deriving(Show)
data BitmapFormat = TextualBitmap | BinaryBitmap deriving(Show)
data Header = Header { format :: BitmapFormat
                     , width :: Int
                     , height :: Int
                     , colorDepth :: Int} deriving(Show)
data PPM = PPM { header :: Header
               , bitmap :: [Pixel]
               }

bitmap should contain the entire image. This is where the first challange comes - the part that contains the actual image data in PPM can be either textual or binary (described in the header). For textual bitmaps I wrote the following function:

parseTextualBitmap :: String -> [Pixel]
parseTextualBitmap = map textualPixel . chunksOf 3 . wordsBy isSpace
                     where textualPixel (r:g:b:[]) = Pixel (read r) (read g) (read b)

I'm not sure what to do with binary bitmaps, though. Using read converts a string representation of numbers to numbers. I want to convert "\x01" to 1 of type Int.

The second challange is parsing the header. I wrote the following function:

parseHeader :: String -> Header
parseHeader = constructHeader . wordsBy isSpace . filterComments
              where
                filterComments = unlines . map (takeWhile (/= '#')) . lines
                formatFromText s
                  | s == "P6" = BinaryBitmap
                  | s == "P3" = TextualBitmap
                constructHeader (format:width:height:colorDepth:_) =
                  Header (formatFromText format) (read width) (read height) (read colorDepth)

Which works pretty well. Now I should write the module exported function (let's call it parsePPM) which gets the entire file content (String) and then return PPM. The function should call parseHeader, deterime the bitmap format, call the apropriate parse(Textual|Binary)Bitmap and then construct a PPM with the result. Once parseHeader returns I should start decoding the bitmap from the point that parseHeader stopped in. However, I cannot know in which point of the string parseHeader stopped. The only solution I could think of is that instead of Header, parseHeader will return (Header,String), when the second element of the tuple is the remainder retrieved by constructHeader (which currently named as _). But I'm not really sure it's the "Haskell Way" of doing things.

To sum up my questions: 1. How do I decode the binary format into a list of Pixel 2. How can I know in which point the header ends

Since I'm learning Haskell by myself I have no one to actually review my code, so in addition to answering my questions I will appriciate any comment about the way I code (coding style, bugs, alternative way to do things, etc...).

Answer 1

Lets start with question 2 because it is easier to answer. Your approach is correct: as you parse things, you remove those characters from the input string, and return a tuple containing the result of the parse, and the remaining string. However, thereis no reason to write all this from scratch (except perhaps as an academic exercise) - there are plenty of parsers which will take care of this issue for you. The one I will use is Parsec. If you are new to monadic parsing you should first read the section on Parsec in RWH.

As for question 1, if you use ByteString instead of String, then parsing single bytes is easy since single bytes are the atomic elements of ByteStrings!

There is also the issue of the Char/ByteString interface. With Parsec, this is a non-issue since you can treat a ByteString as a sequence of Byte or Char - we will see this later.

I decided to just write the full parser - this is a very simple language so with all the primitives defined for you in the Parsec library, it is very easy and very concise.

The file header:

import Text.Parsec.Combinator
import Text.Parsec.Char
import Text.Parsec.ByteString
import Text.Parsec 
import Text.Parsec.Pos

import Data.ByteString (ByteString, pack)
import qualified Data.ByteString.Char8 as C8

import Control.Monad (replicateM)
import Data.Monoid

First, we write the 'primitive' parsers - that is, parsing bytes, parsing textual numbers, and parsing whitespace (which the PPM format uses as a seperator):

parseIntegral :: (Read a, Integral a) => Parser a
parseIntegral = fmap read (many1 digit)

digit parses a single digit - you'll notice that many function names explain what the parser does - and many1 will apply the given parser 1 or more times. Then we read the resulting string to return an actual number (as opposed to a string). In this case, the input ByteString is being treated as text.

parseByte :: Integral a => Parser a
parseByte = fmap (fromIntegral . fromEnum) $ tokenPrim show (\pos tok _ -> updatePosChar pos tok) Just

For this parser, we parse a single Char - which is really just a byte. It is just returned as a Char. We could safely make the return type Parser Word8 because the universe of values that can be returned is [0..255]

whitespace1 :: Parser ()
whitespace1 = many1 (oneOf "\n ") >> return ()

oneOf takes a list of Char and parses any one of the characters in the order given - again, the ByteString is being treated as Text.

Now we can write the parser for the header.

parseHeader :: Parser Header 
parseHeader = do
  f <- choice $ map try $ 
         [string "P3" >> return TextualBitmap
         ,string "P6" >> return BinaryBitmap]
  w <- whitespace1 >> parseIntegral
  h <- whitespace1 >> parseIntegral
  d <- whitespace1 >> parseIntegral
  return $ Header f w h d

A few notes. choice takes a list of parsers and tries them in order. try p takes the parser p, and 'remembers' the state before p starts parsing. If p succeeds, then try p == p. If p fails, then the state before p started is restored and you pretend you never tried p. This is necessary due to how choice behaves.

For the pixels, we have two choices as of now:

parseTextual :: Header -> Parser [Pixel]
parseTextual h = do
  xs <- replicateM (3 * width h * height h) (whitespace1 >> parseIntegral)
  return $ map (\[a,b,c] -> Pixel a b c) $ chunksOf 3 xs

We could use many1 (whitespace 1 >> parseIntegral) - but this wouldn't enforce the fact that we know what the length should be. Then, converting the list of numbers to a list of pixels is trivial.

For binary data:

parseBinary :: Header -> Parser [Pixel]
parseBinary h = do
  whitespace1
  xs <- replicateM (3 * width h * height h) parseByte
  return $ map (\[a,b,c] -> Pixel a b c) $ chunksOf 3 xs

Note how the two are almost identical. You could probably generalize this function (it would be especially useful if you decided to parse the other types of pixel data - monochrome and greyscale).

Now to bring it all together:

parsePPM :: Parser PPM
parsePPM = do
  h <- parseHeader
  fmap (PPM h) $ 
       case format h of
         TextualBitmap -> parseTextual h
         BinaryBitmap  -> parseBinary  h

This should be self-explanatory. Parse the header, then parse the body based on the format. Here are some examples to try it on. They are the ones from the specification page.

example0 :: ByteString
example0 = C8.pack $ unlines 
  ["P3"
  , "4 4"
  , "15"
  , " 0  0  0    0  0  0    0  0  0   15  0 15"
  , " 0  0  0    0 15  7    0  0  0    0  0  0"
  , " 0  0  0    0  0  0    0 15  7    0  0  0"
  , "15  0 15    0  0  0    0  0  0    0  0  0" ]

example1 :: ByteString
example1 = C8.pack ("P6 4 4 15 ") <> 
  pack [0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 0, 0, 0, 0, 15, 7, 
        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 7, 0, 0, 0, 15,
        0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0 ]

Several notes: this doesn't handle comments, which are part of the spec. The error messages are not very useful; you can use the <?> function to create your own error messages. The spec also indicates 'The lines should not be longer than 70 characters.' - this is also not enforced.

edit:

Just because you see do-notation, doesn't necessarily mean that you are working with impure code. Some monads (like this parser) are still pure - they are just used for convenience. For example, you can write your parser with the type parser :: String -> (a, String), or, what we have done here, is we use a new type: data Parser a = Parser (String -> (a, String)) and have parser :: Parser a; we then write a monad instance for Parser to get the useful do-notation. To be clear, Parsec supports monadic parsing, but our parser is not monadic - or rather, uses the Identity monad, which is just newtype Identity a = Identity { runIdentity :: a }, and is only necessary because if we used type Identity a = a we would have 'overlapping instances' errors everywhere, which is not good.

>:i Parser
type Parser = Parsec ByteString ()
        -- Defined in `Text.Parsec.ByteString'
>:i Parsec
type Parsec s u = ParsecT s u Data.Functor.Identity.Identity
        -- Defined in `Text.Parsec.Prim'

So then, the type of Parser is really ParsecT ByteString () Identity. That is, the parser input is ByteString, the user state is () - which just means we aren't using the user state, and the monad in which we are parsing is Identity. ParsecT is itself just a newtype of:

forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b

All those functions in the middle are just used to pretty-print errors. If you are parsing 10's of thousands of characters and an error occurs, you won't be able to just look at it and see where that happened - but Parsec will tell you the line and column. If we specialize all the types to our Parser, and pretend that Identity is just type Identity a = a, then all the monads disappear and you can see that the parser is not impure. As you can see, Parsec is a lot more powerful than is required for this problem - I just used it due to familiarity, but if you were willing to write your own primitive functions like many and digit, then you could get away with using newtype Parser a = Parser (ByteString -> (a, ByteString)).