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

starting out

Browse source 
Generalizing some functions and start of implementation to move media
between albums.
This commit is contained in:
nek0 2016-10-19 14:14:42 +02:00
parent e452639294
commit 0fbbadb979
4 changed files with 147 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
Handler/AdminMediumSettings.hs
View file

@ -109,28 +109,29 @@ getAdminMediumDeleteR mediumId = do
tempMedium <- runDB $ get mediumId
case tempMedium of
Just medium -> do
-- remove reference from album
let albumId = mediumAlbum medium
album <- runDB $ getJust albumId
let mediaList = albumContent album
let newMediaList = removeItem mediumId mediaList
runDB $ update albumId [AlbumContent =. newMediaList]
-- delete comments
commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
_ <- mapM (\ent -> do
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] []
_ <- mapM (\child -> do
-- delete comment children
runDB $ delete $ entityKey child
) children
runDB $ delete $ entityKey ent) commEnts
-- delete medium
runDB $ delete mediumId
-- delete files
liftIO $ removeFile (normalise $ tail $ mediumPath medium)
liftIO $ removeFile (normalise $ tail $ mediumThumb medium)
liftIO $ removeFile (normalise $ tail $ mediumPreview medium)
-- -- remove reference from album
-- let albumId = mediumAlbum medium
-- album <- runDB $ getJust albumId
-- let mediaList = albumContent album
-- let newMediaList = removeItem mediumId mediaList
-- runDB $ update albumId [AlbumContent =. newMediaList]
-- -- delete comments
-- commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
-- _ <- mapM (\ent -> do
-- children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] []
-- _ <- mapM (\child -> do
-- -- delete comment children
-- runDB $ delete $ entityKey child
-- ) children
-- runDB $ delete $ entityKey ent) commEnts
-- -- delete medium
-- runDB $ delete mediumId
-- -- delete files
-- liftIO $ removeFile (normalise $ tail $ mediumPath medium)
-- liftIO $ removeFile (normalise $ tail $ mediumThumb medium)
-- liftIO $ removeFile (normalise $ tail $ mediumPreview medium)
-- outro
deleteMedium mediumId medium
setMessage "Medium deleted successfully"
redirect AdminR
Nothing -> do

59
Handler/Commons.hs
View file

@ -17,7 +17,11 @@
module Handler.Commons where
import Import
import qualified Data.Text as T
import Data.String
import qualified Data.List as L
import System.FilePath as FP
import System.Directory
loginIsAdmin :: IsString t => Handler (Either (t, Route App) ())
loginIsAdmin = do
@ -78,3 +82,58 @@ mediumCheck mediumId = do
return $ Left ("You must be logged in to change settings", LoginR)
Nothing ->
return $ Left ("This medium does not exist", HomeR)
insertMedium :: Medium -> AlbumId -> Handler ()
insertMedium medium aId = do
mId <- runDB $ insert medium
inAlbum <- runDB $ getJust aId
let newMediaList = mId : albumContent inAlbum
runDB $ update aId [AlbumContent =. newMediaList]
deleteMedium :: MediumId -> Medium -> Handler ()
deleteMedium mId medium = do
commEnts <- runDB $ selectList [CommentOrigin ==. mId] []
-- delete comments first
mapM_ (runDB . delete . entityKey) commEnts
-- remove reference
removeReference mId $ mediumAlbum medium
-- delete Files
mapM_ (liftIO . removeFile . normalise . L.tail)
[ mediumPath medium
, mediumThumb medium
, mediumPreview medium
]
-- delete database entry
runDB $ delete mId
moveMedium :: Medium -> MediumId -> AlbumId -> Handler ()
moveMedium med mId destId = do
dest <- runDB $ getJust destId
-- remove reference
removeReference mId $ mediumAlbum med
-- move physical Files
let filen = show $ length (albumContent dest) + 1
ext = takeExtension $ mediumPath med
nPath = "static" </> "data" </> T.unpack (extractKey $ albumOwner dest) </> T.unpack (extractKey destId) </> filen ++ ext
nThumb = takeBaseName nPath ++ "_thumb.jpg"
nPrev = takeBaseName nPath ++ "_preview.jpg"
liftIO $ renameFile (mediumPath med) nPath
liftIO $ renameFile (mediumThumb med) nThumb
liftIO $ renameFile (mediumPreview med) nPrev
-- chenge filenames in database
runDB $ update mId
[ MediumPath =. '/' : nPath
, MediumThumb =. '/' : nThumb
, MediumPreview =. '/' : nPrev
]
-- create new references
let newMediaList = mId : albumContent dest
runDB $ update destId [AlbumContent =. newMediaList]
removeReference :: MediumId -> AlbumId -> Handler ()
removeReference mId aId = do
-- delete references next
album <- runDB $ getJust aId
let newMediaList = removeItem mId $ albumContent album
-- update reference list
runDB $ update aId [AlbumContent =. newMediaList]

68
Handler/MediumSettings.hs
View file

