netpbm 0.2.1 → 0.3.0

raw patch · 4 files changed

+581/−69 lines, 4 filesdep +criteriondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• bench/Bench.hs +15/−0
• netpbm.cabal +24/−4
• src/Graphics/Netpbm.hs +361/−60
• test/Main.hs +181/−5

@@ -0,0 +1,15 @@+import qualified Data.ByteString as BS+import           Criterion.Main++import Graphics.Netpbm+++main :: IO ()+main = do+  sipi <- BS.readFile "test/ppms/SIPI.ppm"+  image <- BS.readFile "test/ppms/image.ppm"++  defaultMain [+       bgroup "fib" [ bench "SIPI.ppm" $ whnf parsePPM sipi+                    , bench "image.ppm" $ whnf parsePPM image+                    ] ]

@@ -1,5 +1,5 @@ name:          netpbm-version:       0.2.1+version:       0.3.0 license:       MIT copyright:     2013 Niklas Hambüchen <mail@nh2.me> author:        Niklas Hambüchen <mail@nh2.me>@@ -12,7 +12,12 @@ homepage:      https://github.com/nh2/haskell-netpbm bug-Reports:   https://github.com/nh2/haskell-netpbm/issues synopsis:      Loading PBM, PGM, PPM image files-description:   This package contains pure Haskell parsers for the netpbm image formats: PBM, PGM and PPM, for both ASCII and binary encodings.+description:+  This package contains pure Haskell parsers for the netpbm image formats: PBM, PGM and PPM, for both ASCII and binary encodings.+  .+  All netpbm image formats are implemented (P1 - P6).+  .+  The current implementation parses PPM images at around 10 MB/s on a Core i5-2520M.   source-repository head@@ -27,7 +32,7 @@       base < 5     , attoparsec >= 0.10     , attoparsec-binary >= 0.2-    , bytestring >= 0.10+    , bytestring >= 0.9     , storable-record >= 0.0.2.5     , unordered-containers >= 0.1.3.0     , vector >= 0.7@@ -48,7 +53,22 @@   build-depends:       base >= 4     , netpbm-    , bytestring >= 0.10+    , bytestring >= 0.9     , hspec >= 1.3.0.1     , HUnit >= 1.2+  ghc-options: -Wall+++benchmark bench+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs:+    bench+  main-is:+    Bench.hs+  build-depends:+      base >= 4+    , netpbm+    , bytestring >= 0.9+    , criterion >= 0.6.0.0   ghc-options: -Wall

