The complete Roberts edge detection algorithm implemented in Haskell

RobertsEdgeDetect.hs

{-# LANGUAGE PackageImports, BangPatterns, QuasiQuotes #-}
module Main where

import Data.Word
import Control.Monad
import System.Environment
import Data.Array.Repa as R
import Data.Array.Repa.IO.BMP
import Data.Array.Repa.IO.DevIL
import Data.Array.Repa.Stencil

main = do
    args <- getArgs
    case args of
        [input, out] -> run input out
        _            -> putStrLn "Uso: Roberts <fileIn.bmp> <fileOut.bmp>"

run fileIn fileOut = do
    inputImage <- runIL $ readImage fileIn
    let greyImage = toGreyScale inputImage
    greyImage `deepSeqArray` return ()

    let (gX, gY) = gradients greyImage
    deepSeqArrays [gX, gY] (return ())

    let normalized = normalizeToInteger $ force2 $ R.zipWith magnitude gX gY	
    deepSeqArray normalized (return ())

    writeMatrixToGreyscaleBMP fileOut normalized

gradients = withManifest $ \i -> let (gX, gY) = (robertsX i, robertsY i) in deepSeqArrays [gX, gY] (gX, gY)

normalizeToInteger img = R.force $ R.map (\x -> (x / maxValue) * 255) img
    where maxValue = R.foldAll max 0.0 img

{-# INLINE magnitude #-}
magnitude x y = fromRational $ toRational $ sqrt (x * x + y * y)

{-# NOINLINE toGreyScale #-}
toGreyScale = withManifest $ \arr ->
    force2 $ traverse arr (\(sh :. _) -> sh)
                 (\get ix -> rgbToLuma (get (ix :. 0)) (get (ix :. 1)) (get (ix :. 2)))

{-# INLINE rgbToLuma #-}
rgbToLuma r g b = (fromIntegral r * 0.3) + (fromIntegral g * 0.59) + (fromIntegral b * 0.11)

type Image = Array DIM2 Float

robertsX :: Image -> Image
{-# NOINLINE robertsX #-}
robertsX img = deepSeqArray img $ (force2 $ mapStencil2 BoundClamp stencilX img)
    where stencilX = [stencil2|	1  0
                                0 -1 |]
robertsY :: Image -> Image
{-# NOINLINE robertsY #-}
robertsY img = deepSeqArray img $ (force2 $ mapStencil2 BoundClamp stencilY img)
    where stencilY = [stencil2| 0  1
                               -1  0 |]