eidolon/Handler/MediumSettings.hs

147 lines
5.5 KiB
Haskell

module Handler.MediumSettings where
import Import
import System.Directory
import System.FilePath
import Data.List (tail)
getMediumSettingsR :: MediumId -> Handler Html
getMediumSettingsR mediumId = do
tempMedium <- runDB $ get mediumId
case tempMedium of
Just medium -> do
ownerId <- return $ mediumOwner medium
owner <- runDB $ getJust ownerId
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
userId <- return $ getUserIdFromText tempUserId
presence <- return (userId == ownerId)
case presence of
True -> do
(mediumSettingsWidget, enctype) <- generateFormPost $ mediumSettingsForm medium
defaultLayout $ do
$(widgetFile "mediumSettings")
False -> do
setMessage "You must own this medium to change its settings"
redirect $ MediumR mediumId
Nothing -> do
setMessage "You must be logged in to change settings"
redirect $ LoginR
Nothing -> do
setMessage "This medium does not exist"
redirect $ HomeR
postMediumSettingsR :: MediumId -> Handler Html
postMediumSettingsR mediumId = do
tempMedium <- runDB $ get mediumId
case tempMedium of
Just medium -> do
ownerId <- return $ mediumOwner medium
owner <- runDB $ getJust ownerId
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
userId <- return $ getUserIdFromText tempUserId
presence <- return (userId == ownerId)
case presence of
True -> do
((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium
case result of
FormSuccess temp -> do
mId <- 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
False -> do
setMessage "You must own this medium to change its settings"
redirect $ MediumR mediumId
Nothing -> do
setMessage "You must be logged in to change settings"
redirect $ LoginR
Nothing -> do
setMessage "This medium does not exist"
redirect $ HomeR
mediumSettingsForm :: Medium -> Form Medium
mediumSettingsForm medium = renderDivs $ Medium
<$> areq textField "Title" (Just $ mediumTitle medium)
<*> pure (mediumPath medium)
<*> pure (mediumTime medium)
<*> pure (mediumOwner medium)
<*> areq textareaField "Description" (Just $ mediumDescription medium)
<*> areq tagField "tags" (Just $ mediumTags medium)
<*> pure (mediumAlbum medium)
getMediumDeleteR :: MediumId -> Handler Html
getMediumDeleteR mediumId = do
tempMedium <- runDB $ get mediumId
case tempMedium of
Just medium -> do
ownerId <- return $ mediumOwner medium
owner <- runDB $ getJust ownerId
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
userId <- return $ getUserIdFromText tempUserId
presence <- return (userId == ownerId)
case presence of
True -> do
defaultLayout $ do
$(widgetFile "mediumDelete")
False -> do
setMessage "You must own this medium to delete it"
redirect $ MediumR mediumId
Nothing -> do
setMessage "You must be logged in to delete media"
redirect $ LoginR
Nothing -> do
setMessage "This Medium does not exist"
redirect $ HomeR
postMediumDeleteR :: MediumId -> Handler Html
postMediumDeleteR mediumId = do
tempMedium <- runDB $ get mediumId
case tempMedium of
Just medium -> do
ownerId <- return $ mediumOwner medium
owner <- runDB $ getJust ownerId
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
userId <- return $ getUserIdFromText tempUserId
presence <- return (userId == ownerId)
case presence of
True -> do
confirm <- lookupPostParam "confirm"
case confirm of
Just "confirm" -> do
-- delete references first
albumId <- return $ mediumAlbum medium
album <- runDB $ getJust albumId
mediaList <- return $ albumContent album
newMediaList <- return $ removeItem mediumId mediaList
-- update reference List
runDB $ update albumId [AlbumContent =. newMediaList]
liftIO $ removeFile (normalise $ tail $ mediumPath medium)
runDB $ delete mediumId
setMessage "Medium succesfully deleted"
redirect $ HomeR
_ -> do
setMessage "You must confirm the deletion"
redirect $ MediumSettingsR mediumId
False -> do
setMessage "You must own this medium to delete it"
redirect $ MediumR mediumId
Nothing -> do
setMessage "You must be logged in to delete media"
redirect $ LoginR
Nothing -> do
setMessage "This Medium does not exist"
redirect $ HomeR