From 0fbbadb9794e2a0b376d1650c349eb09882d8aed Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 19 Oct 2016 14:14:42 +0200 Subject: [PATCH] starting out Generalizing some functions and start of implementation to move media between albums. --- Handler/AdminMediumSettings.hs | 43 ++++++++++----------- Handler/Commons.hs | 59 +++++++++++++++++++++++++++++ Handler/MediumSettings.hs | 68 +++++++++++++++++++++++++++------- Handler/Upload.hs | 21 ++++++----- 4 files changed, 147 insertions(+), 44 deletions(-) diff --git a/Handler/AdminMediumSettings.hs b/Handler/AdminMediumSettings.hs index 63529ae..4db439d 100755 --- a/Handler/AdminMediumSettings.hs +++ b/Handler/AdminMediumSettings.hs @@ -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 diff --git a/Handler/Commons.hs b/Handler/Commons.hs index 30f218f..3d352b2 100755 --- a/Handler/Commons.hs +++ b/Handler/Commons.hs @@ -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] diff --git a/Handler/MediumSettings.hs b/Handler/MediumSettings.hs index 12ee17e..02e8b2c 100755 --- a/Handler/MediumSettings.hs +++ b/Handler/MediumSettings.hs @@ -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 diff --git a/Handler/Upload.hs b/Handler/Upload.hs index 3d933bb..369c0b3 100755 --- a/Handler/Upload.hs +++ b/Handler/Upload.hs @@ -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)