fixing errors with multiple file upload
This commit is contained in:
nek0
parent
0231e20266
commit
4eb7525050
3 changed files with 49 additions and 55 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -76,43 +76,28 @@ postDirectUploadR albumId = do
|
|||
Just username -> do
|
||||
(Just (Entity userId user)) <- runDB $ getBy $ UniqueUser username
|
||||
if userId == ownerId || userId `elem` albumShares album
|
||||
-- is the logged in user the owner or is the album shared with him
|
||||
then 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
|
||||
then do
|
||||
setMessage "All images succesfully uploaded"
|
||||
redirect $ AlbumR albumId
|
||||
else do
|
||||
let msg = toMarkup $
|
||||
"File type not supported of: " `T.append`
|
||||
(T.intercalate ", " onlyErrNames)
|
||||
setMessage msg
|
||||
redirect HomeR
|
||||
_ -> do
|
||||
setMessage "There was an error uploading the file"
|
||||
redirect $ DirectUploadR albumId
|
||||
else do -- owner is not present
|
||||
setMessage "You must own this album to upload"
|
||||
redirect $ AlbumR albumId
|
||||
-- is the logged in user the owner or is the album shared with him
|
||||
then do
|
||||
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
|
||||
case result of
|
||||
FormSuccess temp -> do
|
||||
onlyErrNames <- handleUploads temp
|
||||
if L.null onlyErrNames
|
||||
then do
|
||||
setMessage "All images succesfully uploaded"
|
||||
redirect $ AlbumR albumId
|
||||
else do
|
||||
let msg = toMarkup $
|
||||
"File type not supported of: " `T.append`
|
||||
(T.intercalate ", " onlyErrNames)
|
||||
setMessage msg
|
||||
redirect HomeR
|
||||
_ -> do
|
||||
setMessage "There was an error uploading the file"
|
||||
redirect $ DirectUploadR albumId
|
||||
else 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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue