Generate a .ppm file with a pixel image

Pixels.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector as V
import Data.Word
import Data.Monoid

main :: IO ()
main =
  BS.putStrLn
    . ppImage
    . image 100 100
    . V.fromList
    . fmap V.fromList
    $ [ [ red, green, blue ]
      , [ yellow, white, black ]
      ]

data Color
  = RGB Word8 Word8 Word8

red, green, blue, yellow, white, black :: Color
red = RGB 255 0 0
green = RGB 0 255 0
blue = RGB 0 0 255
yellow = RGB 255 255 0
white = RGB 255 255 255
black = RGB 0 0 0

data Image
  = Image Header (V.Vector (V.Vector Color))

data Header = Header Int Int

image :: Int -> Int -> V.Vector (V.Vector Color) -> Image
image rectWidth rectHeight img =
  let
    rowSize :: Int
    rowSize =
      maximum
      . fmap length
      $ img
    genRow :: V.Vector Color -> V.Vector (V.Vector Color)
    genRow row =
      V.replicate rectHeight
      . V.concatMap (V.replicate rectWidth)
      . (<> V.replicate (rowSize - length row) white)
      $ row
  in
    Image (Header (rectWidth * rowSize) (rectHeight * length img)) (V.concatMap genRow img)

ppImage :: Image -> BS.ByteString
ppImage (Image (Header w h) img) =
  BS.unlines $
    [ "P3", BS.unwords $ fmap (BS.pack . show) [w, h, 255]
    ] <> V.toList (fmap ppImgRow img)
  where
    ppImgRow :: V.Vector Color -> BS.ByteString
    ppImgRow = BS.unwords . V.toList . fmap ppColor
    ppColor :: Color -> BS.ByteString
    ppColor (RGB r g b) = BS.unwords . fmap (BS.pack . show) $ [r, g, b]