@ -96,20 +96,21 @@ postMediumDeleteR mediumId = do
confirm <- lookupPostParam "confirm"
case confirm of
Just "confirm" -> do
-- delete comments
commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
_ <- mapM (runDB . delete . entityKey) commEnts
-- delete references first
let albumId = mediumAlbum medium
album <- runDB $ getJust albumId
let mediaList = albumContent album
let newMediaList = removeItem mediumId mediaList
-- update reference List
runDB $ update albumId [AlbumContent =. newMediaList]
liftIO $ removeFile (normalise $ tail $ mediumPath medium)
liftIO $ removeFile (normalise $ tail $ mediumThumb medium)
liftIO $ removeFile (normalise $ tail $ mediumPreview medium)
runDB $ delete mediumId
-- -- delete comments
-- commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
-- _ <- mapM (runDB . delete . entityKey) commEnts
-- -- delete references first
-- let albumId = mediumAlbum medium
-- album <- runDB $ getJust albumId
-- let mediaList = albumContent album
-- let newMediaList = removeItem mediumId mediaList
-- -- update reference List
-- runDB $ update albumId [AlbumContent =. newMediaList]
-- liftIO $ removeFile (normalise $ tail $ mediumPath medium)
-- liftIO $ removeFile (normalise $ tail $ mediumThumb medium)
-- liftIO $ removeFile (normalise $ tail $ mediumPreview medium)
-- runDB $ delete mediumId
deleteMedium mediumId medium
setMessage "Medium succesfully deleted"
redirect HomeR
_ -> do
@ -118,3 +119,42 @@ postMediumDeleteR mediumId = do
Left (errorMsg, route) -> do
setMessage errorMsg
redirect route
getMediumMoveR :: MediumId -> Handler Html
getMediumMoveR mId = do
checkRes <- mediumCheck mId
case checkRes of
Right medium ->
(mediumSettingsWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
mediumMoveForm medium
Left (err, route) -> do
setMessage err
redirect route
postMediumMoveR :: MediumOd -> Handler Html
postMediumMoveR mId = do
checkRes <- mediumCheck mId
case checkres of
Right medium -> do
((res, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
mediumMoveForm medium
case res of
FormSuccess aId ->
moveMedium medium mId aId
mediumMoveForm :: Medium -> AForm Handler AlbumId
mediumMoveForm medium = id
<$> areq (selectField albums) (bfs ("Destination album" :: T.Text)) (mediumAlbum medium)
<* bootstrapSubmit ("Move medium" :: BootstrapSubmit Text)
where
albums = do
allEnts <- runDB $ selectList [] [Asc AlbumTitle]
let ents = catMaybes $ map (\ent ->
if uId == albumOwner (entityVal ent) || uId `elem` albumShares (entityVal nt)
then Just ent
else Nothing
) allEnts
optionsPairs $ map (\alb -> ((albumTitle $ entityVal alb), entityKey alb) ents
uId = mediumOwner medium

21
Handler/Upload.hs
View file

@ -17,6 +17,7 @@
module Handler.Upload where
import Import as I
import Handler.Commons
import Data.Time
import Data.Maybe
import qualified Data.Text as T
@ -89,10 +90,11 @@ postDirectUploadR albumId = do
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) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) albumId ('/' : metaPreviewPath meta)
mId <- runDB $ I.insert medium
inALbum <- runDB $ getJust albumId
let newMediaList = mId : albumContent inALbum
runDB $ update albumId [AlbumContent =. newMediaList]
-- mId <- runDB $ I.insert medium
-- inALbum <- runDB $ getJust albumId
-- let newMediaList = mId : albumContent inALbum
-- runDB $ update albumId [AlbumContent =. newMediaList]
insertMedium medium albumId
return Nothing
else do
liftIO $ removeFile (FP.normalise path)
@ -251,7 +253,7 @@ bulkUploadForm userId = (\a b c d e f g -> FileBulk b c d e f g a)
where
albums = do
allEnts <- runDB $ selectList [] [Desc AlbumTitle]
let entities = map fromJust $ removeItem Nothing $ map (\ent ->
let entities = catMaybes $ map (\ent ->
if
userId == albumOwner (entityVal ent) || userId `elem` albumShares (entityVal ent)
then Just ent
@ -294,10 +296,11 @@ postUploadR = do
" of " `T.append`
T.pack (show (length indFils)))
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) inAlbumId ('/' : metaPreviewPath meta)
mId <- runDB $ I.insert medium
inALbum <- runDB $ getJust inAlbumId
let newMediaList = mId : albumContent inALbum
runDB $ update inAlbumId [AlbumContent =. newMediaList]
-- mId <- runDB $ I.insert medium
-- inALbum <- runDB $ getJust inAlbumId
-- let newMediaList = mId : albumContent inALbum
-- runDB $ update inAlbumId [AlbumContent =. newMediaList]
insertMedium medium inAlbumId
return Nothing
else do
liftIO $ removeFile (FP.normalise path)