module Codec.ImageType (
getFileType,
getFileTypes,
isJpeg,
isPng,
isGif,
isTiff,
isRgb,
isPbm,
isPgm,
isPpm,
isRast,
isXbm,
isBmp,
isWebp,
isExr,
testJpeg,
testPng,
testGif,
testTiff,
testRgb,
testPbm,
testPgm,
testPpm,
testRast,
testXbm,
testBmp,
testWebp,
testExr
) where
import Prelude hiding (length, head, take, drop)
import System.IO (withFile, IOMode(ReadMode))
import Data.ByteString (ByteString, length, hGet, head, take, drop, index, isPrefixOf)
import qualified Data.ByteString as BS
import Control.Monad (guard)
import Data.Maybe (isJust, catMaybes, listToMaybe)
import Control.Applicative ((<$>))
reading :: FilePath -> (ByteString -> r) -> IO r
reading file test = withFile file ReadMode $ \h -> do
bytes <- hGet h 32
return (length bytes `seq` test bytes)
testJpeg :: ByteString -> Maybe String
testJpeg bytes = [ "jpeg"
| take 4 (drop 6 bytes) `elem` ["JFIF", "Exif"]
]
isJpeg :: FilePath -> IO Bool
isJpeg file = isJust <$> reading file testJpeg
testPng :: ByteString -> Maybe String
testPng bytes = [ "png"
| isPrefixOf "\137PNG\r\n\26\n" bytes
]
isPng :: FilePath -> IO Bool
isPng file = isJust <$> reading file testPng
testGif :: ByteString -> Maybe String
testGif bytes = [ "gif"
| elem (take 6 bytes) ["GIF87a", "GIF89a"]
]
isGif :: FilePath -> IO Bool
isGif file = isJust <$> reading file testGif
testTiff :: ByteString -> Maybe String
testTiff bytes = [ "tiff"
| elem (take 2 bytes) ["MM", "II"]
]
isTiff :: FilePath -> IO Bool
isTiff file = isJust <$> reading file testTiff
testRgb :: ByteString -> Maybe String
testRgb bytes = [ "rgb"
| isPrefixOf "\001\218" bytes
]
isRgb :: FilePath -> IO Bool
isRgb file = isJust <$> reading file testRgb
testPbm :: ByteString -> Maybe String
testPbm bytes = [ "pbm"
| length bytes >= 3
, index bytes(0) == head "P"
, index bytes(1) `BS.elem` "14"
, index bytes(2) `BS.elem` " \t\n\r"
]
isPbm :: FilePath -> IO Bool
isPbm file = isJust <$> reading file testPbm
testPgm :: ByteString -> Maybe String
testPgm bytes = [ "pgm"
| length bytes >= 3
, index bytes(0) == head "P"
, index bytes(1) `BS.elem` "25"
, index bytes(2) `BS.elem` " \t\n\r"
]
isPgm :: FilePath -> IO Bool
isPgm file = isJust <$> reading file testPgm
testPpm :: ByteString -> Maybe String
testPpm bytes = [ "ppm"
| length bytes >= 3
, index bytes(0) == head "P"
, index bytes(1) `BS.elem` "36"
, index bytes(2) `BS.elem` " \t\n\r"
]
isPpm :: FilePath -> IO Bool
isPpm file = isJust <$> reading file testPpm
testRast :: ByteString -> Maybe String
testRast bytes = [ "rast"
| isPrefixOf "\x59\xA6\x6A\x95" bytes
]
isRast :: FilePath -> IO Bool
isRast file = isJust <$> reading file testRast
testXbm :: ByteString -> Maybe String
testXbm bytes = [ "xbm"
| isPrefixOf "#define " bytes
]
isXbm :: FilePath -> IO Bool
isXbm file = isJust <$> reading file testXbm
testBmp :: ByteString -> Maybe String
testBmp bytes = [ "bmp"
| isPrefixOf "BM" bytes
]
isBmp :: FilePath -> IO Bool
isBmp file = isJust <$> reading file testBmp
testWebp :: ByteString -> Maybe String
testWebp bytes = [ "webp"
| isPrefixOf "RIFF" bytes
, take 4 (drop 8 bytes) == "WEBP"
]
isWebp :: FilePath -> IO Bool
isWebp file = isJust <$> reading file testWebp
testExr :: ByteString -> Maybe String
testExr bytes = [ "exr"
| isPrefixOf "\x76\x2f\x31\x01" bytes
]
isExr :: FilePath -> IO Bool
isExr file = isJust <$> reading file testExr
tests :: [ByteString -> Maybe String]
tests = [testJpeg, testPng, testGif,
testTiff, testRgb, testPbm,
testPgm, testPpm, testRast,
testXbm, testBmp, testWebp,
testExr]
getFileType :: FilePath -> IO (Maybe String)
getFileType file = reading file $ \bytes -> do
listToMaybe $ catMaybes [ test bytes | test <- tests ]
getFileTypes :: FilePath -> IO [String]
getFileTypes file = reading file $ \bytes -> do
catMaybes [ test bytes | test <- tests ]