\$\begingroup\$

I've written a small library for reading and writing PGM/PPM images. The format is described here. I attach the library itself and a small utility to convert binary encoded images to ASCII encoding. Any type of comment will be appriciated. However, these points are most important to me:

Abusing of the type system - I fear that I forced my OOP design on the Haskell type system. I wanted to use typeclasses in order to prevent code duplication as much as possible between PGM and PPM images. However, the final result was that I had to duplicate code in several places. The worse thing is that I was forced to add a type signature in the bin2asc utility, so it doesn't support PGM. How can I design this library better to support both types?

Performance - Running my bin2asc utility on this image takes 0.633 seconds. I think it's a bit slow for an image in such size. Since I don't know how to profile code in Haskell I can't tell which function takes most of the time. Is there any bad practice that I have done that hurts performance?

Branching in mixed IO/Maybe functions - When using the do notiaion in a function that returns a Maybe I prevent checking for Nothings by chaining monads. However, in bin2asc I have to check explicitly for Nothing , creating an extra branch. Is there anything I can do to prevent this?

Parsing multiple values in a function - For parseHeader - I had to use multple r variables to hold the remainders. Is there any less error-prone implementation?

PNM.hs

module Data.PNM ( Coord , Image(..) , ImageType(..) , Encoding(..) , PPMImage(..) , PGMImage(..) , parseHeader , Header(..) ) where import Data.Array import Data.Char import Data.List import qualified Data.ByteString.Lazy as S import qualified Data.ByteString.Lazy.Char8 as SC import Data.Word import Control.Monad import System.IO import Control.Applicative import Debug.Trace type Coord = (Int,Int) data GrayscalePixel = GrayscalePixel Int deriving Show data ColorPixel = ColorPixel Int Int Int deriving Show data Encoding = ASCII | Binary deriving (Show,Eq) data ImageType = PPM | PGM deriving (Eq,Show) data PPMImage = PPMImage (Array Coord ColorPixel) deriving Show data PGMImage = PGMImage (Array Coord GrayscalePixel) data Header = Header { imageType :: ImageType , imageEncoding :: Encoding , imageCoords :: Coord , imageBitDepth :: Int } class Pixel p where readPixel :: Encoding -> S.ByteString -> Maybe (p,S.ByteString) encodePixel :: Encoding -> p -> S.ByteString class Image img where decode :: S.ByteString -> Maybe img dimensions :: img -> Coord encode :: Encoding -> img -> S.ByteString hLoad :: Handle -> IO (Maybe img) hLoad h = decode <$> S.hGetContents h load :: FilePath -> IO (Maybe img) load fileName = decode <$> S.readFile fileName dump :: Encoding -> img -> FilePath -> IO () dump encoding img fileName = do let encodedImage = encode encoding img S.writeFile fileName encodedImage encodePixels :: (Pixel p) => Encoding -> [p] -> SC.ByteString encodePixels encoding pixels = SC.concat $ fmap (encodePixel encoding) pixels encodeHeader :: Header -> S.ByteString encodeHeader (Header type' encoding (width,height) depth) = let fields = fmap SC.pack [ magic type' encoding , show width , show height , show depth ] formattedFields = SC.intercalate (SC.singleton ' ') fields in formattedFields `SC.append` (SC.singleton '

') where magic PGM ASCII = "P2" magic PPM ASCII = "P3" magic PGM Binary = "P5" magic PPM Binary = "P6" nextWord :: S.ByteString -> S.ByteString nextWord s | SC.null s = SC.empty | otherwise = let next = SC.dropWhile isSpace s in if SC.null next then SC.empty else if SC.head next == '#' then nextWord $ SC.dropWhile (/= '

') next else next nextLine :: S.ByteString -> S.ByteString nextLine = SC.drop 1 . SC.dropWhile (/= '

') parseMagic :: S.ByteString -> Maybe ((Encoding,ImageType),S.ByteString) parseMagic s = do let (word,remainder) = SC.span (\c -> c /= '#' && not (isSpace c)) s result <- parseMagic' word return (result, remainder) where parseMagic' w | w == SC.pack "P2" = Just (ASCII,PGM) | w == SC.pack "P3" = Just (ASCII,PPM) | w == SC.pack "P5" = Just (Binary,PGM) | w == SC.pack "P6" = Just (Binary,PPM) | otherwise = Nothing parseHeader :: S.ByteString -> Maybe (Header,S.ByteString) parseHeader rawImage = do ((encoding,imageType),r1) <- parseMagic rawImage (width,r2) <- SC.readInt $ nextWord r1 (height,r3) <- SC.readInt $ nextWord r2 (bitDepth,r4) <- SC.readInt $ nextWord r3 return ((Header imageType encoding (width,height) bitDepth),r4) readPixels :: (Pixel p) => Encoding -> S.ByteString -> [p] readPixels encoding s | SC.null s = [] | otherwise = let result = readPixel encoding (next' s) in case result of Nothing -> [] Just (pixel,r) -> pixel:readPixels encoding r where next' | encoding == ASCII = nextWord | encoding == Binary = id instance Pixel GrayscalePixel where readPixel ASCII s = do (num, r) <- SC.readInt s return ((GrayscalePixel num),r) readPixel Binary s = do (x,xs) <- S.uncons s let pixelBin = fromIntegral x return $ ((GrayscalePixel pixelBin),xs) encodePixel ASCII (GrayscalePixel l) = SC.pack $ (show l) ++ " " encodePixel Binary (GrayscalePixel l) = SC.singleton $ chr l instance Pixel ColorPixel where readPixel ASCII s = do (red, r1) <- SC.readInt s (green, r2) <- SC.readInt $ nextWord r1 (blue, r3) <- SC.readInt $ nextWord r2 return ((ColorPixel red green blue),r3) readPixel Binary s = do (red,r1) <- S.uncons s (green,r2) <- S.uncons r1 (blue,r3) <- S.uncons r2 return ((ColorPixel (fromIntegral red) (fromIntegral green) (fromIntegral blue)),r3) encodePixel ASCII (ColorPixel r g b) = SC.concat $ fmap toAscii [r,g,b] where toAscii l = SC.pack $ (show l) ++ " " encodePixel Binary (ColorPixel r g b) = SC.pack $ fmap chr [r,g,b] instance Image PPMImage where dimensions (PPMImage pixels) = let (width,height) = snd $ bounds pixels in (width + 1,height + 1) decode rawImage = do (header,r) <- parseHeader rawImage let imgType = imageType header unless (imgType == PPM) Nothing let rawPixels = nextLine r pixels = readPixels (imageEncoding header) rawPixels (width,height) = imageCoords header unless ((length pixels) == (width * height)) Nothing return (PPMImage $ listArray ((0,0),(width - 1,height - 1)) pixels) encode encoding img@(PPMImage pixels) = let pixelList = elems pixels header = Header PPM encoding (dimensions img) 255 in (encodeHeader header) `S.append` (encodePixels encoding pixelList) instance Image PGMImage where dimensions (PGMImage pixels) = let (width,height) = snd $ bounds pixels in (width + 1,height + 1) decode rawImage = do (header,r) <- parseHeader rawImage let imgType = imageType header unless (imgType == PGM) Nothing let rawPixels = nextLine r pixels = readPixels (imageEncoding header) rawPixels (width,height) = imageCoords header unless ((length pixels) == (width * height)) Nothing return (PGMImage $ listArray ((0,0),(width - 1,height - 1)) pixels) encode encoding img@(PGMImage pixels) = let pixelList = elems pixels header = Header PGM encoding (dimensions img) 255 in (encodeHeader header) `S.append` (encodePixels encoding pixelList)

Main.hs (pnmbin2asc):

import qualified Data.ByteString.Lazy as S import System.Environment import Data.PNM convertImage :: (Image a) => Maybe a -> String -> IO () convertImage Nothing _ = do putStrLn "Bad Source Image" convertImage (Just img) dest = dump ASCII img dest main = do (source:dest:[]) <- getArgs content <- S.readFile source let header = parseHeader content case header of Nothing -> putStrLn $ source ++ ": Bad image" Just (header,_) -> case (imageEncoding header) of ASCII -> putStrLn $ source ++ ": Already an ASCII image" Binary -> let image = decode content :: Maybe PPMImage in convertImage image dest

P.S. I know about Parsec but I have yet to learn how to use it. I wanted to write this library without it for learning purpose