eidolon/Handler/MediumSettings.hs

118 lines
4.2 KiB
Haskell
Raw Normal View History

2015-01-18 19:44:41 +00:00
-- eidolon -- A simple gallery in Haskell and Yesod
-- Copyright (C) 2015 Amedeo Molnár
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
2015-01-21 09:00:18 +00:00
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
2015-01-18 19:44:41 +00:00
2014-08-30 18:25:08 +00:00
module Handler.MediumSettings where
import Import
import Handler.Commons
2014-08-30 19:19:41 +00:00
import System.Directory
import System.FilePath
import qualified Data.Text as T
2014-08-30 19:19:41 +00:00
import Data.List (tail)
2014-08-30 18:25:08 +00:00
getMediumSettingsR :: MediumId -> Handler Html
getMediumSettingsR mediumId = do
checkRes <- mediumCheck mediumId
case checkRes of
Right medium -> do
(mediumSettingsWidget, enctype) <- generateFormPost $ mediumSettingsForm medium
2015-01-16 21:41:12 +00:00
formLayout $ do
setTitle "Eidolon :: Medium Settings"
$(widgetFile "mediumSettings")
Left (errorMsg, route) -> do
setMessage errorMsg
2015-09-14 16:54:46 +00:00
redirect route
2014-08-30 18:25:08 +00:00
postMediumSettingsR :: MediumId -> Handler Html
postMediumSettingsR mediumId = do
checkRes <- mediumCheck mediumId
case checkRes of
Right medium -> do
2014-12-28 06:12:25 +00:00
((result, _), _) <- runFormPost $ mediumSettingsForm medium
case result of
FormSuccess temp -> do
2014-12-28 06:12:25 +00:00
_ <- runDB $ update mediumId
[ MediumTitle =. mediumTitle temp
, MediumDescription =. mediumDescription temp
, MediumTags =. mediumTags temp
]
setMessage "Medium settings changed succesfully"
redirect $ MediumR mediumId
_ -> do
setMessage "There was an error changing the settings"
redirect $ MediumSettingsR mediumId
Left (errorMsg, route) -> do
setMessage errorMsg
2015-09-14 16:54:46 +00:00
redirect route
2014-08-30 18:25:08 +00:00
mediumSettingsForm :: Medium -> Form Medium
mediumSettingsForm medium = renderDivs $ Medium
<$> areq textField "Title" (Just $ mediumTitle medium)
<*> pure (mediumPath medium)
2014-10-01 22:58:36 +00:00
<*> pure (mediumThumb medium)
2014-12-14 19:21:23 +00:00
<*> pure (mediumMime medium)
2014-08-30 18:25:08 +00:00
<*> pure (mediumTime medium)
<*> pure (mediumOwner medium)
<*> aopt textareaField "Description" (Just $ mediumDescription medium)
2014-08-30 18:25:08 +00:00
<*> areq tagField "tags" (Just $ mediumTags medium)
<*> pure (mediumWidth medium)
<*> pure (mediumThumbWidth medium)
2014-08-30 18:25:08 +00:00
<*> pure (mediumAlbum medium)
<*> pure (mediumPreview medium)
<*> pure (mediumPreviewWidth medium)
2014-08-30 19:19:41 +00:00
getMediumDeleteR :: MediumId -> Handler Html
getMediumDeleteR mediumId = do
checkRes <- mediumCheck mediumId
case checkRes of
2015-09-14 16:54:46 +00:00
Right medium ->
2015-01-16 21:41:12 +00:00
formLayout $ do
setTitle "Eidolon :: Delete Medium"
$(widgetFile "mediumDelete")
Left (errorMsg, route) -> do
setMessage errorMsg
2015-09-14 16:54:46 +00:00
redirect route
2014-08-30 19:19:41 +00:00
postMediumDeleteR :: MediumId -> Handler Html
postMediumDeleteR mediumId = do
checkRes <- mediumCheck mediumId
case checkRes of
Right medium -> do
confirm <- lookupPostParam "confirm"
case confirm of
Just "confirm" -> do
-- delete comments
commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
2015-09-14 16:54:46 +00:00
_ <- mapM (runDB . delete . entityKey) commEnts
-- delete references first
2015-09-14 16:54:46 +00:00
let albumId = mediumAlbum medium
album <- runDB $ getJust albumId
2015-09-14 16:54:46 +00:00
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)
runDB $ delete mediumId
setMessage "Medium succesfully deleted"
2015-09-14 16:54:46 +00:00
redirect HomeR
_ -> do
setMessage "You must confirm the deletion"
redirect $ MediumSettingsR mediumId
Left (errorMsg, route) -> do
setMessage errorMsg
2015-09-14 16:54:46 +00:00
redirect route