feat: automatically detect file type on file selection

package-lock.json

@@ -38,6 +38,7 @@
         "highlightjs": "~9.16.2",
         "immer": "~9.0.5",
         "isomorphic-unfetch": "~3.1.0",
+        "jszip": "^3.10.1",
         "markdown-it": "~13.0.1",
         "minify": "^11.3.0",
         "prop-types": "~15.6.2",
@@ -5178,7 +5179,6 @@
     },
     "node_modules/core-util-is": {
       "version": "1.0.3",
-      "dev": true,
       "license": "MIT"
     },
     "node_modules/cosmiconfig": {
@@ -7370,6 +7370,11 @@
       ],
       "license": "BSD-3-Clause"
     },
+    "node_modules/immediate": {
+      "version": "3.0.6",
+      "resolved": "https://registry.npmjs.org/immediate/-/immediate-3.0.6.tgz",
+      "integrity": "sha512-XXOFtyqDjNDAQxVfYxuF7g9Il/IbWmmlQg2MYKOH8ExIT1qg6xc4zyS3HaEEATgs1btfzxq15ciUiY7gjSXRGQ=="
+    },
     "node_modules/immer": {
       "version": "9.0.21",
       "license": "MIT",
@@ -7661,7 +7666,6 @@
     },
     "node_modules/isarray": {
       "version": "1.0.0",
-      "dev": true,
       "license": "MIT"
     },
     "node_modules/isexe": {
@@ -7767,6 +7771,17 @@
         "graceful-fs": "^4.1.6"
       }
     },
+    "node_modules/jszip": {
+      "version": "3.10.1",
+      "resolved": "https://registry.npmjs.org/jszip/-/jszip-3.10.1.tgz",
+      "integrity": "sha512-xXDvecyTpGLrqFrvkrUSoxxfJI5AH7U8zxxtVclpsUtMCq4JQ290LY8AW5c7Ggnr/Y/oK+bQMbqK2qmtk3pN4g==",
+      "dependencies": {
+        "lie": "~3.3.0",
+        "pako": "~1.0.2",
+        "readable-stream": "~2.3.6",
+        "setimmediate": "^1.0.5"
+      }
+    },
     "node_modules/keyv": {
       "version": "4.5.4",
       "dev": true,
@@ -7800,6 +7815,14 @@
         "node": ">=0.10.0"
       }
     },
+    "node_modules/lie": {
+      "version": "3.3.0",
+      "resolved": "https://registry.npmjs.org/lie/-/lie-3.3.0.tgz",
+      "integrity": "sha512-UaiMJzeWRlEujzAuw5LokY1L5ecNQYZKfmyZ9L7wDHb/p5etKaxXhohBcrw0EYby+G/NA52vRSN4N39dxHAIwQ==",
+      "dependencies": {
+        "immediate": "~3.0.5"
+      }
+    },
     "node_modules/lightningcss": {
       "version": "1.24.1",
       "dev": true,
@@ -9847,6 +9870,11 @@
         "node": ">=8"
       }
     },
