hlint cleanup

Makefile

@@ -29,7 +29,9 @@ test:
 	dist\build\imageTest\imageTest.exe debug
 
 lint:
-	hlint Codec
+	hlint lint src \
+		--cpp-define=MIN_VERSION_transformers=1 \
+		--cpp-define=MIN_VERSION_binary=1
 
 sdist: docimages/pixelgraph.svg
 	runhaskell Setup.hs sdist

changelog

@@ -1,9 +1,10 @@
 -*-change-log-*-
 
-v3.1.8 2014
+v3.2 2014
  * Adding TGA reading.
  * Adding TGA writing.
  * Packeable pixel unpack.
+ * Returning gif with transparency (breaking Codec.Picture.Gif interface)
 
 v3.1.7.1 August 2014
  * Previous gif fix was not working withing the readImage

src/Codec/Picture.hs

@@ -204,7 +204,7 @@ writeColorReducedGifImage path img =
 -- All the images of the animation are separated
 -- by the same delay.
 encodeGifAnimation :: GifDelay -> GifLooping
-                   -> [Image PixelRGB8] -> Either String (L.ByteString)
+                   -> [Image PixelRGB8] -> Either String L.ByteString
 encodeGifAnimation delay looping lst =
     encodeGifImages looping
         [(pal, delay, img)

src/Codec/Picture/BitWriter.hs

@@ -111,7 +111,7 @@ getNextBitMSB = do
 
 {-# INLINE getNextBitsMSBFirst #-}
 getNextBitsMSBFirst :: Int -> BoolReader s Word32
-getNextBitsMSBFirst count = aux 0 count
+getNextBitsMSBFirst = aux 0
   where aux acc 0 = return acc
         aux acc n = do
             bit <- getNextBitMSB
@@ -274,7 +274,7 @@ writeBitsGif st d c = do
     currWord <- readSTRef $ bwsBitAcc st
     currCount <- readSTRef $  bwsBitReaded st
     serialize d c currWord currCount
-  where dumpByte    i = pushByte' st i
+  where dumpByte = pushByte' st
 
         serialize bitData bitCount currentWord count
             | bitCount + count == 8 = do

src/Codec/Picture/Bitmap.hs

@@ -174,7 +174,7 @@ instance BmpEncodable Pixel8 where
                   let lineIdx = line * w
                       inner col | col >= w = return ()
                       inner col = do
-                          let v = (arr `VS.unsafeIndex` (lineIdx + col))
+                          let v = arr `VS.unsafeIndex` (lineIdx + col)
                           (buff `M.unsafeWrite` col) v
                           inner (col + 1)
 
@@ -226,9 +226,9 @@ instance BmpEncodable PixelRGB8 where
               let initialIndex = line * w * 3
                   inner col _ _ | col >= w = return ()
                   inner col writeIdx readIdx = do
-                      let r = (arr `VS.unsafeIndex` readIdx)
-                          g = (arr `VS.unsafeIndex` (readIdx + 1))
-                          b = (arr `VS.unsafeIndex` (readIdx + 2))
+                      let r = arr `VS.unsafeIndex` readIdx
+                          g = arr `VS.unsafeIndex` (readIdx + 1)
+                          b = arr `VS.unsafeIndex` (readIdx + 2)
 
                       (buff `M.unsafeWrite` writeIdx) b
                       (buff `M.unsafeWrite` (writeIdx + 1)) g
@@ -270,17 +270,17 @@ decodeImageY8 (BmpInfoHeader { width = w, height = h }) str = Image wi hi stArra
   where wi = fromIntegral w
         hi = fromIntegral h
         stArray = runST $ do
-            arr <- M.new (fromIntegral $ w * h * 1)
+            arr <- M.new . fromIntegral $ w * h
             forM_ [hi - 1, hi - 2 .. 0] (readLine arr)
             VS.unsafeFreeze arr
 
         stride = linePadding 8 wi
 
         readLine :: forall s. M.MVector s Word8 -> Int -> ST s ()
         readLine arr line =
-            let readIndex = (wi * 1 + stride) * line
-                lastIndex = wi * (hi - 1 - line + 1) * 1
-                writeIndex = wi * (hi - 1 - line) * 1
+            let readIndex = (wi + stride) * line
+                lastIndex = wi * (hi - 1 - line + 1)
+                writeIndex = wi * (hi - 1 - line)
 
                 inner _ writeIdx | writeIdx >= lastIndex = return ()
                 inner readIdx writeIdx = do

src/Codec/Picture/ColorQuant.hs

@@ -211,7 +211,7 @@ instance Applicative (Fold a) where
     (Fold stepL beginL doneL) <*> (Fold stepR beginR doneR) =
         let step (Pair xL xR) a = Pair (stepL xL a) (stepR xR a)
             begin = Pair beginL beginR
-            done (Pair xL xR) = (doneL xL) (doneR xR)
+            done (Pair xL xR) = doneL xL $ doneR xR
         in  Fold step begin done
     {-# INLINABLE (<*>) #-}
 
@@ -321,9 +321,9 @@ subdivide cluster = (mkCluster px1, mkCluster px2)
     (PixelRGBF mr mg mb) = meanColor cluster
     (px1, px2) = VU.partition (cond . rgbIntUnpack) $ colors cluster
     cond = case maxAxis $ dims cluster of
-      RAxis -> (\(PixelRGB8 r _ _) -> fromIntegral r < mr)
-      GAxis -> (\(PixelRGB8 _ g _) -> fromIntegral g < mg)
-      BAxis -> (\(PixelRGB8 _ _ b) -> fromIntegral b < mb)
+      RAxis -> \(PixelRGB8 r _ _) -> fromIntegral r < mr
+      GAxis -> \(PixelRGB8 _ g _) -> fromIntegral g < mg
+      BAxis -> \(PixelRGB8 _ _ b) -> fromIntegral b < mb
 
 rgbIntPack :: PixelRGB8 -> PackedRGB
 rgbIntPack (PixelRGB8 r g b) =
@@ -337,7 +337,7 @@ rgbIntUnpack v = PixelRGB8 r g b
   where
     r = fromIntegral $ v `unsafeShiftR` (2 * 8)
     g = fromIntegral $ v `unsafeShiftR` 8
-    b = fromIntegral $ v
+    b = fromIntegral v
 
 initCluster :: Image PixelRGB8 -> Cluster
 initCluster img = mkCluster $ VU.generate ((w * h) `div` subSampling) packer
@@ -379,4 +379,4 @@ dist2Px (PixelRGB8 r1 g1 b1) (PixelRGB8 r2 g2 b2) = dr*dr + dg*dg + db*db
       , fromIntegral b1 - fromIntegral b2 )
 
 nearestColorIdx :: PixelRGB8 -> Vector PixelRGB8 -> Pixel8
-nearestColorIdx p ps  = fromIntegral $ V.minIndex (V.map (\px -> dist2Px px p) ps)
+nearestColorIdx p ps  = fromIntegral $ V.minIndex (V.map (`dist2Px` p) ps)

src/Codec/Picture/Gif.hs

@@ -21,7 +21,7 @@ module Codec.Picture.Gif ( -- * Reading
                          ) where
 
 import Control.Applicative( pure, (<$>), (<*>) )
-import Control.Monad( replicateM, replicateM_ )
+import Control.Monad( replicateM, replicateM_, unless )
 import Control.Monad.ST( runST )
 import Control.Monad.Trans.Class( lift )
 
@@ -327,9 +327,7 @@ data Block = BlockImage GifImage
 skipSubDataBlocks :: Get ()
 skipSubDataBlocks = do
   s <- fromIntegral <$> getWord8
-  if s == 0 then
-    return ()
-  else
+  unless (s == 0) $
     skip s >> skipSubDataBlocks
 
 parseGifBlocks :: Get [Block]
@@ -409,7 +407,7 @@ instance Binary ImageDescriptor where
 --------------------------------------------------
 getPalette :: Word8 -> Get Palette
 getPalette bitDepth = 
-    replicateM (size * 3) get >>= return . Image size 1 . V.fromList
+    Image size 1 . V.fromList <$> replicateM (size * 3) get
   where size = 2 ^ (fromIntegral bitDepth :: Int)
 
 putPalette :: Int -> Palette -> Put
@@ -432,7 +430,7 @@ instance Binary GifHeader where
     put v = do
       put $ gifVersion v
       let descr = gifScreenDescriptor v
-      put $ descr
+      put descr
       putPalette (fromIntegral $ colorTableSize descr) $ gifGlobalMap v
 
     get = do
@@ -443,7 +441,7 @@ instance Binary GifHeader where
           if hasGlobalMap screenDesc then
             getPalette $ colorTableSize screenDesc
           else
-            return $ greyPalette
+            return greyPalette
 
         return GifHeader
             { gifVersion = version
@@ -602,7 +600,7 @@ decodeAllGifImages GifFile { gifHeader = GifHeader { gifGlobalMap = palette
       globalHeight = fromIntegral $ screenHeight wholeDescriptor
 
 gifAnimationApplyer :: forall px.
-                      (Pixel px, ColorConvertible PixelRGB8 px)
+                       (Pixel px, ColorConvertible PixelRGB8 px)
                     => (Int, Int) -> Image px -> Image px
                     -> (Image px, Maybe GraphicControlExtension, Image px)
                     -> (Maybe GraphicControlExtension, GifImage)
@@ -662,6 +660,8 @@ decodeFirstGifImage _ = Left "No image in gif file"
 --
 --  * PixelRGB8
 --
+--  * PixelRGBA8
+--
 decodeGif :: B.ByteString -> Either String DynamicImage
 decodeGif img = decode img >>= decodeFirstGifImage
 
@@ -756,7 +756,7 @@ encodeGifImages looping imageList@((firstPalette, _,firstImage):_) = Right $ enc
     toSerialize = [(controlExtension delay, GifImage
         { imgDescriptor = imageDescriptor lzwKeySize (paletteEqual palette) img
         , imgLocalPalette = Just palette
-        , imgLzwRootSize = fromIntegral $ lzwKeySize
+        , imgLzwRootSize = fromIntegral lzwKeySize
         , imgData = B.concat . L.toChunks . lzwEncode lzwKeySize $ imageData img
         }) | (palette, delay, img) <- imageList
            , let lzwKeySize = computeMinimumLzwKeySize palette

src/Codec/Picture/Gif/LZW.hs

@@ -2,7 +2,7 @@ module Codec.Picture.Gif.LZW( decodeLzw, decodeLzwTiff ) where
 
 import Data.Word( Word8 )
 import Control.Applicative( (<$>) )
-import Control.Monad( when )
+import Control.Monad( when, unless )
 
 import Data.Bits( (.&.) )
 
@@ -122,9 +122,7 @@ lzw variant nMaxBitKeySize initialKeySize initialWriteIdx outVec = do
           | code == endOfInfo = return ()
           | code == clearCode = do
               toOutput <- getNextCode startCodeSize
-              if toOutput == endOfInfo then
-                return ()
-              else do
+              unless (toOutput == endOfInfo) $ do
                 dataSize <- writeString outWriteIdx toOutput
                 getNextCode startCodeSize >>=
                   loop (outWriteIdx + dataSize)

src/Codec/Picture/HDR.hs

@@ -15,7 +15,7 @@ import Data.Char( ord, chr, isDigit )
 import Data.Word( Word8 )
 import Data.Monoid( (<>) )
 import Control.Applicative( pure, (<$>), (<*>) )
-import Control.Monad( when, foldM, foldM_, forM, forM_ )
+import Control.Monad( when, foldM, foldM_, forM, forM_, unless )
 import Control.Monad.Trans.Class( lift )
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
@@ -166,7 +166,7 @@ decodeInfos = do
 --  * PixelRGBF
 --
 decodeHDR :: B.ByteString -> Either String DynamicImage
-decodeHDR str = runST $ runExceptT $ do
+decodeHDR str = runST $ runExceptT $
     case runGet decodeHeader $ L.fromChunks [str] of
       Left err -> throwE err
       Right rez ->
@@ -187,11 +187,11 @@ decodeNum = do
     letter <- getChar8
     space <- getChar8
 
-    when (not $ isSign sign && isAxisLetter letter && space == ' ')
-         (fail "Invalid radiance size declaration")
+    unless (isSign sign && isAxisLetter letter && space == ' ')
+           (fail "Invalid radiance size declaration")
 
     let numDec acc c | isDigit c =
-            getChar8 >>= numDec (acc * 10 + ord c - (ord '0'))
+            getChar8 >>= numDec (acc * 10 + ord c - ord '0')
         numDec acc _
             | sign == '-' = pure $ negate acc
             | otherwise = pure acc
@@ -371,15 +371,15 @@ encodeScanlineColor vec outVec outIdx = do
             case val == prev of
                True -> runLength (n + 1) 0 prev (idx + 1) at
                False | n < 4 -> runLength 0 (n + 1) val (idx + 1) at
-               False -> do
+               False ->
                     pushRun n prev at >>=
                         runLength 1 0 val (idx + 1)
 
         runLength 0 n prev idx at = do
             val <- vec `M.unsafeRead` idx
             if val /= prev
                then runLength 0 (n + 1) val (idx + 1) at
-               else do
+               else
                 pushData (idx - 1) (n - 1) at >>=
                     runLength (2 :: Int) 0 val (idx + 1)
 
@@ -464,7 +464,7 @@ encodeRLENewStyleHDR pic = encode $ runST $ do
 
             (\v -> blitVector v 0 endIndex) <$> V.unsafeFreeze buff
 
-    pure $ RadianceHeader
+    pure RadianceHeader
         { radianceInfos = []
         , radianceFormat = FormatRGBE
         , radianceHeight = h
@@ -473,7 +473,7 @@ encodeRLENewStyleHDR pic = encode $ runST $ do
         }
 
 
-decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s (PixelRGBF))
+decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s PixelRGBF)
 decodeRadiancePicture hdr = do
     let width = abs $ radianceWidth hdr
         height = abs $ radianceHeight hdr

src/Codec/Picture/Jpg.hs

@@ -144,7 +144,7 @@ unpack444Ycbcr compIdx x y
             val7 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 7))
 
             (img `M.unsafeWrite` idx) val0
-            (img `M.unsafeWrite` (idx + (3 * 1))) val1
+            (img `M.unsafeWrite` (idx + (3    ))) val1
             (img `M.unsafeWrite` (idx + (3 * 2))) val2
             (img `M.unsafeWrite` (idx + (3 * 3))) val3
             (img `M.unsafeWrite` (idx + (3 * 4))) val4
@@ -189,8 +189,8 @@ unpack421Ycbcr compIdx x y
             (img `M.unsafeWrite` idx)       v0
             (img `M.unsafeWrite` (idx + 3)) v0
 
-            (img `M.unsafeWrite` (idx + 6 * 1))      v1
-            (img `M.unsafeWrite` (idx + 6 * 1 + 3))  v1
+            (img `M.unsafeWrite` (idx + 6    ))      v1
+            (img `M.unsafeWrite` (idx + 6     + 3))  v1
 
             (img `M.unsafeWrite` (idx + 6 * 2))      v2
             (img `M.unsafeWrite` (idx + 6 * 2 + 3))  v2
@@ -350,7 +350,7 @@ jpgMachineStep (JpgHuffmanTable tables) = mapM_ placeHuffmanTrees tables
               if idx >= V.length (dcDecoderTables s) then s
               else
                 let neu = dcDecoderTables s // [(idx, tree)] in 
-                s { dcDecoderTables = neu `seq` neu }
+                s { dcDecoderTables = neu }
                     where idx = fromIntegral $ huffmanTableDest spec
 
             AcComponent -> modify $ \s ->
@@ -412,7 +412,7 @@ decodeImage frame quants lst outImage = do
             acTree = acHuffmanTree comp
             quantId = fromIntegral .  quantizationTableDest
                     $ jpgComponents frame !! compIdx
-            qTable = quants V.! (min 3 quantId)
+            qTable = quants V.! min 3 quantId
             xd = blockMcuX comp
             yd = blockMcuY comp
             (subX, subY) = subSampling comp
@@ -730,8 +730,8 @@ encodeJpegAtQuality quality img@(Image { imageWidth = w, imageHeight = h }) = en
                                   let blockY = my * sizeY + subY
                                       blockX = mx * sizeX + subX
                                   prev_dc <- dc_table `M.unsafeRead` comp
-                                  (dc_coeff, neo_block) <- (extractor comp blockX blockY >>=
-                                                          encodeMacroBlock table workData zigzaged prev_dc)
+                                  (dc_coeff, neo_block) <- extractor comp blockX blockY >>=
+                                                          encodeMacroBlock table workData zigzaged prev_dc
                                   (dc_table `M.unsafeWrite` comp) $ fromIntegral dc_coeff
                                   serializeMacroBlock writeState dc ac neo_block
 

src/Codec/Picture/Png.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- | Module used for loading & writing \'Portable Network Graphics\' (PNG)
@@ -27,7 +26,7 @@ module Codec.Picture.Png( -- * High level functions
                         ) where
 
 import Control.Applicative( (<$>) )
-import Control.Monad( forM_, foldM_, when )
+import Control.Monad( forM_, foldM_, when, void )
 import Control.Monad.ST( ST, runST )
 import Data.Binary( Binary( get) )
 
@@ -151,7 +150,7 @@ pngFiltering unpacker beginZeroes (imgWidth, imgHeight) str initialIdx = do
                                                  b' = fromIntegral valB
                                                  average = fromIntegral ((a' + b') `div` (2 :: Word16)) 
                                                  writeVal = byte + average 
-                                             (thisLine `M.unsafeWrite` idx) $ writeVal
+                                             (thisLine `M.unsafeWrite` idx) writeVal
                                              inner (idx + 1) $ readIdx + 1
 
           filterPaeth !previousLine !thisLine = inner beginZeroes
@@ -297,7 +296,7 @@ shortUnpacker sampleCount (MutableImage{ mutableImageWidth = imgWidth, mutableIm
             lowBits <- line `M.unsafeRead` (srcPixelIndex + sample * 2 + 1)
             let fullValue = fromIntegral lowBits .|. (fromIntegral highBits `unsafeShiftL` 8)
                 writeIdx = destSampleIndex + sample
-            (arr `M.unsafeWrite` writeIdx) $ fullValue
+            (arr `M.unsafeWrite` writeIdx) fullValue
 
 -- | Transform a scanline to a bunch of bytes. Bytes are then packed
 -- into pixels at a further step.
@@ -317,7 +316,7 @@ scanLineInterleaving :: Int -> Int -> (Int, Int) -> (StrideInfo -> BeginOffset -
                      -> B.ByteString
                      -> ST s ()
 scanLineInterleaving depth sampleCount (imgWidth, imgHeight) unpacker str =
-    pngFiltering (unpacker (1,1) (0, 0)) strideInfo (byteWidth, imgHeight) str 0 >> return ()
+    void $ pngFiltering (unpacker (1,1) (0, 0)) strideInfo (byteWidth, imgHeight) str 0
         where byteWidth = byteSizeOfBitLength depth sampleCount imgWidth
               strideInfo | depth < 8 = 1
                          | otherwise = sampleCount * (depth `div` 8)
@@ -327,7 +326,7 @@ scanLineInterleaving depth sampleCount (imgWidth, imgHeight) unpacker str =
 adam7Unpack :: Int -> Int -> (Int, Int) -> (StrideInfo -> BeginOffset -> LineUnpacker s)
             -> B.ByteString -> ST s ()
 adam7Unpack depth sampleCount (imgWidth, imgHeight) unpacker str =
-  foldM_ (\i f -> f i) 0 subImages >> return ()
+  void $ foldM_ (\i f -> f i) 0 subImages
     where Adam7MatrixInfo { adam7StartingRow  = startRows
                           , adam7RowIncrement = rowIncrement
                           , adam7StartingCol  = startCols