diff --git a/Handler/Upload.hs b/Handler/Upload.hs index 09fde1d..8d8ff40 100644 --- a/Handler/Upload.hs +++ b/Handler/Upload.hs @@ -3,9 +3,11 @@ module Handler.Upload where import Import as I import Data.Time import qualified Data.Text as T -import System.FilePath -import Graphics.Transform.Magick.Images -import Graphics.Transform.Magick.Types +import qualified System.FilePath as FP +import qualified Filesystem.Path as FSP +import Filesystem.Path.CurrentOS +import Graphics.ImageMagick.MagickWand +import Control.Monad.Trans.Resource import Foreign import Foreign.C.Types import Foreign.C.String @@ -145,42 +147,33 @@ postDirectUploadR albumId = do setMessage "This Album does not exist" redirect $ AlbumR albumId -generateThumb :: FilePath -> UserId -> AlbumId -> Handler FilePath +generateThumb :: FP.FilePath -> UserId -> AlbumId -> Handler FP.FilePath generateThumb path userId albumId = do - liftIO $ initializeMagick - image <- liftIO $ readImage path - case image of - HImage imag _ -> do - h1 <- liftIO $ withForeignPtr imag (\a -> do - himage <- peek a - r <- return $ rows himage - case r of CULong ro -> return ro - ) - w1 <- liftIO $ withForeignPtr imag (\a -> do - himage <- peek a - c <- return $ columns himage - case c of CULong co -> return co - ) - h2 <- return $ 220 - w2 <- return $ (h1 `div` w1) * h2 - error $ show w2 - thumb <- return $ thumbnailImage (fromIntegral w2) (fromIntegral h2) image - newName <- return $ (takeBaseName path) ++ "_thumb" ++ (takeExtension path) - newPath <- return $ "static" "data" - (T.unpack $ extractKey userId) - (T.unpack $ extractKey albumId) - newName - _ <- liftIO $ writeImage newPath thumb - return newPath + newName <- return $ (FP.takeBaseName path) ++ "_thumb" ++ (FP.takeExtension path) + newPath <- return $ "static" FP. "data" + FP. (T.unpack $ extractKey userId) + FP. (T.unpack $ extractKey albumId) + FP. newName + liftIO $ withMagickWandGenesis $ do + (_ , w) <- magickWand + readImage w (decodeString path) + w1 <- getImageWidth w + h1 <- getImageHeight w + h2 <- return 220 + w2 <- return $ floor (((fromIntegral w1) / (fromIntegral h1)) * (fromIntegral h2)) + resizeImage w w2 h2 lanczosFilter 1 + setImageCompressionQuality w 95 + writeImage w (Just (decodeString newPath)) + return newPath -writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FilePath -writeOnDrive file userId albumId = do - filen <- return $ fileName file - path <- return $ "static" "data" - (T.unpack $ extractKey userId) - (T.unpack $ extractKey albumId) - (T.unpack filen) - liftIO $ fileMove file path +writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FP.FilePath +writeOnDrive fil userId albumId = do + filen <- return $ fileName fil + path <- return $ "static" FP. "data" + FP. (T.unpack $ extractKey userId) + FP. (T.unpack $ extractKey albumId) + FP. (T.unpack filen) + liftIO $ fileMove fil path return path uploadForm :: UserId -> Form TempMedium diff --git a/eidolon.cabal b/eidolon.cabal index 894e571..8c34cf4 100644 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -91,6 +91,7 @@ library , mime-mail , blaze-html , filepath + , system-filepath , time , yesod-persistent , transformers @@ -98,7 +99,8 @@ library , cereal , cryptohash-cryptoapi , crypto-api - , hsmagick + , imagemagick + , resourcet executable eidolon if flag(library-only) diff --git a/templates/album.cassius b/templates/album.cassius index 9e6d67f..125379d 100644 --- a/templates/album.cassius +++ b/templates/album.cassius @@ -3,10 +3,6 @@ border-radius: 6px box-shadow: 0 0 3px #c4c4c4 -.thumbnail img - width: 250px - margin: 0 - ul list-style-type: none diff --git a/templates/home.cassius b/templates/home.cassius index ff8de9a..125379d 100644 --- a/templates/home.cassius +++ b/templates/home.cassius @@ -3,9 +3,6 @@ border-radius: 6px box-shadow: 0 0 3px #c4c4c4 -.thumbnail img - width: 250px - ul list-style-type: none diff --git a/templates/profile.cassius b/templates/profile.cassius index ff8de9a..125379d 100644 --- a/templates/profile.cassius +++ b/templates/profile.cassius @@ -3,9 +3,6 @@ border-radius: 6px box-shadow: 0 0 3px #c4c4c4 -.thumbnail img - width: 250px - ul list-style-type: none diff --git a/templates/tagMedia.cassius b/templates/tagMedia.cassius index 695c565..c0ac854 100644 --- a/templates/tagMedia.cassius +++ b/templates/tagMedia.cassius @@ -3,9 +3,6 @@ border-radius: 6px box-shadow: 0 0 3px #c4c4c4 -.thumbnail img - width: 250px - ul list-style: none