+    "node_modules/pako": {
+      "version": "1.0.11",
+      "resolved": "https://registry.npmjs.org/pako/-/pako-1.0.11.tgz",
+      "integrity": "sha512-4hLB8Py4zZce5s4yd9XzopqwVv/yGNhV1Bl8NTmCq1763HeK2+EwVTv+leGeL13Dnh2wfbqowVPXCIO0z4taYw=="
+    },
     "node_modules/pandemonium": {
       "version": "2.4.1",
       "license": "MIT",
@@ -10608,7 +10636,6 @@
     },
     "node_modules/process-nextick-args": {
       "version": "2.0.1",
-      "dev": true,
       "license": "MIT"
     },
     "node_modules/progress": {
@@ -11097,7 +11124,6 @@
     },
     "node_modules/readable-stream": {
       "version": "2.3.8",
-      "dev": true,
       "license": "MIT",
       "dependencies": {
         "core-util-is": "~1.0.0",
@@ -12142,7 +12168,6 @@
     },
     "node_modules/string_decoder": {
       "version": "1.1.1",
-      "dev": true,
       "license": "MIT",
       "dependencies": {
         "safe-buffer": "~5.1.0"
@@ -12762,7 +12787,6 @@
     },
     "node_modules/util-deprecate": {
       "version": "1.0.2",
-      "dev": true,
       "license": "MIT"
     },
     "node_modules/utility-types": {

package.json

@@ -49,6 +49,7 @@
     "highlightjs": "~9.16.2",
     "immer": "~9.0.5",
     "isomorphic-unfetch": "~3.1.0",
+    "jszip": "^3.10.1",
     "markdown-it": "~13.0.1",
     "minify": "^11.3.0",
     "prop-types": "~15.6.2",

src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs

 module Gargantext.Components.Forest.Tree.Node.Action.Upload where
 
+import Gargantext.Utils.ZIP as ZIP
 import Data.Array as A
-import Data.Either (Either, fromRight')
+import Data.Array.NonEmpty as DAN
+import Data.Either (Either(..), fromRight', hush, note)
 import Data.Eq.Generic (genericEq)
 import Data.Foldable (intercalate)
 import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing)
 import Data.Newtype (class Newtype)
+import Data.Set as Set
+import Data.String as DS
 import Data.String.Regex as DSR
 import Data.String.Regex.Flags as DSRF
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
+import Data.Traversable (traverse)
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff)
 import Effect.Class (liftEffect)
@@ -18,7 +23,7 @@ import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
 import Gargantext.Components.Forest.Tree.Node.Action (Props)
 import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
-import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat(..), FileType(..), UploadFileBlob(..), readUFBAsBase64, readUFBAsText)
+import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat(..), FileType(..), UploadFileBlob(..), readUFBAsBase64, readUFBAsText, readUFBAsArrayBuffer)
 import Gargantext.Components.Forest.Tree.Node.Action.Utils (loadLanguages)
 import Gargantext.Components.Forest.Tree.Node.Tools as Tools
 import Gargantext.Components.Lang (Lang(..), langReader)
@@ -125,105 +130,227 @@ uploadFileViewWithLangsCpt = here.component "uploadFileViewWithLangs" cpt
   where
     cpt { dispatch, langs, nodeType, session } _ = do
       -- mFile    :: R.State (Maybe UploadFile) <- R.useState' Nothing
-      mFile       <- T.useBox (Nothing :: Maybe UploadFile)
-      fileType    <- T.useBox TSV
-      fileFormat  <- T.useBox Plain
-      lang        <- T.useBox EN
-      selection   <- T.useBox ListSelection.MyListsFirst
-
-      let setFileType'   val = T.write_ val fileType
-      let setFileFormat' val = T.write_ val fileFormat
+      processed' /\ processed   <- R2.useBox' false
+      message' /\ message       <- R2.useBox' ""
+      mFile' /\ mFile           <- R2.useBox' (Nothing :: Maybe UploadFile)
+      fileType' /\ fileType     <- R2.useBox' TSV
+      fileFormat' /\ fileFormat <- R2.useBox' Plain
+      lang                      <- T.useBox EN
+      selection                 <- T.useBox ListSelection.MyListsFirst
+      infoText' /\ infoText     <- R2.useBox'
+        "The following settings were found automatically, based on the extension of the provided file."
+
+      let setFileType'   val = T.write_ val fileType >>= \_ -> T.write_ "" infoText
+      let setFileFormat' val = T.write_ val fileFormat >>= \_ -> T.write_ "" infoText
       let setLang'       val = T.write_ val lang
 
-      let bodies =
+      let props = { dispatch
+                  , processed
+                  , message
+                  , fileFormat
+                  , fileType
+                  , lang
+                  , mFile
+                  , nodeType
+                  , selection
+                  }
+
+      let fileUpload =
             [ R2.row
               [ H.div { className:"col-12 flex-space-around"}
                 [ H.div { className: "form-group" }
                   [ H.input { type: "file"
                             , className: "form-control"
                             , placeholder: "Choose file"
-                            , on: {change: onChangeContents mFile}
+                            , on: {change: onChangeContents props}
                             }
                   ]
+                , H.text message'
                 ]
               ]
-            , R2.row
-              [ H.div {className:"col-6 flex-space-around"}
-                [ Tools.formChoiceSafe { items: [ TSV
-                                                , TSV_HAL
-                                                , Istex
-                                                , WOS
-                                                , JSON
-                                                  -- , Iramuteq
-                                                ]
-                                 , default: TSV
-                                 , callback: setFileType'
-                                 , print: show } []
-                , Tools.formChoiceSafe { items: [ Plain
-                                                , ZIP ]
-                                       , default: Plain
-                                       , callback: setFileFormat'
-                                       , print: show } []
-                ]
+            ]
+      let selects = if processed' then
+          [ R2.row
+            [ H.div {className:"col-6 flex-space-around"}
+              [ H.text infoText'
+              , B.formSelect' { list: [ TSV
+                                      , TSV_HAL
+                                      , Istex
+                                      , WOS
+                                      , JSON
+                                        -- , Iramuteq
+                                      ]
+                               , value: fileType'
+                               , callback: setFileType' } []
+              , B.formSelect' { list: [ Plain
+                                      , ZIP ]
+                              , value: fileFormat'
+                              , callback: setFileFormat' } []
               ]
-            , R2.row
-              [ H.div {className:"col-6 flex-space-around"}
-                [ Tools.formChoiceSafe { items: langs <> [No_extraction]
+            ]
+          , R2.row
+            [ H.div { className: "col-6 flex-space-around" }
+              [ H.text "Please choose the language of your documents and the list to use."
+              , Tools.formChoiceSafe { items: langs <> [No_extraction]
                                        , default: EN
                                        , callback: setLang'
                                        , print: show
                                        } []
-                ]
-              ]
-            , R2.row
-              [ H.div { className: "col-6 flex-space-around" }
-                [ ListSelection.selection { selection, session } [] ]
+              , ListSelection.selection { selection, session } []
               ]
             ]
-
-      let footer = H.div {} [ uploadButton { dispatch
-                                           , fileFormat
-                                           , fileType
-                                           , lang
-                                           , mFile
-                                           , nodeType
-                                           , selection
-                                           } []
+          ]
+        else []
+      let bodies = fileUpload <> selects
+      let footer = H.div {} [ uploadButton props []
                             ]
       pure $ Tools.panel { mError: Nothing } (bodies <> [ footer ])
 
+-- | Properties of a file upload
+type UploadFileProps =
+  ( dispatch   :: Action -> Aff Unit
+  , processed  :: T.Box Boolean -- ^ file was uploaded and processed
+  , message    :: T.Box String -- ^ (error) message shown on file selection
+  , fileFormat :: T.Box FileFormat -- ^ file format of the upload, e.g. Plain or ZIP
+  , fileType   :: T.Box FileType -- ^ file type of the upload, e.g. TSV, JSON, etc.
+  , lang       :: T.Box Lang -- ^ language of the uploaded document
+  , mFile      :: T.Box (Maybe UploadFile)
+  , nodeType   :: GT.NodeType
+  , selection  :: T.Box ListSelection.Selection
+  )
 
-onChangeContents :: forall e. T.Box (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit
-onChangeContents mFile e = do
+-- | Callback called upon selecting a file in the upload file selector.
+onChangeContents :: forall e. Record UploadFileProps -> E.SyntheticEvent_ e -> Effect Unit
+onChangeContents props@{ dispatch
+                       , processed
+                       , message
+                       , fileFormat
+                       , fileType
+                       , lang
+                       , mFile
+                       , nodeType
+                       , selection
+                       } e = do
   let mF = R2.inputFileNameWithBlob 0 e
   E.preventDefault e
   E.stopPropagation e
   case mF of
     Nothing -> pure unit
-    Just {blob, name} -> void $ launchAff do
-      --contents <- readAsText blob
-      --contents <- readAsDataURL blob
-      liftEffect $ do
-        T.write_ (Just $ {blob: UploadFileBlob blob, name}) mFile
-
-
-type UploadButtonProps =
-  ( dispatch   :: Action -> Aff Unit
-  , fileFormat :: T.Box FileFormat
-  , fileType   :: T.Box FileType
-  , lang       :: T.Box Lang
-  , mFile      :: T.Box (Maybe UploadFile)
-  , nodeType   :: GT.NodeType
-  , selection  :: T.Box ListSelection.Selection
-  )
+    Just {blob, name} -> do
+      T.write_ (Just $ {blob: UploadFileBlob blob, name}) mFile
+      checkFileUpdateParams props
 
-uploadButton :: R2.Component UploadButtonProps
+uploadButton :: R2.Component UploadFileProps
 uploadButton = R.createElement uploadButtonCpt
 
-uploadButtonCpt :: R.Component UploadButtonProps
+-- | String pattern used to parse extensions in file paths
+fileExtensionPattern :: String
+fileExtensionPattern = "(.*)\\.(.*)"
+
+-- | Given a file name, it parses the extension and returns the lower case extension and
+-- otherwise `Nothing`.
+extensionFromFileName :: String -> Maybe String
+extensionFromFileName name = do
+  reg <- hush (DSR.regex fileExtensionPattern DSRF.noFlags)
+  matches <- DSR.match reg name
+  case DAN.toArray matches of
+    [_, _, ext] -> DS.toLower <$> ext
+    _ -> Nothing
+
+-- | Given a file name, it parses the extension and checks if it is `.zip`. If yes,
+-- it returns `Just true` otherwise `Just false`. If the parsing fails, it returns `Nothing`.
+isZIPFromFileName :: String -> Maybe Boolean
+isZIPFromFileName name = do
+  ext <- extensionFromFileName name
+  case ext of
+    "zip" -> pure true
+    _     -> pure false
+
+-- | Given a file name, this returns one of the pre-defined file types based on the extension
+-- of the filename and `Nothing` if the extension is not recognized.
+fileTypeFromFileName :: String -> Maybe FileType
+fileTypeFromFileName name = do
+  ext <- extensionFromFileName name
+  case ext of
+    -- There should be more file extensions here, but I don't understand the other
+    -- constructors of `FileType`
+    "tsv" -> pure TSV
+    "json" -> pure JSON
+    _ -> Nothing
+
+-- | Given an array of file names, extract file types from the extensions and return the
+-- unique file type. If any of the steps fail, an error message is returned.
+fileTypeFromFileNames :: Array String -> Either String FileType
+fileTypeFromFileNames names = do
+  fts <- note "Some extensions were not recognized." (traverse fileTypeFromFileName names)
+  ft <- note "Found no files in the archive" (A.head fts)
+  case Set.size (Set.fromFoldable fts) of
+    0 -> Left "Found no files in the archive."
+    1 -> Right ft
+    _ -> Left "More than one file type found in the archive."
+
+-- | Check the selected file in the upload file selector, analyze the extension
+-- and inform the user by updating visible parameters.
+checkFileUpdateParams :: Record UploadFileProps -> Effect Unit
+checkFileUpdateParams { dispatch
+                      , processed
+                      , message
+                      , fileFormat
+                      , fileType
+                      , lang
+                      , mFile
+                      , nodeType
+                      , selection
+                      } = do
+  processed'  <- T.read processed
+  fileType'   <- T.read fileType
+  fileFormat' <- T.read fileFormat
+  mFile'      <- T.read mFile
+  lang'       <- T.read lang
+  selection'  <- T.read selection
+  let { blob, name } = unsafePartial $ fromJust mFile'
+  case isZIPFromFileName name of
+    Just true -> do
+      void $ launchAff do
+        contents <- readUFBAsArrayBuffer blob
+        files <- (ZIP.getFiles contents :: Aff (Array String))
+        case fileTypeFromFileNames files of
+          Right ft -> liftEffect $ do
+            here.log2 "[uploadFileCheck] found filetype" ft
+            T.write_ ft fileType
+            T.write_ ZIP fileFormat
+            -- update processed and message
+            T.write_ true processed
+            T.write_ "" message
+          Left err -> liftEffect $ do
+            here.log2 "[uploadFileCheck] error" err
+            T.write_ false processed
+            T.write_ err message
+    Just false -> do
+      case fileTypeFromFileName name of
+        Just ft -> do
+          here.log2 "[uploadFileCheck] found filetype" ft
+          -- write parsed `FileType` to the `fileType'` box
+          T.write_ ft fileType
+          T.write_ Plain fileFormat
+          -- update processed and message
+          T.write_ true processed
+          T.write_ "" message
+        Nothing -> do
+          here.log2 "[uploadFileCheck] unkown filetype" name
+          T.write_ false processed
+          T.write_ "This filetype is not supported." message
+    Nothing -> do
+      here.log2 "[uploadFileCheck] extension invalid" name
+      T.write_ false processed
+      T.write_ "The file extension is invalid." message
+
+uploadButtonCpt :: R.Component UploadFileProps
 uploadButtonCpt = here.component "uploadButton" cpt
   where
     cpt { dispatch
+        , processed
+        , message
         , fileFormat
         , fileType
         , lang
@@ -231,6 +358,7 @@ uploadButtonCpt = here.component "uploadButton" cpt
         , nodeType
         , selection
         } _ = do
+      processed'  <- T.useLive T.unequal processed
       fileType'   <- T.useLive T.unequal fileType
       fileFormat' <- T.useLive T.unequal fileFormat
       mFile'      <- T.useLive T.unequal mFile
@@ -238,7 +366,7 @@ uploadButtonCpt = here.component "uploadButton" cpt
       selection'  <- T.useLive T.unequal selection
       onPending /\ onPendingBox <- R2.useBox' false
 
-      let disabled = isNothing mFile' || onPending
+      let disabled = isNothing mFile' || onPending || not processed'
 
       pure $
         H.div
@@ -277,6 +405,7 @@ uploadButtonCpt = here.component "uploadButton" cpt
           let { blob, name } = unsafePartial $ fromJust mFile'
           T.write_ true onPendingBox
           here.log2 "[uploadButton] fileType" fileType'
+          here.log2 "[uploadButton] name" (fileTypeFromFileName name)
           void $ launchAff do
             case fileType' of
               Arbitrary ->
@@ -300,6 +429,10 @@ uploadListViewCpt :: R.Component Props
 uploadListViewCpt = here.component "uploadListView" cpt where
   cpt { dispatch, session } _ = do
   -- States
+    processed
+      <- T.useBox false
+    message
+      <- T.useBox ""
     mFile
       <- T.useBox (Nothing :: Maybe UploadFile)
     fileType
@@ -310,6 +443,16 @@ uploadListViewCpt = here.component "uploadListView" cpt where
       <- R2.useBox' EN
     selection
       <- T.useBox ListSelection.MyListsFirst
+    let props = { dispatch
+                , processed
+                , message
+                , fileFormat: fileFormatBox
+                , fileType
+                , lang: langBox
+                , mFile
+                , selection
+                , nodeType: GT.Annuaire
+                }
 
   -- Render
     pure $
@@ -335,7 +478,7 @@ uploadListViewCpt = here.component "uploadListView" cpt where
             { type: "file"
             , className: "form-control"
             , placeholder: "Choose file"
-            , on: { change: onChangeContents mFile }
+            , on: { change: onChangeContents props }
             }
           ]
         ]
@@ -419,21 +562,13 @@ uploadListViewCpt = here.component "uploadListView" cpt where
             } []
           ]
         ]
