content: {-# LANGUAGE ScopedTypeVariables #-}
  
  module Bitmap.Netpbm(readNetpbm, writeNetpbm) where
  
  import Bitmap
  import Data.Char
  import System.IO
  import Control.Monad
  import Control.Monad.ST
  import Data.Array.ST
  
  nil :: a
  nil = undefined
  
  readNetpbm :: forall c. Color c => FilePath -> IO (Image RealWorld c)
  readNetpbm path = do
      let die = fail "readNetpbm: bad format"
      ppm <- readFile path
      let (s, rest) = splitAt 2 ppm
      unless (s == magicNumber) die
      let getNum :: String -> IO (Int, String)
          getNum ppm = do
              let (s, rest) = span isDigit $ skipBlanks ppm
              when (null s) die
              return (read s, rest)
      (width, rest) <- getNum rest
      (height, rest) <- getNum rest
      (_, c : rest) <-
          if getMaxval then getNum rest else return (nil, rest)
      unless (isSpace c) die
      i <- stToIO $ listImage width height $
          fromNetpbm $ map fromEnum rest
      return i
    where skipBlanks =
             dropWhile isSpace .
             until ((/= '#') . head) (tail . dropWhile (/= '\n')) .
             dropWhile isSpace
          magicNumber = netpbmMagicNumber (nil :: c)
          getMaxval = not $ null $ netpbmMaxval (nil :: c)
  
  writeNetpbm :: forall c. Color c => FilePath -> Image RealWorld c -> IO ()
  writeNetpbm path i = withFile path WriteMode $ \h -> do
      (width, height) <- stToIO $ dimensions i
      let w = hPutStrLn h
      w $ magicNumber
      w $ show width ++ " " ++ show height
      unless (null maxval) (w maxval)
      stToIO (getPixels i) >>= hPutStr h . toNetpbm
    where magicNumber = netpbmMagicNumber (nil :: c)
          maxval = netpbmMaxval (nil :: c)
  