nek0/eidolon
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

version bump: added preview images for large images

Browse source
This commit is contained in:
nek0 2015-09-28 00:40:05 +02:00
parent 461c93aa28
commit 6e7f3f9c1a
10 changed files with 129 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Handler/AdminMediumSettings.hs
View file

@ -96,6 +96,8 @@ adminMediumSetForm medium = renderDivs $ Medium
<*> pure (mediumWidth medium)
<*> pure (mediumThumbWidth medium)
<*> pure (mediumAlbum medium)
<*> pure (mediumPreview medium)
<*> pure (mediumPreviewWidth medium)
getAdminMediumDeleteR :: MediumId -> Handler Html
getAdminMediumDeleteR mediumId = do

3
Handler/Medium.hs
View file

@ -60,7 +60,8 @@ getMediumR mediumId = do
[ Desc CommentTime ]
let dataWidth = if mediumWidth medium >= 850 then 850 else mediumWidth medium
let tr = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumThumb medium) []
let pr = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []
let pr = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPreview medium) []
let ir = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []
formLayout $ do
setTitle $ toHtml ("Eidolon :: Medium " `T.append` (mediumTitle medium))
rssLink (CommentFeedRssR mediumId) $ "Comment feed of medium " `T.append` mediumTitle medium

2
Handler/MediumSettings.hs
View file

@ -71,6 +71,8 @@ mediumSettingsForm medium = renderDivs $ Medium
<*> pure (mediumWidth medium)
<*> pure (mediumThumbWidth medium)
<*> pure (mediumAlbum medium)
<*> pure (mediumPreview medium)
<*> pure (mediumPreviewWidth medium)
getMediumDeleteR :: MediumId -> Handler Html
getMediumDeleteR mediumId = do

27
Handler/Upload.hs
View file

@ -80,12 +80,12 @@ postDirectUploadR albumId = do
mime `elem` acceptedTypes
then do
path <- writeOnDrive file ownerId albumId
(thumbPath, iWidth, tWidth) <- generateThumb path ownerId albumId
(thumbPath, prevPath, iWidth, tWidth, pWidth) <- generateThumb path ownerId albumId
tempName <- if
length indFils == 1
then return $ fileBulkPrefix temp
else return (fileBulkPrefix temp `T.append` " " `T.append` T.pack (show (index :: Int)) `T.append` " of " `T.append` T.pack (show (length indFils)))
let medium = Medium tempName ('/' : path) ('/' : thumbPath) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) iWidth tWidth albumId
let medium = Medium tempName ('/' : path) ('/' : thumbPath) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) iWidth tWidth albumId ('/' : prevPath) pWidth
mId <- runDB $ I.insert medium
inALbum <- runDB $ getJust albumId
let newMediaList = mId : albumContent inALbum
@ -118,24 +118,35 @@ postDirectUploadR albumId = do
setMessage "This Album does not exist"
redirect $ AlbumR albumId
generateThumb :: FP.FilePath -> UserId -> AlbumId -> Handler (FP.FilePath, Int, Int)
generateThumb :: FP.FilePath -> UserId -> AlbumId -> Handler (FP.FilePath, FP.FilePath, Int, Int, Int)
generateThumb path userId albumId = do
let newName = FP.takeBaseName path ++ "_thumb.jpg"
let newPath = "static" FP.</> "data" FP.</> T.unpack (extractKey userId) FP.</> T.unpack (extractKey albumId) FP.</> newName
(iWidth, tWidth) <- liftIO $ withMagickWandGenesis $ do
let prevName = FP.takeBaseName path ++ "_preview.jpg"
let prevPath = "static" FP.</> "data" FP.</> T.unpack (extractKey userId) FP.</> T.unpack (extractKey albumId) FP.</> prevName
(iWidth, tWidth, pWidth) <- liftIO $ withMagickWandGenesis $ do
(_, w) <- magickWand
(_, p) <- magickWand
readImage w (decodeString path)
readImage p (decodeString path)
w1 <- getImageWidth w
h1 <- getImageHeight w
let h2 = 230
let w2 = floor (fromIntegral w1 / fromIntegral h1 * fromIntegral h2 :: Double)
let h3 = h1 `div` 2
let w3 = w1 `div` 2
setImageAlphaChannel w deactivateAlphaChannel
setImageAlphaChannel p deactivateAlphaChannel
setImageFormat w "jpeg"
setImageFormat p "jpeg"
resizeImage w w2 h2 lanczosFilter 1
resizeImage p w3 h3 lanczosFilter 1
setImageCompressionQuality w 95
setImageCompressionQuality p 95
writeImage w (Just (decodeString newPath))
return (w1, w2)
return (newPath, iWidth, tWidth)
writeImage p (Just (decodeString prevPath))
return (w1, w2, w3)
return (newPath, prevPath, iWidth, tWidth, pWidth)
writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FP.FilePath
writeOnDrive fil userId albumId = do
@ -230,12 +241,12 @@ postUploadR = do
albRef <- runDB $ getJust inAlbumId
let ownerId = albumOwner albRef
path <- writeOnDrive file ownerId inAlbumId
(thumbPath, iWidth, tWidth) <- generateThumb path ownerId inAlbumId
(thumbPath, prevPath, iWidth, tWidth, pWidth) <- generateThumb path ownerId inAlbumId
tempName <- if
length indFils == 1
then return $ fileBulkPrefix temp
else return (fileBulkPrefix temp `T.append` " " `T.append` T.pack (show (index :: Int)) `T.append` " of " `T.append` T.pack (show (length indFils)))
let medium = Medium tempName ('/' : path) ('/' : thumbPath) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) iWidth tWidth inAlbumId
let medium = Medium tempName ('/' : path) ('/' : thumbPath) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) iWidth tWidth inAlbumId ('/' : prevPath) pWidth
mId <- runDB $ I.insert medium
inALbum <- runDB $ getJust inAlbumId
let newMediaList = mId : albumContent inALbum

