eidolon/Handler/NewAlbum.hs

87 lines
3.1 KiB
Haskell
Raw Permalink 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-13 22:49:37 +00:00
module Handler.NewAlbum where
2016-12-19 02:18:06 +00:00
import Import as I
import Data.List as L (head)
2015-10-19 06:32:47 +00:00
import Data.Text as T
2016-12-19 02:18:06 +00:00
import Text.Blaze (toMarkup)
2014-08-14 00:26:02 +00:00
import System.Directory
import System.FilePath
2014-08-13 22:49:37 +00:00
getNewAlbumR :: Handler Html
2014-08-14 00:26:02 +00:00
getNewAlbumR = do
2017-04-26 19:43:22 +00:00
musername <- maybeAuthId
case musername of
Just username -> do
(Just (Entity userId _)) <- runDB $ getBy $ UniqueUser username
2015-10-19 06:32:47 +00:00
(albumWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $
albumForm userId
2016-08-31 19:37:20 +00:00
defaultLayout $ do
2014-09-24 21:03:18 +00:00
setTitle "Eidolon :: Create new Album"
2014-08-14 00:26:02 +00:00
$(widgetFile "newAlbum")
Nothing -> do
2014-08-26 02:37:56 +00:00
setMessage "You need to be logged in"
2017-04-24 05:46:34 +00:00
redirect $ AuthR LoginR
2014-08-13 22:49:37 +00:00
postNewAlbumR :: Handler Html
2014-08-14 00:26:02 +00:00
postNewAlbumR = do
2017-04-26 19:43:22 +00:00
musername <- maybeAuthId
case musername of
Just username -> do
(Just (Entity userId _)) <- runDB $ getBy $ UniqueUser username
2015-10-19 06:32:47 +00:00
((result, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $
albumForm userId
2014-08-14 00:26:02 +00:00
case result of
FormSuccess album -> do
2016-12-19 02:18:06 +00:00
namesakes <- runDB $ selectList [AlbumTitle ==. albumTitle album, AlbumOwner ==. userId] []
if I.null namesakes
2016-12-19 01:44:44 +00:00
then do
-- Put album in Database
albumId <- runDB $ insert album
-- add album reference in user
user <- runDB $ getJust userId
let albumList = userAlbums user
let newAlbumList = albumId : albumList
runDB $ update userId [UserAlbums =. newAlbumList]
-- create folder
liftIO $ createDirectoryIfMissing True $ "static" </> "data" </> unpack (extractKey userId) </> unpack (extractKey albumId)
2016-12-19 01:44:44 +00:00
-- outro
setMessage "Album successfully created"
redirect $ AlbumR albumId
else do
2016-12-19 02:18:06 +00:00
setMessage $ toMarkup $ "You already have an album named " `T.append`
albumTitle album
redirect $ AlbumR $ entityKey $ L.head namesakes
2014-09-07 05:03:06 +00:00
_ -> do
setMessage "There was an error creating the album"
2015-09-14 16:54:46 +00:00
redirect NewAlbumR
2014-09-07 05:03:06 +00:00
Nothing -> do
setMessage "You must be logged in to create albums"
2017-04-24 05:46:34 +00:00
redirect $ AuthR LoginR
2014-08-14 00:26:02 +00:00
2015-10-19 06:32:47 +00:00
albumForm :: UserId -> AForm Handler Album
albumForm userId = Album
<$> areq textField (bfs ("Title" :: T.Text)) Nothing
2014-08-14 00:26:02 +00:00
<*> pure userId
<*> pure []
<*> pure []
2014-08-15 11:24:14 +00:00
<*> pure Nothing
2015-10-19 06:32:47 +00:00
<* bootstrapSubmit ("Create album" :: BootstrapSubmit Text)