-      
+
       -- Footer
       ,
         H.div
         {}
         [
-          uploadButton
-          { dispatch
-          , fileFormat: fileFormatBox
-          , fileType
-          , lang: langBox
-          , mFile
-          , selection
-          , nodeType: GT.Annuaire
-          } []
+          uploadButton props []
         ]
       ]
 

src/Gargantext/Components/Forest/Tree/Node/Action/Upload/Types.purs

@@ -4,6 +4,7 @@ import Gargantext.Prelude
 
 import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Eq.Generic (genericEq)
+import Data.Ord.Generic (genericCompare)
 import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import Data.Show.Generic (genericShow)
@@ -17,6 +18,7 @@ data FileType = TSV | TSV_HAL | Istex | WOS | PresseRIS | Arbitrary | JSON | Ira
 
 derive instance Generic FileType _
 instance Eq FileType where eq = genericEq
+instance Ord FileType where compare = genericCompare
 instance Show FileType where show = genericShow
 instance Read FileType where
   read :: String -> Maybe FileType

src/Gargantext/Utils/ZIP.js

+/* global exports */
+"use strict";
+
+// module WebSocket
+
+async function getFilesAsync_ (blob) {
+  var JSZip = require("jszip");
+  var zip = new JSZip();
+  var data = await zip.loadAsync(blob);
+  var vals = Object.values(data.files);
+  var fns = [];
+  for (var i = 0; i < vals.length; i++) {
+    fns.push(vals[i].name);
+    console.log(vals[i].name);
+  }
+  console.log(fns);
+  return fns;
+}
+
+export const getFilesAsync = blob => () =>
+  getFilesAsync_(blob);

src/Gargantext/Utils/ZIP.purs

+-- | This module defines a simple low-level interface to the websockets API.
+
+module Gargantext.Utils.ZIP
+  ( getFiles
+  ) where
+
+import Gargantext.Prelude
+
+import Data.ArrayBuffer.Types (ArrayBuffer)
+import Effect
+import Control.Promise
+import Effect.Aff (Aff)
+
+foreign import getFilesAsync :: ArrayBuffer -> Effect (Promise (Array String))
+
+getFiles :: ArrayBuffer -> Aff (Array String)
+getFiles blob = toAffE $ getFilesAsync blob