@@ -4,17 +4,23 @@  -- | Parsing the netpbm image formates (PBM, PGM and PPM, both ASCII and binary) from 'ByteString's. --+-- All netpbm image formats are implemented (P1 - P6).+-- -- To parse one of these formats, use `parsePPM`. ----- Currently, only P6 images are implemented.--- Implementing the other types should be straighforward.+-- See also: <http://www.imagemagick.org/Usage/formats/#netpbm> module Graphics.Netpbm (   PPMType (..) , PPM (..)-, PpmPixelRGB8-, PpmPixelRGB16+, PpmPixelRGB8 (..)+, PpmPixelRGB16 (..)+, PbmPixel (..)+, PgmPixel8 (..)+, PgmPixel16 (..) , PPMHeader (..) , PpmPixelData (..)+, pixelVectorToList+, pixelDataToIntList , parsePPM , PpmParseResult -- TODO expose attoparsec functions in .Internal package@@ -25,16 +31,18 @@ import           Data.Attoparsec.ByteString as A import           Data.Attoparsec.ByteString.Char8 as A8 import           Data.Attoparsec.Binary (anyWord16be)+import           Data.Bits (testBit) import           Data.ByteString (ByteString)-import           Data.Char (ord)+import           Data.Char (chr, ord) import           Data.List (foldl') import           Data.Word (Word8, Word16) import           Foreign.Storable.Record as Store import           Foreign.Storable (Storable (..))  import qualified Data.Vector.Unboxed as U+import           Data.Vector.Unboxed ((!)) import qualified Data.Vector.Generic-import qualified Data.Vector.Generic.Mutable+import qualified Data.Vector.Generic.Mutable as VGM  import Data.Vector.Unboxed.Deriving @@ -79,11 +87,40 @@                                    {-# UNPACK #-} !Word16 -- Blue                                    deriving (Eq, Show) +-- | A pixel containing black or white.+newtype PbmPixel = PbmPixel Bool -- False = black, True = white+                 deriving (Eq, Show)++-- | A pixel containing an 8-bit greyscale value.+data PgmPixel8 = PgmPixel8 {-# UNPACK #-} !Word8+                           deriving (Eq, Show)++-- | A pixel containing a 16-bit greyscale value.+data PgmPixel16 = PgmPixel16 {-# UNPACK #-} !Word16+                             deriving (Eq, Show)+ -- | Image data, either 8 or 16 bits.+-- TODO rename to PNM data PpmPixelData = PpmPixelDataRGB8 (U.Vector PpmPixelRGB8)   -- ^ For 8-bit PPMs.                   | PpmPixelDataRGB16 (U.Vector PpmPixelRGB16) -- ^ For 16-bit PPMs.+                  | PbmPixelData (U.Vector PbmPixel)           -- ^ For 1-bit PBMs.+                  | PgmPixelData8 (U.Vector PgmPixel8)         -- ^ For 8-bit PGMs.+                  | PgmPixelData16 (U.Vector PgmPixel16)       -- ^ For 16-bit PGMs.  +pixelVectorToList :: (U.Unbox a) => U.Vector a -> [a]+pixelVectorToList = U.toList+++pixelDataToIntList :: PpmPixelData -> [Int]+pixelDataToIntList d = case d of+  PpmPixelDataRGB8 v  -> concat [ map fromIntegral [r, g, b] | PpmPixelRGB8 r g b  <- U.toList v ]+  PpmPixelDataRGB16 v -> concat [ map fromIntegral [r, g, b] | PpmPixelRGB16 r g b <- U.toList v ]+  PbmPixelData v      ->        [ if b then 1 else 0         | PbmPixel b          <- U.toList v ]+  PgmPixelData8 v     ->        [ fromIntegral x             | PgmPixel8 x         <- U.toList v ]+  PgmPixelData16 v    ->        [ fromIntegral x             | PgmPixel16 x        <- U.toList v ]++ -- * Unbox instance for pixels  derivingUnbox "PpmPixelRGB8"@@ -96,36 +133,84 @@     [| \ (PpmPixelRGB16 a b c) -> (a, b, c) |]     [| \ (a, b, c) -> PpmPixelRGB16 a b c |] +derivingUnbox "PbmPixel"+    [t| PbmPixel -> Bool |]+    [| \ (PbmPixel b) -> b |]+    [| \ b -> PbmPixel b |] +derivingUnbox "PgmPixel8"+    [t| PgmPixel8 -> Word8 |]+    [| \ (PgmPixel8 x) -> x |]+    [| \ x -> PgmPixel8 x |]++derivingUnbox "PgmPixel16"+    [t| PgmPixel16 -> Word16 |]+    [| \ (PgmPixel16 x) -> x |]+    [| \ x -> PgmPixel16 x |]++ -- * Storable instance for pixels -storePixel8 :: Store.Dictionary PpmPixelRGB8-storePixel8 =+storePpmPixel8 :: Store.Dictionary PpmPixelRGB8+storePpmPixel8 =   Store.run $ liftA3 PpmPixelRGB8     (Store.element (\(PpmPixelRGB8 x _ _) -> x))     (Store.element (\(PpmPixelRGB8 _ y _) -> y))     (Store.element (\(PpmPixelRGB8 _ _ z) -> z)) -storePixel16 :: Store.Dictionary PpmPixelRGB16-storePixel16 =+storePpmPixel16 :: Store.Dictionary PpmPixelRGB16+storePpmPixel16 =   Store.run $ liftA3 PpmPixelRGB16     (Store.element (\(PpmPixelRGB16 x _ _) -> x))     (Store.element (\(PpmPixelRGB16 _ y _) -> y))     (Store.element (\(PpmPixelRGB16 _ _ z) -> z)) +storePbmPixel :: Store.Dictionary PbmPixel+storePbmPixel =+  Store.run $ liftA PbmPixel+    (Store.element (\(PbmPixel x) -> x))++storePgmPixel8 :: Store.Dictionary PgmPixel8+storePgmPixel8 =+  Store.run $ liftA PgmPixel8+    (Store.element (\(PgmPixel8 x) -> x))++storePgmPixel16 :: Store.Dictionary PgmPixel16+storePgmPixel16 =+  Store.run $ liftA PgmPixel16+    (Store.element (\(PgmPixel16 x) -> x))+ instance Storable PpmPixelRGB8 where-  sizeOf = Store.sizeOf storePixel8-  alignment = Store.alignment storePixel8-  peek = Store.peek storePixel8-  poke = Store.poke storePixel8+  sizeOf = Store.sizeOf storePpmPixel8+  alignment = Store.alignment storePpmPixel8+  peek = Store.peek storePpmPixel8+  poke = Store.poke storePpmPixel8  instance Storable PpmPixelRGB16 where-  sizeOf = Store.sizeOf storePixel16-  alignment = Store.alignment storePixel16-  peek = Store.peek storePixel16-  poke = Store.poke storePixel16+  sizeOf = Store.sizeOf storePpmPixel16+  alignment = Store.alignment storePpmPixel16+  peek = Store.peek storePpmPixel16+  poke = Store.poke storePpmPixel16 +instance Storable PbmPixel where+  sizeOf = Store.sizeOf storePbmPixel+  alignment = Store.alignment storePbmPixel+  peek = Store.peek storePbmPixel+  poke = Store.poke storePbmPixel +instance Storable PgmPixel8 where+  sizeOf = Store.sizeOf storePgmPixel8+  alignment = Store.alignment storePgmPixel8+  peek = Store.peek storePgmPixel8+  poke = Store.poke storePgmPixel8++instance Storable PgmPixel16 where+  sizeOf = Store.sizeOf storePgmPixel16+  alignment = Store.alignment storePgmPixel16+  peek = Store.peek storePgmPixel16+  poke = Store.poke storePgmPixel16++ -- | Parses a netpbm magic number. -- One of P1, P2, P3, P4, P5, P6. magicNumberParser :: Parser PPMType@@ -134,7 +219,6 @@   case magic of     "P1" -> return P1     "P2" -> return P2-     "P3" -> return P3     "P4" -> return P4     "P5" -> return P5@@ -143,6 +227,66 @@   +-- Not writing this as @comments = skipMany comment@ because that would allow this parser+-- to consume no input, which makes it loop forever when stuck into something like `many`.+{-# INLINE comment #-}+comment :: Parser ByteString+comment = "#" .*> A.takeWhile isNotNewline <* endOfLine+  where+    isNotNewline w = w /= 10 && w /= 13+++{-# INLINE sep #-}+sep :: Parser ()+-- At least one space, optionally with more space or comments around+sep = do skipMany comment+         singleWhitespace+         skipMany (singleWhitespace <|> void comment)+++-- | Decimal, possibly with comments interleaved,+-- but starting and ending with a digit.+-- See the notes about comments.+{-# INLINE decimalC #-}+decimalC :: Parser Int+decimalC = foldl' shiftDecimalChar 0 <$> (digit `sepBy1` skipMany comment)+  where+    shiftDecimalChar a d = a * 10 + ord d - (48 :: Int)+++headerParser :: Parser PPMHeader+headerParser = do+  ppmType <- magicNumberParser+  sep+  width <- decimalC+  sep+  height <- decimalC+  skipMany comment -- Don't allow whitespace here since after the next whitespace there must not be any more comments+  return $ PPMHeader ppmType width height+++{-# INLINE word8max #-}+-- Parsing words not bigger than given maxval+word8max :: Word8 -> Parser Word8+word8max m = A.satisfy (<= m) <?> "pixel data must be smaller than maxval"++{-# INLINE word16max #-}+word16max :: Word16 -> Parser Word16+word16max m = do w16 <- anyWord16be+                 when (not $ w16 <= m) $ fail "pixel data must be smaller than maxval"+                 return w16+++{-# INLINE isValidMaxval #-}+isValidMaxval :: Int -> Bool+isValidMaxval v = v > 0 && v < 65536+++{-# INLINE singleWhitespace #-}+singleWhitespace :: Parser ()+singleWhitespace = void $ A.satisfy isSpace_w8++ -- | Parses a SINGLE PPM file. -- -- Specification: http://netpbm.sourceforge.net/doc/ppm.html@@ -157,61 +301,218 @@ -- inside the magic number". -- -- See also the notes for `imagesParser`.-ppmParser :: Parser PPM-ppmParser = do-  ppmType <- magicNumberParser-  -- TODO Implement the other netpbm image types-  when (ppmType /= P6) $ error "haskell-netpbm currently only supports PPM P6"-  comments-  skipSpace-  comments-  width <- decimalC-  comments-  skipSpace-  comments-  height <- decimalC-  comments-  skipSpace-  comments+ppmBodyParser :: PPMHeader -> Parser PPM+ppmBodyParser header@PPMHeader { ppmWidth = width, ppmHeight = height } = do++  sep+   maxColorVal <- decimalC-  when (not $ isValidColorVal maxColorVal) $+  when (not $ isValidMaxval maxColorVal) $     fail $ "PPM: invalid color maxval " ++ show maxColorVal-  comments-  _ <- A8.satisfy isSpace -- obligatory SINGLE whitespace-  -- Starting from here, comments are not allowed any more-  raster <- if maxColorVal < 256 -- 1 or 2 bytes per pixel-      -- TODO check if values are smaller than maxColorVal-      then PpmPixelDataRGB8 <$> (U.replicateM (height * width) $-             PpmPixelRGB8 <$> anyWord8 <*> anyWord8 <*> anyWord8)-      else PpmPixelDataRGB16 <$> (U.replicateM (height * width) $-             PpmPixelRGB16 <$> anyWord16be <*> anyWord16be <*> anyWord16be)+  skipMany comment -  return $ PPM (PPMHeader ppmType width height) raster+  singleWhitespace -- obligatory SINGLE whitespace; starting from here, comments are not allowed any more +  raster <- case maxColorVal of -- 1 or 2 bytes per pixel+    -- Parse pixel data into vector, making sure that words don't exceed maxColorVal+    m | m < 256   -> let v = word8max (fromIntegral m)+                      in PpmPixelDataRGB8  <$> U.replicateM (height * width) (PpmPixelRGB8  <$> v <*> v <*> v)+    m | otherwise -> let v = word16max (fromIntegral m)+                      in PpmPixelDataRGB16 <$> U.replicateM (height * width) (PpmPixelRGB16 <$> v <*> v <*> v)++  return $ PPM header raster+++pgmBodyParser :: PPMHeader -> Parser PPM+pgmBodyParser header@PPMHeader { ppmWidth = width, ppmHeight = height } = do++  sep++  maxGreyVal <- decimalC+  when (not $ isValidMaxval maxGreyVal) $+    fail $ "PGM: invalid grey maxval " ++ show maxGreyVal+  skipMany comment++  singleWhitespace -- obligatory SINGLE whitespace; starting from here, comments are not allowed any more++  raster <- case maxGreyVal of -- 1 or 2 bytes per pixel+    -- Parse pixel data into vector, making sure that words don't exceed maxGreyVal+    m | m < 256   -> let v = word8max (fromIntegral m)+                      in PgmPixelData8  <$> U.replicateM (height * width) (PgmPixel8  <$> v)+    m | otherwise -> let v = word16max (fromIntegral m)+                      in PgmPixelData16 <$> U.replicateM (height * width) (PgmPixel16 <$> v)++  return $ PPM header raster+++pbmBodyParser :: PPMHeader -> Parser PPM+pbmBodyParser header@PPMHeader { ppmWidth = width, ppmHeight = height } = do++  singleWhitespace -- obligatory SINGLE whitespace; starting from here, comments are not allowed any more++  -- From: http://netpbm.sourceforge.net/doc/pbm.html+  --   "Each row is Width bits, packed 8 to a byte, with don't care bits to fill out the last byte in the row."+  let widthBytes = (width + 7) // 8++  -- Parse pixel data first in into a Word8 vector, then translate to a Bool vector, leaving the don't-cares at the end out.+  word8Vector <- U.replicateM (height * widthBytes) anyWord8++  let bits = U.create $ do+        v <- VGM.replicate (width * height) (PbmPixel False)+        forM_ [0..height-1] $ \row ->+          forM_ [0..width-1] $ \col ->+            let i            = row * width + col+                (col8, bitN) = col /% 8+                i8           = row * widthBytes + col8+             -- We negate (see "not"), because:+             --   "1 is black, 0 is white."+             -- Also, `testBit` indexes from the right (LSB).+             in VGM.write v i (PbmPixel . not $ (word8Vector ! i8) `testBit` (7 - bitN))+        return v++  return $ PPM header (PbmPixelData bits)   where-    isValidColorVal v = v > 0 && v < 65536-    comments = void $ many comment-    comment = "#" .*> A.takeWhile isNotNewline <* endOfLine-    isNotNewline w = w /= 10 && w /= 13-    -- Decimal, possibly with comments interleaved,-    -- but starting and ending with a digit.-    -- See the notes about comments above.-    decimalC :: Parser Int-    decimalC = foldl' shiftDecimalChar 0 <$> ((:) <$> digit <*> many (comments *> digit))-    shiftDecimalChar a d = a * 10 + ord d - (48 :: Int)+    (//) = quot+    (/%) = quotRem  +-- | See http://netpbm.sourceforge.net/doc/pbm.html+--+-- We ignore the "No line should be longer than 70 characters" here due to "should".+pbmAsciiBodyParser :: PPMHeader -> Parser PPM+pbmAsciiBodyParser header@PPMHeader { ppmWidth = width, ppmHeight = height } = do++  singleWhitespace -- obligatory SINGLE whitespace; starting from here, comments are not allowed any more++  -- Parse pixel data into Bool vector.+  let n = height * width+  -- There must be whitespace *between* the values.+  -- There can be whitespace *before* the first value since:+  --   "White space in the raster section is ignored."+  -- Don't allow it *after* so that we can check if there is a whitespace between raster and optional junk.+  -- I use `generateM` here instead of fromList . (`sepBy` [whitespace]) because I believe it's faster.+  bits <- U.replicateM n (A.takeWhile isSpace_w8 *> asciiBit)++  -- From the spec (who the heck can even come up with this):+  --   "You can put any junk you want after the raster, if it starts with a white space character."+  -- Note that it says *can*, i.e. the junk can also be empty, so trailing whitespace is allowed.+  -- So let's eat all remaining input:+  option () (A.takeWhile1 isSpace_w8 *> takeLazyByteString *> pure ())++  -- Now we should be at the end of file.+  endOfInput <?> "there is junk after the ASCII raster that is not separated by whitespace"++  return $ PPM header (PbmPixelData bits)+  where+    asciiBit = PbmPixel <$> (anyWord8 >>= toBool)+    -- We flip True/False because "1" means black == False.+    toBool 48 = return True+    toBool 49 = return False+    toBool w  = fail $ "ASCII bit must be '0' or '1', not " ++ show (chr $ fromIntegral w)+++pgmAsciiBodyParser :: PPMHeader -> Parser PPM+pgmAsciiBodyParser header@PPMHeader { ppmWidth = width, ppmHeight = height } = do++  sep++  maxGreyVal <- decimalC+  when (not $ isValidMaxval maxGreyVal) $+    fail $ "PGM: invalid grey maxval " ++ show maxGreyVal+  skipMany comment++  singleWhitespace -- obligatory SINGLE whitespace; starting from here, comments are not allowed any more++  let n = height * width++  -- TODO size-check the int by first putting it in Word64 and limiting decimal length+  raster <- case maxGreyVal of -- 1 or 2 bytes per pixel+    -- Parse pixel data into vector, making sure that words don't exceed maxGreyVal+    m | m < 256 -> PgmPixelData8  <$> U.replicateM n (A.takeWhile isSpace_w8 *> (PgmPixel8  <$> decimal))+    _           -> PgmPixelData16 <$> U.replicateM n (A.takeWhile isSpace_w8 *> (PgmPixel16 <$> decimal))++  option () (A.takeWhile1 isSpace_w8 *> takeLazyByteString *> pure ())++  -- Now we should be at the end of file.+  endOfInput <?> "there is junk after the ASCII raster that is not separated by whitespace"++  return $ PPM header raster+++ppmAsciiBodyParser :: PPMHeader -> Parser PPM+ppmAsciiBodyParser header@PPMHeader { ppmWidth = width, ppmHeight = height } = do++  sep++  maxColorVal <- decimalC+  when (not $ isValidMaxval maxColorVal) $+    fail $ "PGM: invalid color maxval " ++ show maxColorVal+  skipMany comment++  singleWhitespace -- obligatory SINGLE whitespace; starting from here, comments are not allowed any more++  let n = height * width+      d8  = A.takeWhile isSpace_w8 *> decimal :: Parser Word8+      d16 = A.takeWhile isSpace_w8 *> decimal :: Parser Word16++  -- TODO size-check the int by first putting it in Word64 and limiting decimal length+  raster <- case maxColorVal of -- 1 or 2 bytes per pixel+    -- Parse pixel data into vector, making sure that words don't exceed maxColorVal+    m | m < 256 -> PpmPixelDataRGB8  <$> U.replicateM n (PpmPixelRGB8  <$> d8  <*> d8  <*> d8 )+    _           -> PpmPixelDataRGB16 <$> U.replicateM n (PpmPixelRGB16 <$> d16 <*> d16 <*> d16)++  option () (A.takeWhile1 isSpace_w8 *> takeLazyByteString *> pure ())++  -- Now we should be at the end of file.+  endOfInput <?> "there is junk after the ASCII raster that is not separated by whitespace"++  return $ PPM header raster+++imageParserOfType :: Maybe PPMType -> Parser PPM+imageParserOfType mpN = do+  header@PPMHeader { ppmType } <- headerParser++  case mpN of+    Just pN | pN /= ppmType -> fail "an image in a multi-image file is not of the same type as the first image in the file"+    _                       -> return ()++  case ppmType of+    P1 -> pbmAsciiBodyParser header+    P2 -> pgmAsciiBodyParser header+    P3 -> ppmAsciiBodyParser header+    P4 -> pbmBodyParser header+    P5 -> pgmBodyParser header+    P6 -> ppmBodyParser header+++imageParser :: Parser PPM+imageParser = imageParserOfType Nothing++ -- | Parses a full PPM file, containing one or more images. ----- "A PPM file consists of a sequence of one or more PPM images."--- We allow trailing whitespace after images, which is AGAINST THE SPEC:+-- From the spec: -- -- >"A PPM file consists of a sequence of one or more PPM images. -- > There are no data, delimiters, or padding before, after, or between images." ----- However, you can find PPM files that have trailing whitespace, especially a '\n'.+-- However, you can find PPM files that have trailing whitespace, especially a '\n',+-- so we allow this. imagesParser :: Parser [PPM]-imagesParser = many1 (ppmParser <* skipSpace)+imagesParser = do+  -- Parse the first image.+  firstImage@PPM { ppmHeader = PPMHeader { ppmType } } <- imageParser <* skipSpace++  -- Force the following images, if any, to be of the same type.+  otherImages <- many (imageParserOfType (Just ppmType) <* skipSpace)++  -- TODO Restructure so that this cannot happen. There is no point of returning [PPM] for ASCII images.+  when (ppmType `elem` [P1, P2, P3] && not (null otherImages)) $+    error "haskell-netpbm bug: ASCII formats should never contain more than one image (they treat remaining data as junk)"++  return $ firstImage:otherImages+   -- | The result of a PPM parse.

