module Graphics.Thumbnail
       ( ImageFormat(..)
       , Thumbnail(..)
       , mkThumbnail) where

import Graphics.GD
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L

data ImageFormat = Gif | Jpeg | Png

data Thumbnail = Thumbnail { fmt :: ImageFormat
                           , img :: Image
                           , sz  :: Size
                           , lbs :: L.ByteString
                           }

mkThumbnail :: L.ByteString -> IO (Either String Thumbnail)
mkThumbnail = thumbnail . L.unpack
  where
    thumbnail ws@(0xff:0xd8:_) = thumbnailJpeg ws
    thumbnail ws@(0x89:0x50:_) = thumbnailPng ws
    thumbnail ws@(0x47:0x49:0x46:_) = thumbnailGif ws
    thumbnail _ = return $ Left "unsupported image format"
    
    thumbnailJpeg ws = do
      src <- loadJpegByteString $ BS.pack ws
      size <- imageSize src
      dest <- copyImage src
      let size' = newSize size
      thm <- uncurry resizeImage size' dest
      bs <- saveJpegByteString (-1) thm
      return $ Right Thumbnail { fmt=Jpeg
                               , img=thm
                               , sz=size'
                               , lbs=strictToLazy bs
                               }
    
    thumbnailPng ws = do
      src <- loadPngByteString $ BS.pack ws
      size <- imageSize src
      dest <- copyImage src
      let size' = newSize size
      thm <- uncurry resizeImage size' dest
      bs <- savePngByteString thm
      return $ Right Thumbnail { fmt=Png
                               , img=thm
                               , sz=size'
                               , lbs=strictToLazy bs
                               }
      
    thumbnailGif ws = do
      src <- loadGifByteString $ BS.pack ws
      size <- imageSize src
      dest <- copyImage src
      let size' = newSize size
      thm <- uncurry resizeImage size' dest
      bs <- saveGifByteString thm
      return $ Right Thumbnail { fmt=Gif
                               , img=thm
                               , sz=size'
                               , lbs=strictToLazy bs
                               }
        
    strictToLazy = L.pack . BS.unpack
    
newSize :: Size -> Size
newSize (w, h) | w >= h && wMax*h`div`w > wMin = (wMax, wMax*h`div`w)
               | w >= h && h >= hMin           = (hMin*w`div`h, hMin)
               | w <  h && hMax*w`div`h > hMin = (hMax*w`div`h, hMax)
               | w <  h && w >= wMin           = (wMin, wMin*h`div`w)
               | otherwise = (w, h)

wMax, wMin, hMax, hMin :: Int
(wMax, wMin) = (60, 20)
(hMax, hMin) = (60, 20)