added direct upload to album page
This commit is contained in:
parent
7754e321b2
commit
339a8e5b0e
|
@ -60,6 +60,80 @@ postUploadR = do
|
||||||
setMessage "You need to be logged in"
|
setMessage "You need to be logged in"
|
||||||
redirect $ LoginR
|
redirect $ LoginR
|
||||||
|
|
||||||
|
getDirectUploadR :: AlbumId -> Handler Html
|
||||||
|
getDirectUploadR albumId = do
|
||||||
|
tempAlbum <- runDB $ get albumId
|
||||||
|
case tempAlbum of -- does the requested album exist
|
||||||
|
Just album -> do
|
||||||
|
ownerId <- return $ albumOwner album
|
||||||
|
owner <- runDB $ getJust ownerId
|
||||||
|
ownerName <- return $ userName owner
|
||||||
|
msu <- lookupSession "userId"
|
||||||
|
case msu of -- is anybody logged in
|
||||||
|
Just tempUserId -> do
|
||||||
|
userId <- return $ getUserIdFromText tempUserId
|
||||||
|
presence <- return (userId == ownerId)
|
||||||
|
case presence of -- is the owner present
|
||||||
|
True -> do
|
||||||
|
(dUploadWidget, enctype) <- generateFormPost $ dUploadForm userId albumId
|
||||||
|
defaultLayout $ do
|
||||||
|
$(widgetFile "dUpload")
|
||||||
|
False -> do
|
||||||
|
setMessage "You must own this album to upload"
|
||||||
|
redirect $ AlbumR albumId
|
||||||
|
Nothing -> do
|
||||||
|
setMessage "You must be logged in to upload"
|
||||||
|
redirect $ LoginR
|
||||||
|
Nothing -> do
|
||||||
|
setMessage "This album does not exist"
|
||||||
|
redirect $ HomeR
|
||||||
|
|
||||||
|
postDirectUploadR :: AlbumId -> Handler Html
|
||||||
|
postDirectUploadR albumId = do
|
||||||
|
tempAlbum <- runDB $ get albumId
|
||||||
|
case tempAlbum of -- does the album exist
|
||||||
|
Just album -> do
|
||||||
|
ownerId <- return $ albumOwner album
|
||||||
|
owner <- runDB $ getJust ownerId
|
||||||
|
ownerName <- return $ userName owner
|
||||||
|
msu <- lookupSession "userId"
|
||||||
|
case msu of -- is anybody logged in
|
||||||
|
Just tempUserId -> do
|
||||||
|
userId <- return $ getUserIdFromText tempUserId
|
||||||
|
presence <- return (userId == ownerId)
|
||||||
|
case presence of -- is the logged in user the owner
|
||||||
|
True -> do
|
||||||
|
((result, dUploadWidget), enctype) <- runFormPost (dUploadForm userId albumId)
|
||||||
|
case result of
|
||||||
|
FormSuccess temp -> do
|
||||||
|
path <- writeOnDrive (tempMediumFile temp) userId albumId
|
||||||
|
medium <- return $ Medium
|
||||||
|
(tempMediumTitle temp)
|
||||||
|
('/' : path)
|
||||||
|
(tempMediumTime temp)
|
||||||
|
(tempMediumOwner temp)
|
||||||
|
(tempMediumDesc temp)
|
||||||
|
(tempMediumTags temp)
|
||||||
|
albumId
|
||||||
|
mId <- runDB $ insert medium
|
||||||
|
inAlbum <- runDB $ getJust albumId
|
||||||
|
newMediaList <- return $ mId : (albumContent inAlbum)
|
||||||
|
runDB $ update albumId [AlbumContent =. newMediaList]
|
||||||
|
setMessage "Image successfully uploaded"
|
||||||
|
redirect $ AlbumR albumId
|
||||||
|
_ -> do
|
||||||
|
setMessage "There was an error uploading the file"
|
||||||
|
redirect $ DirectUploadR albumId
|
||||||
|
False -> do -- owner is not present
|
||||||
|
setMessage "You must own this album to upload"
|
||||||
|
redirect $ AlbumR albumId
|
||||||
|
Nothing -> do
|
||||||
|
setMessage "You must be logged in to upload"
|
||||||
|
redirect $ AlbumR albumId
|
||||||
|
Nothing -> do
|
||||||
|
setMessage "This Album does not exist"
|
||||||
|
redirect $ AlbumR albumId
|
||||||
|
|
||||||
writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FilePath
|
writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FilePath
|
||||||
writeOnDrive file userId albumId = do
|
writeOnDrive file userId albumId = do
|
||||||
filename <- return $ fileName file
|
filename <- return $ fileName file
|
||||||
|
@ -85,6 +159,16 @@ uploadForm userId = renderDivs $ TempMedium
|
||||||
entities <- runDB $ selectList [AlbumOwner ==. userId] [Desc AlbumTitle]
|
entities <- runDB $ selectList [AlbumOwner ==. userId] [Desc AlbumTitle]
|
||||||
optionsPairs $ I.map (\alb -> (albumTitle $ entityVal alb, entityKey alb)) entities
|
optionsPairs $ I.map (\alb -> (albumTitle $ entityVal alb, entityKey alb)) entities
|
||||||
|
|
||||||
|
dUploadForm :: UserId -> AlbumId -> Form TempMedium
|
||||||
|
dUploadForm userId albumId = renderDivs $ TempMedium
|
||||||
|
<$> areq textField "Title" Nothing
|
||||||
|
<*> areq fileField "Select file" Nothing
|
||||||
|
<*> lift (liftIO getCurrentTime)
|
||||||
|
<*> pure userId
|
||||||
|
<*> areq textareaField "Description" Nothing
|
||||||
|
<*> areq tagField "Enter tags" Nothing
|
||||||
|
<*> pure albumId
|
||||||
|
|
||||||
tagField :: Field Handler [Text]
|
tagField :: Field Handler [Text]
|
||||||
tagField = Field
|
tagField = Field
|
||||||
{ fieldParse = \rawVals _ -> do
|
{ fieldParse = \rawVals _ -> do
|
||||||
|
|
|
@ -14,3 +14,4 @@
|
||||||
/newalbum NewAlbumR GET POST
|
/newalbum NewAlbumR GET POST
|
||||||
/album/#AlbumId AlbumR GET
|
/album/#AlbumId AlbumR GET
|
||||||
/medium/#MediumId MediumR GET
|
/medium/#MediumId MediumR GET
|
||||||
|
/album/#AlbumId/upload DirectUploadR GET POST
|
||||||
|
|
|
@ -3,7 +3,7 @@ $newline never
|
||||||
by <a href=@{UserR ownerName}>#{ownerName}</a>
|
by <a href=@{UserR ownerName}>#{ownerName}</a>
|
||||||
<br>
|
<br>
|
||||||
$if presence == True
|
$if presence == True
|
||||||
TODO: direct Upload to this album
|
<a href=@{DirectUploadR albumId}>Upload image to this album
|
||||||
<br>
|
<br>
|
||||||
$if null media
|
$if null media
|
||||||
This album is empty
|
This album is empty
|
||||||
|
|
10
templates/dUpload.hamlet
Normal file
10
templates/dUpload.hamlet
Normal file
|
@ -0,0 +1,10 @@
|
||||||
|
<h3>Image upload
|
||||||
|
|
||||||
|
Here you can upload your image.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
<form method=post enctype=#{enctype}>
|
||||||
|
^{dUploadWidget}
|
||||||
|
<div>
|
||||||
|
<input type=submit value="Upload">
|
Loading…
Reference in a new issue