eidolon/Handler/NewAlbum.hs

58 lines
1.8 KiB
Haskell
Raw Normal View History

2014-08-13 22:49:37 +00:00
module Handler.NewAlbum where
import Import
2014-08-14 00:26:02 +00:00
import Data.Text
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
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
userId <- lift $ pure $ getUserIdFromText tempUserId
2014-08-15 12:50:03 +00:00
(albumWidget, enctype) <- generateFormPost (albumForm userId)
formLayout $ 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"
2014-08-14 00:26:02 +00:00
redirect $ LoginR
2014-08-13 22:49:37 +00:00
postNewAlbumR :: Handler Html
2014-08-14 00:26:02 +00:00
postNewAlbumR = do
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
2014-09-07 05:03:06 +00:00
userId <- return $ getUserIdFromText tempUserId
2014-12-28 06:12:25 +00:00
((result, _), _) <- runFormPost (albumForm userId)
2014-08-14 00:26:02 +00:00
case result of
FormSuccess album -> do
-- Put album in Database
2014-08-14 00:26:02 +00:00
albumId <- runDB $ insert album
-- add album reference in user
user <- runDB $ getJust userId
albumList <- return $ userAlbums user
newAlbumList <- return $ albumId : albumList
runDB $ update userId [UserAlbums =. newAlbumList]
-- create folder
2014-08-18 01:09:03 +00:00
liftIO $ createDirectory $ "static" </> "data" </> (unpack $ extractKey userId) </> (unpack $ extractKey albumId)
-- outro
2014-08-15 13:47:16 +00:00
setMessage $ "Album successfully created"
2014-08-15 12:50:03 +00:00
redirect $ ProfileR userId
2014-09-07 05:03:06 +00:00
_ -> do
setMessage "There was an error creating the album"
redirect $ NewAlbumR
Nothing -> do
setMessage "You must be logged in to create albums"
redirect $ LoginR
2014-08-14 00:26:02 +00:00
albumForm :: UserId -> Form Album
albumForm userId = renderDivs $ Album
<$> areq textField "Title" Nothing
<*> pure userId
<*> pure []
<*> pure []
2014-08-15 11:24:14 +00:00
<*> pure Nothing
<*> pure 230