never executed always true always false

    1 module HelVM.HelMA.Automata.Piet.Parser (
    2   processImage,
    3 ) where
    4 
    5 import           HelVM.HelMA.Automata.Piet.Types.Color
    6 import           HelVM.HelMA.Automata.Piet.Types.Image
    7 
    8 import qualified Codec.Picture                         as Picture
    9 
   10 import           Data.MonoTraversable
   11 
   12 processImage ::  Maybe Natural -> Picture.DynamicImage -> Image Color
   13 processImage codelInfo dynamicImage = imageFromJuicy actualCodelLength img where
   14   actualCodelLength = max 1 $ maybe defaultCodelInfo fromIntegral codelInfo
   15   defaultCodelInfo = imageGuessCodelLength img
   16   img = Picture.convertRGBA8 dynamicImage
   17 
   18 imageFromJuicy :: Int -> Picture.Image Picture.PixelRGBA8 -> Image Color
   19 imageFromJuicy codelLength img = newImage (width, height) pixels where
   20   width  = Picture.imageWidth img `div` codelLength
   21   height = Picture.imageHeight img `div` codelLength
   22 
   23   pixels = [ ((x, y), extractColor x y) | x <- [0 .. width-1], y <- [0 .. height-1] ]
   24 
   25   extractColor x y = checkAlpha (Picture.pixelAt img (x * codelLength) (y * codelLength))
   26   checkAlpha (Picture.PixelRGBA8 r g b _) = rgb2Color r g b
   27 
   28 imageGuessCodelLength :: Picture.Image Picture.PixelRGBA8 -> Int
   29 imageGuessCodelLength img = lastUntil isOne $ scanl gcd (gcd width height) $ fmap olength (group rows) <> fmap olength (group cols) where
   30   width  = Picture.imageWidth img
   31   height = Picture.imageHeight img
   32   isOne  = (== 1)
   33 
   34   rows = [ [ Picture.pixelAt img x y | x <- [0 .. width-1] ]  | y <- [0 .. height-1] ]
   35   cols = [ [ Picture.pixelAt img x y | y <- [0 .. height-1] ] | x <- [0 .. width-1] ]
   36 
   37   lastUntil _ [x]    = x
   38   lastUntil p (x:xs) = guardPred (p x) p x xs
   39   lastUntil _ _      = error "empty list in lastUntil helper (imageGuessCodelLength)"
   40 
   41   guardPred True  _  x _  = x
   42   guardPred False p' _ xs = lastUntil p' xs