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

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