fixing errors with multiple file upload

Handler/Commons.hs

@@ -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

Handler/NewAlbum.hs

@@ -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

Handler/Upload.hs

@@ -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
+          -- is the logged in user the owner or is the album shared with him
-            then do
+          then do
-              ((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
+            ((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
-              case result of
+            case result of
-                FormSuccess temp -> do
+              FormSuccess temp -> do
-                  let fils = fileBulkFiles temp
+                onlyErrNames <- handleUploads temp
-                  let indFils = zip [1..] fils
+                if L.null onlyErrNames
-                  errNames <- mapM
+                then do
-                    (handleUpload
+                  setMessage "All images succesfully uploaded"
-                      (length indFils)
+                  redirect $ AlbumR albumId
-                      (fileBulkAlbum temp)
+                else do
-                      (fileBulkPrefix temp)
+                  let msg = toMarkup $
-                      (fileBulkTime temp)
+                        "File type not supported of: " `T.append`
-                      (fileBulkOwner temp)
+                        (T.intercalate ", " onlyErrNames)
-                      (fileBulkDesc temp)
+                  setMessage msg
-                      (fileBulkTags temp)
+                  redirect HomeR
-                      (fileBulkLicence temp)
+              _ -> do
-                      NewFile
+                setMessage "There was an error uploading the file"
-                    )indFils
+                redirect $ DirectUploadR albumId
-                  let onlyErrNames = catMaybes errNames
+          else do -- owner is not present
-                  if
+            setMessage "You must own this album to upload"
-                    L.null onlyErrNames
+            redirect $ AlbumR albumId
-                    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
+          onlyErrNames <- handleUploads 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
@@ -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