fixing errors with multiple file upload

This commit is contained in:
nek0 2017-07-25 22:50:09 +02:00
parent 0231e20266
commit 4eb7525050
3 changed files with 49 additions and 55 deletions

View file

@ -313,7 +313,7 @@ writeOnDrive fil userId albumId spec = do
let ac = albumContent album
[PersistInt64 int] <- case spec of
NewFile ->
if L.null ac then return [PersistInt64 1] else return $ keyToValues $ maximum $ ac
if L.null ac then return [PersistInt64 0] else return $ keyToValues $ maximum $ ac
Replace mId -> do
medium <- runDB $ getJust mId
return $ (PersistInt64 (read $ takeBaseName $ mediumPath medium :: Int64)) : []
@ -321,7 +321,12 @@ writeOnDrive fil userId albumId spec = do
Replace _ -> 0
NewFile -> 1
ext = FP.takeExtension $ T.unpack $ fileName fil
path = "static" FP.</> "data" FP.</> T.unpack (extractKey userId) FP.</> T.unpack (extractKey albumId) FP.</> filen ++ ext
path =
"static" FP.</>
"data" FP.</>
T.unpack (extractKey userId) FP.</>
T.unpack (extractKey albumId) FP.</>
filen ++ ext
dde <- liftIO $ doesDirectoryExist $ FP.dropFileName path
if not dde
then

View file

@ -61,7 +61,7 @@ postNewAlbumR = do
let newAlbumList = albumId : albumList
runDB $ update userId [UserAlbums =. newAlbumList]
-- create folder
liftIO $ createDirectory $ "static" </> "data" </> unpack (extractKey userId) </> unpack (extractKey albumId)
liftIO $ createDirectoryIfMissing True $ "static" </> "data" </> unpack (extractKey userId) </> unpack (extractKey albumId)
-- outro
setMessage "Album successfully created"
redirect $ AlbumR albumId

View file

@ -81,23 +81,8 @@ postDirectUploadR albumId = do
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
case result of
FormSuccess temp -> do
let fils = fileBulkFiles temp
let indFils = zip [1..] fils
errNames <- mapM
(handleUpload
(length indFils)
(fileBulkAlbum temp)
(fileBulkPrefix temp)
(fileBulkTime temp)
(fileBulkOwner temp)
(fileBulkDesc temp)
(fileBulkTags temp)
(fileBulkLicence temp)
NewFile
)indFils
let onlyErrNames = catMaybes errNames
if
L.null onlyErrNames
onlyErrNames <- handleUploads temp
if L.null onlyErrNames
then do
setMessage "All images succesfully uploaded"
redirect $ AlbumR albumId
@ -201,21 +186,7 @@ postUploadR = do
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId user
case result of
FormSuccess temp -> do
let fils = fileBulkFiles temp
let indFils = zip [1..] fils
errNames <- mapM
(handleUpload
(length indFils)
(fileBulkAlbum temp)
(fileBulkPrefix temp)
(fileBulkTime temp)
(fileBulkOwner temp)
(fileBulkDesc temp)
(fileBulkTags temp)
(fileBulkLicence temp)
NewFile
)indFils
let onlyErrNames = catMaybes errNames
onlyErrNames <- handleUploads temp
if
L.null onlyErrNames
then do
@ -233,3 +204,21 @@ postUploadR = do
Nothing -> do
setMessage "You need to be logged in"
redirect $ AuthR LoginR
handleUploads :: FileBulk -> Handler [Text]
handleUploads temp = do
let fils = fileBulkFiles temp
indFils = zip [1..] fils
errNames <- mapM
(handleUpload
(length indFils)
(fileBulkAlbum temp)
(fileBulkPrefix temp)
(fileBulkTime temp)
(fileBulkOwner temp)
(fileBulkDesc temp)
(fileBulkTags temp)
(fileBulkLicence temp)
NewFile
)indFils
return $ catMaybes errNames