@@ -16,6 +16,16 @@   Left e                                               -> assertFailure $ "image parse failed: " ++ e  +checkSinglePPMdata :: PPMType -> (Int, Int) -> [Int] -> PpmParseResult -> Assertion+checkSinglePPMdata typ size expected parseResult = case parseResult of+  Right ([PPM { ppmHeader = PPMHeader { ppmType, ppmWidth, ppmHeight }+              , ppmData }], rest) -> do+                                        (ppmType, (ppmWidth, ppmHeight), rest) `shouldBe` (typ, size, Nothing)+                                        pixelDataToIntList ppmData `shouldBe` expected+  Right (ppms, _)                 -> assertFailure $ "expected only one image, but got " ++ show (length ppms)+  Left e                          -> assertFailure $ "image parse failed: " ++ e++ shouldNotParse :: PpmParseResult -> Assertion shouldNotParse res = case res of   Left _ -> return ()@@ -31,6 +41,16 @@   parse ("test/ppms/" ++ name) >>= check  +repcat :: Int -> [a] -> [a]+repcat n = concat . replicate n+++-- @dir@ must have trailing slash.+checkDirectory :: FilePath -> String -> PPMType -> [(String, (Int, Int))] -> Spec+checkDirectory dir desc typ filesWithSizes = forM_ filesWithSizes $ \(f, size) ->+  parseTestFile (dir ++ f) desc $ checkSinglePPM typ size++ main :: IO () main = hspec $ do   describe "P6 PPM (color binary)" $ do@@ -38,7 +58,7 @@     parseTestFile "gimp.ppm" "a file produced by GIMP" $       checkSinglePPM P6 (640,400) -    parseTestFile "gitlogo.ppm" "a file produced convert" $+    parseTestFile "gitlogo.ppm" "a file produced by convert" $       checkSinglePPM P6 (220,92)      parseTestFile "image.ppm" "some random file from the internet" $@@ -48,7 +68,7 @@       checkSinglePPM P6 (227,149)      describe "more test files from the internet" $ do-      forM_+      checkDirectory "internet/set1/" "from the internet" P6         [ ("boxes_1.ppm", (63,63))         , ("boxes_2.ppm", (63,63))         , ("house_1.ppm", (111,132))@@ -65,11 +85,25 @@         , ("tree_2.ppm", (133,133))         , ("west_1.ppm", (366,216))         , ("west_2.ppm", (366,216))-        ] $ \(f, size) ->-          parseTestFile ("internet/set1/" ++ f) "from the internet" $-            checkSinglePPM P6 size+        ]+      checkDirectory "internet/set3/" "from the internet, PNM" P6+        [ ("birch.pnm", (128,128))+        , ("cotton.pnm", (256,170))+        , ("oak.pnm", (128,128))+        , ("quilt.pnm", (256,237))+        ] +      parseTestFile "internet/set2/mandrill.ppm" "the color file from the 'Math 625' course" $+        checkSinglePPM P6 (512,512) +      parseTestFile "internet/set2/half.ppm" "the color file from the 'Math 625' course, half width" $+        checkSinglePPM P6 (256,512)++      parseTestFile "SIPI.ppm" "SIPI test file" $+        -- convert SIPI.tiff SIPI.ppm+        checkSinglePPM P6 (256,256)++     parseTestFile "gitlogo-double.ppm" "a multi-image file" $ do       \res -> case res of         Right ([ PPM { ppmHeader = h1 }@@ -134,6 +168,25 @@           Left e                                  -> assertFailure $ "did not parse: " ++ e  +    describe "16-bit images" $ do++      -- See http://wiki.simg.de/doku.php?id=common:formats#pnm_family+      parseTestFile "gitlogo-16bit-created-by-simg_convert_-16be_gitlogo.ppm_output.ppm" "16-bit image created by simg" $+        \res -> case res of+          Right ([PPM { ppmHeader, ppmData }], rest) -> do ppmHeader `shouldBe` PPMHeader P6 220 92+                                                           rest `shouldBe` Nothing+                                                           case ppmData of+                                                             PpmPixelDataRGB16 _ -> return ()+                                                             _                   -> assertFailure $ "did not get 16-bit data"+          Right r                                 -> assertFailure $ "parsed unexpected: " ++ show r+          Left e                                  -> assertFailure $ "did not parse: " ++ e++      parseTestFile "SIPI-16.ppm" "SIPI test file" $+        -- convert SIPI.tiff -depth 16 SIPI-16.ppm+        checkSinglePPM P6 (256,256)++      -- TODO try to get a 16-bit image out of the new gimp+     describe "negative examples" $ do        parseTestFile "bad/gitlogo-garbage-in-numbers.ppm" "ascii characters in a number" shouldNotParse@@ -146,4 +199,127 @@        parseTestFile "bad/gitlogo-comment-user-error.ppm" "a comment accidentally being put to close to a number, eating the following whitespace" $ shouldNotParse +      parseTestFile "bad/gitlogo-comment-user-error-no-space-after-magic.ppm" "a comment accidentally being put to close to the magic number, eating the following whitespace" $ shouldNotParse+       parseTestFile "bad/gitlogo-comment-without-following-extra-newline-before-data-block.ppm" "no non-comment whitespace before data block" shouldNotParse++      parseTestFile "bad/gitlogo-value-bigger-than-maxval.ppm" "subpixel value is bigger than maxval" shouldNotParse++      parseTestFile "internet/set3/cathedral.pnm" "subpixel value is bigger than maxval" shouldNotParse+      parseTestFile "internet/set3/checkers.pnm"  "subpixel value is bigger than maxval" shouldNotParse+      parseTestFile "internet/set3/fish_tile.pnm" "subpixel value is bigger than maxval" shouldNotParse+      parseTestFile "internet/set3/garnet.pnm"    "subpixel value is bigger than maxval" shouldNotParse+++  describe "P5 PGM (greyscale binary)" $ do++    parseTestFile "internet/set2/mandrill.pgm" "the color file from the 'Math 625' course" $+      checkSinglePPM P5 (512,512)++    parseTestFile "internet/set2/half.pgm" "the color file from the 'Math 625' course, half width" $+      checkSinglePPM P5 (256,512)++    parseTestFile "SIPI-convert.pgm" "a file produced by convert" $+      -- convert SIPI.tiff SIPI-convert.pgm+      checkSinglePPM P5 (256,256)+++    describe "comments" $ do++      parseTestFile "internet/set2/comments.pgm" "the color file from the 'Math 625' course, with comments" $+        checkSinglePPM P5 (512,512)+++    describe "16-bit" $ do++      parseTestFile "SIPI-convert-16.pgm" "a file produced by convert, 16-bit" $+        -- convert SIPI.tiff -depth 16 SIPI-convert-16.pgm+        checkSinglePPM P5 (256,256)+++  describe "P4 PBM (bitmap binary)" $ do++    parseTestFile "testgrid.pbm" "the bitmap file from the netpbm test suite" $+      checkSinglePPMdata P4 (14,16) (repcat 8 (repcat 7 [0,1] ++ replicate 14 0))++    parseTestFile "SIPI-convert.pbm" "a file produced by convert" $+      -- convert SIPI.tiff SIPI-convert.pbm+      checkSinglePPM P4 (256,256)+++  describe "P3 PPM (color ASCII)" $ do++    checkDirectory "internet/set3/" "more test files from the internet" P3+      [ ("feep.ppm", (4,4))+      , ("snail.ppm", (256,256))+      ]++    parseTestFile "SIPI-convert-plain.ppm" "a file produced by convert" $+      -- convert SIPI.tiff -compress none SIPI-convert-plain.ppm+      checkSinglePPM P3 (256,256)++    parseTestFile "SIPI-convert-plain-16.ppm" "a file produced by convert, 16-bit" $+      -- convert SIPI.tiff -compress none -depth 16 SIPI-convert-plain-16.ppm+      checkSinglePPM P3 (256,256)+++  describe "P2 PGM (greyscale ASCII)" $ do++    checkDirectory "internet/set3/" "more test files from the internet" P2+      [ ("balloons.pgm", (640,480))+      , ("columns.pgm", (640,480))+      , ("feep.pgm", (24,7))+      , ("tracks.pgm", (300,200))+      ]++    parseTestFile "pgm-plain-made-up-from-pbm-spec.pgm" "the plain PBM file from the spec example, converted to PGM" $+      -- Invert 0/1 because in PBM 1 is black, not so in PGM+      checkSinglePPMdata P2 (24,7) (map (1 -) pbmFromSpecResult)++    parseTestFile "SIPI-convert-plain.pgm" "a file produced by convert" $+      -- convert SIPI.tiff -compress none SIPI-convert-plain.pgm+      checkSinglePPM P2 (256,256)++    describe "16-bit" $ do++      parseTestFile "SIPI-convert-plain-16.pgm" "a file produced by convert, 16-bit" $+        -- convert SIPI.tiff -compress none -depth 16 SIPI-convert-plain-16.pgm+        checkSinglePPM P2 (256,256)+++  describe "P1 PBM (bitmap ASCII)" $ do++    describe "more test files from the internet" $ do+      checkDirectory "internet/set3/" "from the internet" P1+        [ ("circle_ascii.pbm", (200,200))+        , ("feep.pbm", (24,7))+        ]++    parseTestFile "pbm-plain-from-spec.pbm" "the plain PBM file from the spec example" $+      checkSinglePPMdata P1 (24,7) pbmFromSpecResult+++    describe "ASCII files should only contain one image" $ do++      parseTestFile "pbm-plain-from-spec-multiple-but-treated-as-junk.pbm" "ASCII PBM from spec, multiple times, rest should be treated as junk" $+        checkSinglePPMdata P1 (24,7) pbmFromSpecResult++      parseTestFile "bad/pbm-plain-from-spec-multiple-no-space-before-junk.pbm" "ASCII PBM from spec, multiple times, rest should be treated as junk" $+        shouldNotParse+++    parseTestFile "SIPI-convert-plain.pbm" "a file produced by convert" $+      -- convert SIPI.tiff -compress none SIPI-convert-plain.pbm+      checkSinglePPM P1 (256,256)++-- Some result data++-- Note that in a PBM file, "1" means black, but in the result 0 means black.+pbmFromSpecResult :: [Int]+pbmFromSpecResult = [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1+                    ,1,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1+                    ,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,0,1+                    ,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,0,0,0,0,1+                    ,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,1+                    ,1,0,1,1,1,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,1,1,1,1+                    ,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]