Computing the intersection of two identical heatmaps, one with a black background and the other on a map

Main.hs

module Main where

import Codec.Picture

intersection :: Image PixelRGBA8 -> Image PixelRGBA8 -> Int -> Int -> PixelRGBA8
intersection a b x y =
  let (PixelRGBA8 a1 a2 a3 a4) = pixelAt a x y
      (PixelRGBA8 b1 b2 b3 b4) = pixelAt b x y
      as = [a1, a2, a3]
      bs = [b1, b2, b3]
      test = not . null . filter (>= 100)
      average x y = fromIntegral $ (fromIntegral x + fromIntegral y) `quot` (2 :: Integer)
  in if test as && test bs
  then PixelRGBA8 (average a1 b1) (average a2 b2) (average a3 b3) 255
  else PixelRGBA8 0 0 0 0

main :: IO ()
main = do
  Right (ImageRGBA8 routes) <- readPng "routes.png"
  Right (ImageRGBA8 map)    <- readPng "map.png"
  let img = generateImage (intersection routes map) (imageWidth routes) (imageHeight routes)
  writePng "intersection.png" img