71
Migrations/0.0.3-0.0.4/Migration.hs Normal file
View file

@ -0,0 +1,71 @@
import Database.HDBC
import Database.HDBC.PostgreSQL
import System.IO
import Control.Exception
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import System.FilePath as FP
import Filesystem.Path.CurrentOS
import Graphics.ImageMagick.MagickWand
main :: IO ()
main = do
putStrLn "Enter database host"
dbHost <- getLine
putStrLn "Enter database port"
dbPort <- getLine
putStrLn "Enter database user"
dbUser <- getLine
putStrLn "Enter database name"
dbName <- getLine
putStrLn "Enter database password"
dbPasswd <- getPasswd
let dbString = "host=" ++ dbHost ++ " port=" ++ dbPort ++ " user=" ++ dbUser ++ " dbname=" ++ dbName ++ " password=" ++ dbPasswd
conn <- connectPostgreSQL dbString
-- Uncomment next two lines, if eidolon has been run after the update
_ <- run conn "alter table medium add column preview varchar not null default 'fill_me!'" []
_ <- run conn "alter table medium add column preview_width int8 not null default 0" []
stmt1 <- prepare conn "select * from medium"
_ <- execute stmt1 []
rows <- fetchAllRowsAL stmt1
-- mapM_ (putStrLn . show) rows
tups <- sequence $ map (\entry ->
case entry of
[("id", theId), _, ("path", SqlByteString path), _, _, _, ("owner", SqlInteger owner), _, _, _, _, ("album", SqlInteger album), _, _] -> do
let newName = takeBaseName (B.unpack path) ++ "_thumb.jpg"
let newPath = "static" FP.</> "data" FP.</> show owner FP.</> show album FP.</> newName
pWidth <- withMagickWandGenesis $ do
(_, w) <- magickWand
readImage w (decodeString $ tail $ B.unpack path)
w1 <- getImageWidth w
h1 <- getImageHeight w
let w2 = w1 `div` 2
let h2 = h1 `div` 2
setImageAlphaChannel w deactivateAlphaChannel
setImageFormat w (T.pack "jpeg")
resizeImage w w2 h2 lanczosFilter 1
setImageCompressionQuality w 95
writeImage w (Just (decodeString newPath))
return w2
return [SqlByteString (B.pack newPath), SqlInteger (fromIntegral pWidth), theId]
_ ->
error "malformed entry"
) rows
stmt2 <- prepare conn "update medium set preview = ?, preview_width = ? where id = ?"
executeMany stmt2 tups
commit conn
disconnect conn
putStrLn "Migration successfull!!"
getPasswd :: IO String
getPasswd = do
putStr "Password: "
hFlush stdout
pass <- withEcho False getLine
putChar '\n'
return pass
withEcho :: Bool -> IO a -> IO a
withEcho echo action = do
old <- hGetEcho stdin
bracket_ (hSetEcho stdin echo) (hSetEcho stdin old) action

