diff --git a/Data/Conduit/ImageSize.hs b/Data/Conduit/ImageSize.hs --- a/Data/Conduit/ImageSize.hs +++ b/Data/Conduit/ImageSize.hs @@ -1,11 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DeriveDataTypeable #-} +-- | Detect the image size without opening the image itself. module Data.Conduit.ImageSize - ( sinkImageSize - , Size (..) - , sinkImageInfo - , FileFormat (..) - ) where + ( Size (..) + , FileFormat (..) + , sinkImageInfo + , sinkImageSize + ) where import qualified Data.ByteString.Lazy as L import Data.Conduit @@ -13,90 +15,96 @@ import qualified Data.ByteString as S import Data.ByteString.Char8 () import Data.ByteString.Lazy.Char8 () +import qualified Data.Typeable as T import Control.Applicative ((<$>), (<*>)) + data Size = Size { width :: Int, height :: Int } - deriving (Show, Eq, Ord, Read) + deriving (Show, Eq, Ord, Read, T.Typeable) + data FileFormat = GIF | PNG | JPG - deriving (Show, Eq, Ord, Read, Enum) + deriving (Show, Eq, Ord, Read, Enum, T.Typeable) + -- | Specialized version of 'sinkImageInfo' that returns only the -- image size. sinkImageSize :: Monad m => Consumer S.ByteString m (Maybe Size) sinkImageSize = fmap (fmap fst) sinkImageInfo + -- | Find out the size of an image. Also returns the file format -- that parsed correctly. Note that this function does not -- verify that the file is indeed in the format that it returns, -- since it looks only at a small part of the header. sinkImageInfo :: Monad m => Consumer S.ByteString m (Maybe (Size, FileFormat)) -sinkImageInfo = - start id +sinkImageInfo = start id where start front = await >>= maybe (return Nothing) (pushHeader front) pushHeader front bs' - | S.length bs >= 11 && S.take 5 (S.drop 6 bs) == - S.pack [0x4A, 0x46, 0x49, 0x46, 0x00] = - leftover (S.drop 4 bs) >> jpg - | S.length bs >= 6 && S.take 6 bs `elem` gifs = - leftover (S.drop 6 bs) >> gif - | S.length bs >= 8 && S.take 8 bs == S.pack [137, 80, 78, 71, 13, 10, 26, 10] = - leftover (S.drop 8 bs) >> png - | S.length bs < 11 = start $ S.append bs - | otherwise = leftover bs >> return Nothing + | S.length bs >= 11 && S.take 3 bs == S.pack [0xFF, 0xD8, 0xFF] = + leftover (S.drop 4 bs) >> jpg + | S.length bs >= 6 && S.take 6 bs `elem` gifs = + leftover (S.drop 6 bs) >> gif + | S.length bs >= 8 && S.take 8 bs == S.pack [137, 80, 78, 71, 13, 10, 26, 10] = + leftover (S.drop 8 bs) >> png + | S.length bs < 11 = start $ S.append bs + | otherwise = leftover bs >> return Nothing where - bs = front bs' + bs = front bs' gifs = ["GIF87a", "GIF89a"] gif = do - b <- CB.take 4 - let go x y = fromIntegral x + (fromIntegral y) * 256 - return $ case L.unpack b of - [w1, w2, h1, h2] -> Just (Size (go w1 w2) (go h1 h2), GIF) - _ -> Nothing + b <- CB.take 4 + let go x y = fromIntegral x + (fromIntegral y) * 256 + return $ case L.unpack b of + [w1, w2, h1, h2] -> Just (Size (go w1 w2) (go h1 h2), GIF) + _ -> Nothing png = do - _ <- CB.take 4 -- FIXME drop - hdr <- CB.take 4 - if hdr == "IHDR" - then do - mw <- getInt 4 0 - mh <- getInt 4 0 - return $ (\w h -> (Size w h, PNG)) <$> mw <*> mh - else return Nothing + CB.drop 4 + hdr <- CB.take 4 + if hdr == "IHDR" + then do + mw <- getInt 4 0 + mh <- getInt 4 0 + return $ (\w h -> (Size w h, PNG)) <$> mw <*> mh + else return Nothing jpg = do - mi <- getInt 2 0 - case mi of - Nothing -> return Nothing - Just i -> do - _ <- CB.take $ i - 2 - jpgFrame + mi <- getInt 2 0 + case mi of + Nothing -> return (Just (Size 1 1, JPG)) + Just i -> do + CB.drop $ i - 2 + jpgFrame + jpgSofMarkerBytes = [0xC0, 0xC1, 0xC2, 0xC3, 0xC5, 0xC6, 0xC7, + 0xC9, 0xCA, 0xCB, 0xCD, 0xCE, 0xCF] + jpgFrame = do - mx <- CB.head - case mx of - Just 255 -> do - my <- CB.head - case my of - Just 0xC0 -> do - _ <- CB.take 3 - mh <- getInt 2 0 - mw <- getInt 2 0 - return $ (\w h -> (Size w h, JPG)) <$> mw <*> mh - Just _ -> jpg - Nothing -> return Nothing - _ -> return Nothing + mx <- CB.head + case mx of + Just 0xFF -> do + my <- CB.head + case my of + Just b | b `elem` jpgSofMarkerBytes -> do + _ <- CB.take 3 + mh <- getInt 2 0 + mw <- getInt 2 0 + return $ (\w h -> (Size w h, JPG)) <$> mw <*> mh + Just _ -> jpg + Nothing -> return Nothing + _ -> return Nothing getInt :: (Monad m, Integral i) - => Int - -> i - -> Consumer S.ByteString m (Maybe i) + => Int + -> i + -> Consumer S.ByteString m (Maybe i) getInt 0 i = return $ Just i getInt len i = do - mx <- CB.head - case mx of - Nothing -> return Nothing - Just x -> getInt (len - 1) (i * 256 + fromIntegral x) + mx <- CB.head + case mx of + Nothing -> return Nothing + Just x -> getInt (len - 1) (i * 256 + fromIntegral x) diff --git a/imagesize-conduit.cabal b/imagesize-conduit.cabal --- a/imagesize-conduit.cabal +++ b/imagesize-conduit.cabal @@ -1,15 +1,15 @@ Name: imagesize-conduit -Version: 1.0.0.2 -Synopsis: Determine the size of some common image formats. (deprecated) +Version: 1.0.0.3 +Synopsis: Determine the size of some common image formats. Description: Currently supports PNG, GIF, and JPEG. This package provides a Sink that will consume the minimum number of bytes necessary to determine the image dimensions. License: BSD3 License-file: LICENSE Author: Michael Snoyman -Maintainer: michael@snoyman.com +Maintainer: Mikael Brockman , Felipe Lessa Category: Graphics, Conduit Build-type: Simple Cabal-version: >=1.8 -Homepage: http://github.com/snoyberg/conduit +Homepage: http://github.com/silkapp/imagesize-conduit extra-source-files: test/main.hs test/logo.png test/logo.gif @@ -18,8 +18,9 @@ Library Exposed-modules: Data.Conduit.ImageSize Build-depends: base >= 4 && < 5 - , conduit >= 1.0 && < 1.1 - , bytestring >= 0.9 + , conduit >= 1.1 && < 1.2 + , conduit-extra >= 1.1 && < 1.2 + , bytestring >= 0.10 ghc-options: -Wall test-suite test @@ -27,12 +28,14 @@ main-is: main.hs type: exitcode-stdio-1.0 build-depends: conduit + , conduit-extra + , resourcet , imagesize-conduit , base - , hspec >= 1.3 + , hspec >= 1.10 , bytestring ghc-options: -Wall source-repository head type: git - location: git://github.com/snoyberg/conduit.git + location: git://github.com/silkapp/imagesize-conduit.git diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB +import Control.Monad.Trans.Resource (runResourceT) import Data.Conduit.ImageSize import Test.Hspec @@ -8,12 +9,12 @@ main :: IO () main = hspec $ do describe "image size" $ do - it "png" $ check (Just $ Size 271 61) "test/logo.png" - it "jpg" $ check (Just $ Size 271 61) "test/logo.jpg" - it "gif" $ check (Just $ Size 271 61) "test/logo.gif" + it "png" $ check (Just (Size 271 61, PNG)) "test/logo.png" + it "jpg" $ check (Just (Size 271 61, JPG)) "test/logo.jpg" + it "gif" $ check (Just (Size 271 61, GIF)) "test/logo.gif" it "invalid" $ check Nothing "test/main.hs" -check :: Maybe Size -> FilePath -> Expectation +check :: Maybe (Size, FileFormat) -> FilePath -> Expectation check ex fp = do - size <- C.runResourceT $ CB.sourceFile fp C.$$ sinkImageSize + size <- runResourceT $ CB.sourceFile fp C.$$ sinkImageInfo size `shouldBe` ex