cropping an image with JuicyPixels

Main.hs

module Main where

import Codec.Picture
import Codec.Picture.Types
import Debug.Trace

type X = Int
type Y = Int
type Width = Int
type Height = Int
data CropDimensions = CropD X Y Width Height

{-
Is suppose to take the color of the top-left pixel
Then look at pixel columns from left to right (left)
                   columns      right to left (right)
                   rows         top to bottom (top)
                   rows         bottom to top (bottom)
to see if they have the same color as the start pixels

if one pixel does not have the same color we found the square cropping area
-}
detectCrop :: DynamicImage -> Either String CropDimensions
detectCrop dynImg =
  let xMax = (dynamicMap imageWidth dynImg) - 1
      yMax = (dynamicMap imageHeight dynImg) - 1

      aux :: Pixel a => Image a -> Either String CropDimensions
      aux img =
        let startPixel = pixelAt img 0 0 -- naive background color detection

            rows    = [ [pixelAt img x y | x <- [0..xMax]] | y <- [0..yMax] ]
            columns = [ [pixelAt img x y | y <- [0..yMax]] | x <- [0..xMax] ]

            hasStartPixel q = flip zip [0..] $ map (\x -> all (== startPixel) x) q

            findEdge rev rowcol = case lookup False $ rev $ hasStartPixel rowcol of
                                    Nothing -> Left "Could not detect crop area (only background in image)."
                                    Just result -> Right result

            left   = findEdge id      columns
            right  = findEdge reverse columns
            top    = findEdge id      rows
            bottom = findEdge reverse rows

        in do
          l <- left
          r <- right
          t <- top
          b <- bottom
          if l > r || t > b
            then Left "Could not detect crop area (unexpected error in algorithm)"
            --else Left $ show l ++ " " ++ show r ++ " " ++ show t ++ " " ++ show b
            else Right $ CropD l t (r - l + 1) (b - t + 1)

  in dynamicMap aux dynImg

crop :: DynamicImage -> CropDimensions -> Either String DynamicImage
crop img (CropD x y width height)
  | outOfBound = Left "Parameters out of bound from original image"
  | otherwise  = let f img = generateImage (\x2 y2 -> pixelAt img (x2+x) (y2+y)) width height
                 in Right $ dynamicPixelMap f img
  where srcWidth  = dynamicMap imageWidth img
        srcHeight = dynamicMap imageHeight img
        outOfBound = x < 0
                  || x + width > srcWidth
                  || y < 0
                  || y + height > srcHeight

main :: IO ()
main = do
  img <- readImage "test.png"
  case img of
    Left err -> putStrLn err
    Right img -> do
      case detectCrop img of
        Left str -> putStrLn $ "detectCrop: " ++ str
        Right dimensions -> case crop img dimensions of
                              Left str -> putStrLn $ "crop: " ++ str
                              Right newImg -> do
                                savePngImage "output.png" newImg
                                putStrLn "Image saved"