12
README.md
View file

@ -44,7 +44,7 @@ After installing all dependencies you can configure and build the software with
```bash
cabal configure
cabal build
cabal build exe:eidolon
```
##Deploying
@ -65,6 +65,16 @@ You can start the gallery now by running the executable. You need to provide a s
Since eidolon will block your console, I recommend wrapping a init-script around it. how you can do that is written in my [blog](http://nek0.eu/posts/2014-10-23-Daemonize-a-yesod-app.html).
##Migrations
###0.0.3-0.0.4
* do not start or restart your eidolon service before migration
* build the Migration script with `cabal build Migration1`
* Migration script is located in `dist/build/Migration1/` in your build directory
* run migration script from your run location (where your `static` folder with all the images are located)
* start or restart your eidolon service
##Acknowledgements:
* This software uses the web Framework "Yesod" by Michael Snoyman. See more at: <http://www.yesodweb.com/>

2
config/models
View file

@ -53,6 +53,8 @@ Medium
width Int
thumbWidth Int
album AlbumId
preview FP.FilePath
previewWidth Int
deriving Eq Show
Comment
author UserId

18
eidolon.cabal
View file

@ -1,5 +1,5 @@
name: eidolon
version: 0.0.3
version: 0.0.4
synopsis: Image gallery in Yesod
homepage: https://eidolon.nek0.eu
license: AGPL-3
@ -116,7 +116,7 @@ library
executable eidolon
if flag(library-only)
Buildable: False
Buildable: True
main-is: main.hs
hs-source-dirs: app
@ -126,6 +126,20 @@ executable eidolon
ghc-options: -threaded -O2
executable Migrate1
main-is: Migration.hs
hs-source-dirs: Migrations/0.0.3-0.0.4
ghc-options: -Wall
build-depends: base
, HDBC
, HDBC-postgresql
, imagemagick
, text
, filepath
, system-filepath
, bytestring
test-suite test
type: exitcode-stdio-1.0
main-is: main.hs

2
static/css/style-global.css
View file

@ -207,7 +207,7 @@
{
position: relative !important;
max-width: 100%;
max-height: auto !important;
/*max-height: auto !important;*/
/*width: auto !important;*/
display: block;
margin-left: auto;

3
templates/medium.hamlet
View file

@ -6,7 +6,8 @@
by <a href=@{UserR ownerName}>#{ownerName}</a> from album <a href=@{AlbumR albumId}>#{albumTitle album}</a>
<div id="header" class="item image" data-width=#{dataWidth}>
<div class="inner">
<img sizes="(min-width: 40em) 80vw, 100vw" srcset="@{tr} 1x, @{pr} 2x" title=#{mediumTitle medium}>
<a href=@{ir}>
<img sizes="(min-width: 40em) 80vw, 100vw" srcset="@{tr} 1x, @{pr} 2x, @{ir} 3x" title=#{mediumTitle medium}>
<div id="header" class="item" data-width="400">
<div class="inner">