Merge branch 'dev-corpus-query-async' into dev-upload-lang

src/Gargantext/Components/App.purs

@@ -6,7 +6,10 @@ import Data.Array (fromFoldable)
 import Data.Foldable (intercalate)
 import Data.Maybe (Maybe(..), maybe')
 import Data.Tuple (fst, snd)
-import Gargantext.Components.Data.Lang (Lang(..))
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+import Gargantext.Components.Data.Lang (LandingLang(..))
 import Gargantext.Components.Folder (folder)
 import Gargantext.Components.Forest (forest)
 import Gargantext.Components.GraphExplorer (explorerLayout)
@@ -27,8 +30,6 @@ import Gargantext.Routes (AppRoute(..))
 import Gargantext.Sessions (Sessions, useSessions)
 import Gargantext.Sessions as Sessions
 import Gargantext.Utils.Reactix as R2
-import Reactix as R
-import Reactix.DOM.HTML as H
 
 -- TODO (what does this mean?)
 -- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
@@ -49,12 +50,12 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
     let forested      = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
     let mCurrentRoute = fst route
     let backends      = fromFoldable defaultBackends
-    let withSession = \sid f -> maybe' (\_ -> forested $ homeLayout EN) f $ Sessions.lookup sid (fst sessions)
+    let withSession = \sid f -> maybe' (\_ -> forested $ homeLayout LL_EN) f $ Sessions.lookup sid (fst sessions)
     pure $ case fst showLogin of
       true -> forested $ login { sessions, backends, visible: showLogin }
       false ->
         case fst route of
-          Home  -> forested $ homeLayout EN
+          Home  -> forested $ homeLayout LL_EN
           Login -> login { sessions, backends, visible: showLogin }
           Folder sid _      -> withSession sid $ \_ -> forested (folder {})
           Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }

src/Gargantext/Components/Forest/Tree.purs

@@ -12,6 +12,9 @@ import Data.Tuple (Tuple(..), fst, snd)
 import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
+import Reactix as R
+import Reactix.DOM.HTML as H
+
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
 import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
 import Gargantext.Components.Loader (loader)
@@ -19,9 +22,8 @@ import Gargantext.Components.Login.Types (TreeId)
 import Gargantext.Ends (Frontends)
 import Gargantext.Routes (AppRoute)
 import Gargantext.Sessions (Session)
-import Gargantext.Types (AsyncTask(..))
-import Reactix as R
-import Reactix.DOM.HTML as H
+import Gargantext.Types as GT
+import Gargantext.Utils.Reactix as R2
 
 ------------------------------------------------------------------------
 type Props = ( root          :: ID
@@ -117,9 +119,9 @@ toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asy
           )
         ]
 
-    onAsyncTaskFinish (AsyncTask {id: id_}) = setTreeState $ const $ ts { asyncTasks = newAsyncTasks }
+    onAsyncTaskFinish (GT.AsyncTaskWithType {task: GT.AsyncTask {id}}) = setTreeState $ const $ ts { asyncTasks = newAsyncTasks }
       where
-        newAsyncTasks = A.filter (\(AsyncTask {id: id'}) -> id_ /= id') asyncTasks
+        newAsyncTasks = A.filter (\(GT.AsyncTaskWithType {task: GT.AsyncTask {id: id'}}) -> id /= id') asyncTasks
 
 
 childNodes :: Session
@@ -149,18 +151,22 @@ performAction :: Session
               -> R.State Tree
               -> Action
               -> Aff Unit
+performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
+  void $ createNode session id $ CreateValue {name, nodeType}
+  liftEffect $ setReload (_ + 1)
+
 performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
   void $ deleteNode session id
   liftEffect $ setReload (_ + 1)
 
+performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (SearchQuery task) = do
+  liftEffect $ setTree $ \t@{asyncTasks} -> t { asyncTasks = A.cons task asyncTasks }
+  liftEffect $ log2 "[performAction] SearchQuery task:" task
+
 performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name)  = do
   void $ renameNode session id $ RenameValue {name}
   liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
 
-performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
-  void $ createNode session id $ CreateValue {name, nodeType}
-  liftEffect $ setReload (_ + 1)
-
 performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (UploadFile fileType contents) = do
   task <- uploadFile session id fileType contents
   liftEffect $ setTree $ \t@{asyncTasks} -> t { asyncTasks = A.cons task asyncTasks }

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

@@ -7,15 +7,17 @@ import Data.Generic.Rep.Show (genericShow)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
 import Effect.Aff (Aff)
+import Prelude hiding (div)
+
+import Gargantext.Components.Data.Lang (Lang)
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, get, put, post, delete)
-import Gargantext.Types (NodeType(..), AsyncTask(..))
-import Gargantext.Components.Search.Types (Lang(..))
-import Prelude hiding (div)
+import Gargantext.Types as GT
 
-data Action = Submit       String
+data Action = CreateSubmit String GT.NodeType
             | DeleteNode
-            | CreateSubmit String NodeType
+            | SearchQuery GT.AsyncTaskWithType
+            | Submit       String
             | UploadFile   FileType UploadFileContents
 
 -----------------------------------------------------
@@ -52,16 +54,16 @@ type Reload = Int
 newtype UploadFileContents = UploadFileContents String
 
 createNode :: Session -> ID -> CreateValue -> Aff (Array ID)
-createNode session parentId = post session $ NodeAPI Node (Just parentId) ""
+createNode session parentId = post session $ NodeAPI GT.Node (Just parentId) ""
 
 renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
-renameNode session renameNodeId = put session $ NodeAPI Node (Just renameNodeId) "rename"
+renameNode session renameNodeId = put session $ NodeAPI GT.Node (Just renameNodeId) "rename"
 
 deleteNode :: Session -> ID -> Aff ID
-deleteNode session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
+deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
 
 loadNode :: Session -> ID -> Aff FTree
-loadNode session nodeId = get session $ NodeAPI Tree (Just nodeId) ""
+loadNode session nodeId = get session $ NodeAPI GT.Tree (Just nodeId) ""
 
 
 newtype RenameValue = RenameValue
@@ -77,7 +79,7 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
 newtype CreateValue = CreateValue
   {
     name :: Name
-  , nodeType :: NodeType
+  , nodeType :: GT.NodeType
   }
 
 instance encodeJsonCreateValue :: EncodeJson CreateValue where
@@ -88,14 +90,14 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
 
 data NTree a = NTree a (Array (NTree a))
 type FTree = NTree LNode
-type Tree = { tree :: FTree, asyncTasks :: Array AsyncTask }
+type Tree = { tree :: FTree, asyncTasks :: Array GT.AsyncTaskWithType }
 
 instance ntreeFunctor :: Functor NTree where
   map f (NTree x ary) = NTree (f x) (map (map f) ary)
 
 newtype LNode = LNode { id :: ID
                       , name :: Name
-                      , nodeType :: NodeType
+                      , nodeType :: GT.NodeType
                       }
 
 derive instance newtypeLNode :: Newtype LNode _

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

@@ -13,11 +13,12 @@ import Reactix as R
 import Reactix.DOM.HTML as H
 import URI.Extra.QueryPairs as QP
 import Web.File.FileReader.Aff (readAsText)
-import Gargantext.Components.Search.Types (readLang, Lang(..))
+
+import Gargantext.Components.Data.Lang (readLang, Lang(..))
 import Gargantext.Components.Forest.Tree.Node.Action
-import Gargantext.Routes (SessionRoute(..))
+import Gargantext.Routes as GR
 import Gargantext.Sessions (Session, postWwwUrlencoded)
-import Gargantext.Types (class ToQuery, AsyncTask, NodeType(..))
+import Gargantext.Types as GT
 import Gargantext.Utils (id)
 import Gargantext.Utils.Reactix as R2
 
@@ -121,7 +122,7 @@ uploadButton d id (mContents /\ setMContents) (fileType /\ setFileType) (lang /\
 -- START File Type View
 type FileTypeProps =
   ( id :: ID
-  , nodeType :: NodeType)
+  , nodeType :: GT.NodeType)
 
 fileTypeView :: (Action -> Aff Unit)
              -> Record FileTypeProps
@@ -200,21 +201,22 @@ newtype FileUploadQuery = FileUploadQuery {
     fileType :: FileType
   }
 derive instance newtypeSearchQuery :: Newtype FileUploadQuery _
-instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
+instance fileUploadQueryToQuery :: GT.ToQuery FileUploadQuery where
   toQuery (FileUploadQuery {fileType}) =
     QP.print id id $ QP.QueryPairs $
          pair "fileType" fileType
     where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
           pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
 
-uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff AsyncTask
-uploadFile session id fileType (UploadFileContents fileContents) =
-    postWwwUrlencoded session p bodyParams
+uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff GT.AsyncTaskWithType
+uploadFile session id fileType (UploadFileContents fileContents) = do
+    task <- postWwwUrlencoded session p bodyParams
+    pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
     --postMultipartFormData session p fileContents
   where
     q = FileUploadQuery { fileType: fileType }
-    --p = NodeAPI Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
-    p = NodeAPI Corpus (Just id) $ "add/form/async" -- <> Q.print (toQuery q)
+    --p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
+    p = GR.NodeAPI GT.Corpus (Just id) $ GT.asyncTaskTypePath GT.Form
     bodyParams = [
         Tuple "_wf_data" (Just fileContents)
       , Tuple "_wf_filetype" (Just $ show fileType)

src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs

@@ -12,7 +12,7 @@ import Effect.Timer (clearInterval, setInterval)
 import Gargantext.Components.Forest.Tree.Node.Action (ID)
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, get)
-import Gargantext.Types (AsyncProgress(..), AsyncTask(..), AsyncTaskStatus(..), NodeType(..), progressPercent)
+import Gargantext.Types as GT
 import Partial.Unsafe (unsafePartial)
 
 import Reactix as R
@@ -21,7 +21,7 @@ import Reactix.DOM.HTML as H
 
 type Props =
   (
-    asyncTask :: AsyncTask
+    asyncTask :: GT.AsyncTaskWithType
   , corpusId  :: ID
   , onFinish  :: Unit -> Effect Unit
   , session   :: Session
@@ -34,17 +34,17 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p []
 asyncProgressBarCpt :: R.Component Props
 asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
   where
-    cpt props@{asyncTask: (AsyncTask {id}), corpusId, onFinish} _ = do
+    cpt props@{asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}}), corpusId, onFinish} _ = do
       (progress /\ setProgress) <- R.useState' 0.0
       intervalIdRef <- R.useRef Nothing
 
       R.useEffectOnce' $ do
         intervalId <- setInterval 1000 $ do
           launchAff_ $ do
-            asyncProgress@(AsyncProgress {status}) <- queryProgress props
+            asyncProgress@(GT.AsyncProgress {status}) <- queryProgress props
             liftEffect do
-              setProgress \p -> min 100.0 $ progressPercent asyncProgress
-              if (status == Finished) || (status == Killed) || (status == Failed) then do
+              setProgress \p -> min 100.0 $ GT.progressPercent asyncProgress
+              if (status == GT.Finished) || (status == GT.Killed) || (status == GT.Failed) then do
                 _ <- case R.readRef intervalIdRef of
                   Nothing -> pure unit
                   Just iid -> clearInterval iid
@@ -68,7 +68,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
     toInt :: Number -> Int
     toInt n = unsafePartial $ fromJust $ fromNumber n
 
-queryProgress :: Record Props -> Aff AsyncProgress
-queryProgress {asyncTask: AsyncTask {id}, corpusId, session} = get session p
+queryProgress :: Record Props -> Aff GT.AsyncProgress
+queryProgress {asyncTask: GT.AsyncTaskWithType {task: GT.AsyncTask {id}, typ}, corpusId, session} = get session p
   where
-    p = NodeAPI Corpus (Just corpusId) $ "add/form/async/" <> id <> "/poll?limit=1"
+    p = NodeAPI GT.Corpus (Just corpusId) $ path <> id <> "/poll?limit=1"
+    path = GT.asyncTaskTypePath typ

src/Gargantext/Components/Lang/Data/Lang.purs

 module Gargantext.Components.Data.Lang where
 
-data Lang = EN | FR
+import Data.Argonaut (class EncodeJson, encodeJson)
+import Data.Maybe (Maybe(..))
+
+import Gargantext.Prelude (class Eq, class Show, show)
+
+-- Language used for search
+allLangs :: Array Lang
+allLangs = [ EN
+           , FR
+           , Universal
+           , No_extraction
+           ]
+
+data Lang = FR | EN | Universal | No_extraction
+
+instance showLang :: Show Lang where
+  show FR = "FR"
+  show EN = "EN"
+  show Universal = "All"
+  show No_extraction = "Nothing"
+
+derive instance eqLang :: Eq Lang
+
+readLang :: String -> Maybe Lang
+readLang "FR"  = Just FR
+readLang "EN"  = Just EN
+readLang "All" = Just Universal
+readLang "Nothing" = Just No_extraction
+readLang _           = Nothing
+
+instance encodeJsonLang :: EncodeJson Lang where
+  encodeJson a = encodeJson (show a)
+
+
+-- Language used for the landing page
+data LandingLang = LL_EN | LL_FR

src/Gargantext/Components/Nodes/Home.purs

@@ -10,7 +10,7 @@ import Gargantext.Components.Lang.Landing.EnUS as En
 import Gargantext.Components.Lang.Landing.FrFR as Fr
 import Gargantext.Components.Data.Landing
   (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
-import Gargantext.Components.Data.Lang (Lang(..))
+import Gargantext.Components.Data.Lang (LandingLang(..))
 
 type Props = ()
 
@@ -36,13 +36,13 @@ performAction Enter = void $ setHash "/search"
 performAction Login = void $ setHash "/login"
 performAction SignUp = pure unit
 
-langLandingData :: Lang -> LandingData
-langLandingData FR = Fr.landingData
-langLandingData EN = En.landingData
+langLandingData :: LandingLang -> LandingData
+langLandingData LL_FR = Fr.landingData
+langLandingData LL_EN = En.landingData
 
 ------------------------------------------------------------------------
 
-homeLayout :: Lang -> R.Element
+homeLayout :: LandingLang -> R.Element
 homeLayout lang = R.createElement homeLayoutCpt {landingData} []
   where landingData = langLandingData lang
 

src/Gargantext/Components/Search/SearchBar.purs

@@ -2,18 +2,23 @@ module Gargantext.Components.Search.SearchBar
   ( Props, searchBar, searchBarCpt
   ) where
 
-import Prelude (pure, ($))
 import Data.Tuple.Nested ((/\))
+import Effect (Effect)
 import Reactix as R
 import Reactix.DOM.HTML as H
 
-import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
+import Gargantext.Prelude (Unit, pure, ($))
+
+import Gargantext.Components.Data.Lang (Lang)
+import Gargantext.Components.Search.Types (allDatabases) -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
 import Gargantext.Components.Search.SearchField (Search, searchField)
 import Gargantext.Sessions (Session)
+import Gargantext.Types as GT
 
-type Props = ( session   :: Session
-             , langs     :: Array Lang
+type Props = ( langs     :: Array Lang
+             , onSearch  :: GT.AsyncTaskWithType -> Effect Unit
              , search    :: R.State Search
+             , session   :: Session
              )
 
 searchBar :: Record Props -> R.Element
@@ -22,7 +27,7 @@ searchBar props = R.createElement searchBarCpt props []
 searchBarCpt :: R.Component Props
 searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
   where
-    cpt {session, langs, search: search@(s /\ _)} _ = do
+    cpt {langs, onSearch, search: search@(s /\ _), session} _ = do
       --onSearchChange session s
       pure $ H.div {"style": {"margin" :"10px"}}
-        [ searchField {databases:allDatabases, langs, search, session}]
+        [ searchField {databases:allDatabases, langs, onSearch, search, session}]

src/Gargantext/Components/Search/SearchField.purs

 module Gargantext.Components.Search.SearchField
   ( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex) where
 
-import Prelude (const, map, pure, show, discard, ($), (&&), (<), (<$>), (<>), (==), (<<<), Unit, bind)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (over)
 import Data.String (length)
 import Data.Set as Set
 import Data.Tuple (fst)
 import Data.Tuple.Nested ((/\))
-import DOM.Simple.Console (log2)
-import Effect.Aff (Aff, launchAff_)
+import DOM.Simple.Console (log, log2)
+import Effect.Aff (launchAff_)
 import Effect.Class (liftEffect)
 import Effect (Effect)
-import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Reactix.DOM.HTML as H
 
-import Gargantext.Components.Modals.Modal (modalShow)
-import Gargantext.Components.Search.Types -- (Database(..), readDatabase, Lang(..), readLang, Org(..), readOrg, allOrgs, allIMTorgs, HAL_Filters(..), IMT_org(..))
+import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, ($), (&&), (<), (<$>), (<<<), (<>), (==))
+
+import Gargantext.Components.Data.Lang (Lang)
+import Gargantext.Components.Search.Types (DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, readDatabase, readOrg) -- (Database(..), readDatabase, Lang(..), readLang, Org(..), readOrg, allOrgs, allIMTorgs, HAL_Filters(..), IMT_org(..))
 import Gargantext.Sessions (Session)
+import Gargantext.Types as GT
+import Gargantext.Utils.Reactix as R2
 
 select :: forall props.
           R.IsComponent String props (Array R.Element)
@@ -27,23 +29,26 @@ select :: forall props.
           -> R.Element
 select = R.createElement "select"
 
-type Search = { datafield :: Maybe DataField
-              , term      :: String
+type Search = { databases :: Array Database
+              , datafield :: Maybe DataField
               , lang      :: Maybe Lang
               , node_id   :: Maybe Int
+              , term      :: String
               }
 
 eqSearch :: Search -> Search -> Boolean
-eqSearch s s' =    (s.datafield == s'.datafield)
+eqSearch s s' =    (s.databases == s'.databases)
+                && (s.datafield == s'.datafield)
                 && (s.term == s'.term)
                 && (s.lang == s'.lang)
                 && (s.node_id == s'.node_id)
 
 defaultSearch :: Search
-defaultSearch = { datafield: Nothing
-                , term: ""
-                , lang: Nothing
+defaultSearch = { databases: []
+                , datafield: Nothing
                 , node_id: Nothing
+                , lang: Nothing
+                , term: ""
                 }
 
 type Props =
@@ -51,6 +56,7 @@ type Props =
   ( databases :: Array Database
   , langs     :: Array Lang
   -- State hook for a search, how we get data in and out
+  , onSearch  :: GT.AsyncTaskWithType -> Effect Unit
   , search    :: R.State Search
   , session   :: Session
   )
@@ -63,7 +69,7 @@ searchField p = R.createElement searchFieldComponent p []
 searchFieldComponent :: R.Component Props
 searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
   where
-    cpt props@{search: search@(s /\ _)} _ = do
+    cpt props@{onSearch, search: search@(s /\ _)} _ = do
       pure $
         H.div { className: "search-field-group", style: { width: "100%" } }
           [
@@ -97,7 +103,7 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
           , H.div { className : "panel-footer" }
                 [ if needsLang s.datafield then langNav search props.langs else H.div {} []
                 , H.div {} []
-                , H.div {className: "flex-center"} [submitButton {search, session: props.session}]
+                , H.div {className: "flex-center"} [submitButton {onSearch, search, session: props.session}]
                 ]
           ]
     eqProps :: Record Props -> Record Props -> Boolean
@@ -182,21 +188,6 @@ updateFilter org _ = (Just (External (Just (HAL (Just (IMT imtOrgs'))))))
                   else Set.fromFoldable [org]
 
 ------------------------------------------------------------------------
-langList :: R.State Search -> Array Lang -> R.Element
-langList (lang /\ setLang) langs =
-              H.div { className: "form-group" }
-                   [ H.div {className: "text-primary center"} [H.text "with lang"]
-                   , R2.select { className: "form-control"
-                               , on: { change: \e -> setLang $ _ {lang = lang' e}}
-                               } (liItem <$> langs)
-                   ]
-    where
-      liItem :: Lang -> R.Element
-      liItem l = H.option {className : "text-primary center"} [ H.text (show l) ]
-
-      lang' = readLang <<< R2.unsafeEventValue
-
-
 langNav :: R.State Search -> Array Lang -> R.Element
 langNav ({lang} /\ setSearch) langs =
   R.fragment [ H.div {className: "text-primary center"} [H.text "with lang"]
@@ -329,7 +320,8 @@ searchInputComponent = R.hooksComponent "G.C.S.SearchInput" cpt
 
 type SubmitButtonProps =
   (
-    search :: R.State Search
+    onSearch :: GT.AsyncTaskWithType -> Effect Unit
+  , search :: R.State Search
   , session :: Session
   )
 
@@ -339,41 +331,48 @@ submitButton p = R.createElement submitButtonComponent p []
 submitButtonComponent :: R.Component SubmitButtonProps
 submitButtonComponent = R.hooksComponent "G.C.S.SubmitButton" cpt
   where
-    cpt {search: search /\ setSearch, session} _ =
+    cpt {onSearch, search: (search /\ _), session} _ =
       pure $
         H.button { className: "btn btn-primary"
                  , type: "button"
-                 , on: {click: doSearch session search}
+                 , on: {click: doSearch onSearch session search}
                  , style: { width: "100%" }
                  } [ H.text "Launch Search" ]
 
-    doSearch s q = \_ -> do
+    doSearch os s q = \_ -> do
       log2 "[submitButton] searching" q
-      triggerSearch s q
+      triggerSearch os s q
       --case search.term of
       --  "" -> setSearch $ const defaultSearch
       --  _  -> setSearch $ const q
 
-triggerSearch :: Session -> Search -> Effect Unit
-triggerSearch s q =
+triggerSearch :: (GT.AsyncTaskWithType -> Effect Unit) -> Session -> Search -> Effect Unit
+triggerSearch os s q =
   launchAff_ $ do
 
     liftEffect $ do
       -- log2 "Searching datafield: " $ show q.database
-      log2 "Searching term: " q.term
-      log2 "Searching lang: " q.lang
+      log2 "[triggerSearch] Searching term: " q.term
+      log2 "[triggerSearch] Searching lang: " q.lang
 
-    r <- (performSearch s $ searchQuery q) :: Aff Unit
+    case q.node_id of
+      Nothing -> liftEffect $ log "[triggerSearch] node_id is Nothing, don't know what to do"
+      Just id -> do
+        task <- performSearch s id $ searchQuery q
+        liftEffect $ do
+          log2 "[triggerSearch] task" task
+          os task
 
-    liftEffect $ do
-      log2 "Return:" r
-      modalShow "addCorpus"
+    --liftEffect $ do
+    --  log2 "Return:" r
+    --  modalShow "addCorpus"
 
 searchQuery :: Search -> SearchQuery
 searchQuery {datafield: Nothing, term} =
   over SearchQuery (_ {query=term}) defaultSearchQuery
-searchQuery {datafield, lang, term, node_id} =
-  over SearchQuery (_ { datafield=datafield
+searchQuery {databases, datafield, lang, term, node_id} =
+  over SearchQuery (_ { databases=databases
+                      , datafield=datafield
                       , lang=lang
                       , query=term
                       , node_id=node_id

src/Gargantext/Components/Search/Types.purs

 module Gargantext.Components.Search.Types where
 
-import Prelude (class Eq, class Show, show, ($), (<>), map)
-import Data.Set (Set)
-import Data.Ord
-import Data.Set as Set
 import Data.Array (concat)
-import Data.Argonaut (class EncodeJson, class DecodeJson, jsonEmptyObject, (:=), (~>), encodeJson)
+import Data.Argonaut (class EncodeJson, encodeJson, jsonEmptyObject, (:=), (~>))
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
 import Data.Newtype (class Newtype)
+import Data.Set (Set)
+import Data.Set as Set
 import Data.Tuple (Tuple)
 import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff)
+import URI.Extra.QueryPairs as QP
+import URI.Query as Q
+
+import Gargantext.Prelude (class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>))
+
+import Gargantext.Components.Data.Lang
 import Gargantext.Ends (class ToUrl, backendUrl)
+import Gargantext.Routes as GR
 import Gargantext.Sessions (Session(..), post)
-import Gargantext.Types (class ToQuery, toQuery)
+import Gargantext.Types as GT
 import Gargantext.Utils (id)
-import URI.Extra.QueryPairs as QP
-import URI.Query as Q
 
 ------------------------------------------------------------------------
 class Doc a where
   doc :: a -> String
 
-------------------------------------------------------------------------
--- | Lang search specifications
-allLangs :: Array Lang
-allLangs = [ EN
-           , FR
-           , Universal
-           , No_extraction
-           ]
-
-data Lang = FR | EN | Universal | No_extraction
-
-instance showLang :: Show Lang where
-  show FR = "FR"
-  show EN = "EN"
-  show Universal = "All"
-  show No_extraction = "Nothing"
-
-derive instance eqLang :: Eq Lang
-
-readLang :: String -> Maybe Lang
-readLang "FR"  = Just FR
-readLang "EN"  = Just EN
-readLang "All" = Just Universal
-readLang "Nothing" = Just No_extraction
-readLang _           = Nothing
-
-instance encodeJsonLang :: EncodeJson Lang where
-  encodeJson a = encodeJson (show a)
-
 ------------------------------------------------------------------------
 -- | DataField search specifications
 
@@ -302,14 +276,16 @@ instance showSearchOrder :: Show SearchOrder where
   show ScoreDesc = "ScoreDesc"
 
 ------------------------------------------------------------------------
+
 newtype SearchQuery = SearchQuery
   { query     :: String
+  , databases :: Array Database
   , datafield :: Maybe DataField
+  , files_id  :: Array String
   , lang      :: Maybe Lang
+  , limit     :: Maybe Int
   , node_id   :: Maybe Int
-  , files_id  :: Array String
   , offset    :: Maybe Int
-  , limit     :: Maybe Int
   , order     :: Maybe SearchOrder
   }
 
@@ -318,20 +294,21 @@ derive instance newtypeSearchQuery :: Newtype SearchQuery _
 defaultSearchQuery :: SearchQuery
 defaultSearchQuery = SearchQuery
   { query: ""
+  , databases: []
   , datafield: Nothing
+  , files_id : []
   , lang    : Nothing
+  , limit: Nothing
   , node_id : Nothing
-  , files_id : []
   , offset: Nothing
-  , limit: Nothing
   , order: Nothing
   }
 
 instance toUrlSessionSearchQuery :: ToUrl Session SearchQuery where
   toUrl (Session {backend}) q = backendUrl backend q2
-    where q2 = "new" <> Q.print (toQuery q)
+    where q2 = "new" <> Q.print (GT.toQuery q)
   
-instance searchQueryToQuery :: ToQuery SearchQuery where
+instance searchQueryToQuery :: GT.ToQuery SearchQuery where
   toQuery (SearchQuery {offset, limit, order}) =
     QP.print id id $ QP.QueryPairs
                    $ pair "offset" offset
@@ -342,15 +319,18 @@ instance searchQueryToQuery :: ToQuery SearchQuery where
             [ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ]
 
 instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
-  encodeJson (SearchQuery {query, datafield, node_id, lang})
+  encodeJson (SearchQuery {query, databases, datafield, node_id, lang})
     =  "query"      := query
-    ~> "datafield"  := "" -- fromMaybe "" datafield
+    -- ~> "datafield"  := "" -- fromMaybe "" datafield
+    ~> "databases"  := databases
+    ~> "lang"       := maybe "EN" show lang
     ~> "node_id"    := fromMaybe 0 node_id
     -- ~> "files_id"   := files_id
-    ~> "lang"       := maybe "EN" show lang
     ~> jsonEmptyObject
 
-performSearch :: forall a. DecodeJson a => Session -> SearchQuery -> Aff a
-performSearch session q = post session q q
-
-
+performSearch :: Session -> Int -> SearchQuery -> Aff GT.AsyncTaskWithType
+performSearch session nodeId q = do
+  task <- post session p q
+  pure $ GT.AsyncTaskWithType {task, typ: GT.Query}
+  where
+    p = GR.NodeAPI GT.Corpus (Just nodeId) $ GT.asyncTaskTypePath GT.Query

src/Gargantext/Types.purs

@@ -4,15 +4,16 @@ import Prelude
 import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
 import Data.Array as A
 import Data.Either (Either(..))
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Eq (genericEq)
+import Data.Generic.Rep.Ord (genericCompare)
+import Data.Generic.Rep.Show (genericShow)
 import Data.Int (toNumber)
 import Data.Maybe (Maybe(..), maybe)
+import Data.Tuple (Tuple)
 import Effect.Aff (Aff)
 import Prim.Row (class Union)
 import URI.Query (Query)
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Eq (genericEq)
-import Data.Generic.Rep.Ord (genericCompare)
-import Data.Generic.Rep.Show (genericShow)
 
 newtype SessionId = SessionId String
 
@@ -437,6 +438,16 @@ modeFromString "Institutes" = Just Institutes
 modeFromString "Terms" = Just Terms
 modeFromString _ = Nothing
 
+-- Async tasks
+
+-- corresponds to /add/form/async or /add/query/async
+data AsyncTaskType = Form | Query
+derive instance genericAsyncTaskType :: Generic AsyncTaskType _
+
+asyncTaskTypePath :: AsyncTaskType -> String
+asyncTaskTypePath Form = "add/form/async/"
+asyncTaskTypePath Query = "add/query/async/"
+
 type AsyncTaskID = String
 
 data AsyncTaskStatus = Running | Failed | Finished | Killed
@@ -455,7 +466,7 @@ readAsyncTaskStatus "running"  = Running
 readAsyncTaskStatus _ = Running
 
 newtype AsyncTask = AsyncTask {
-    id :: AsyncTaskID
+    id     :: AsyncTaskID
   , status :: AsyncTaskStatus
   }
 derive instance genericAsyncTask :: Generic AsyncTask _
@@ -467,6 +478,11 @@ instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
     status <- obj .: "status"
     pure $ AsyncTask {id, status}
 
+newtype AsyncTaskWithType = AsyncTaskWithType {
+    task :: AsyncTask
+  , typ  :: AsyncTaskType
+  }
+
 newtype AsyncProgress = AsyncProgress {
     id :: AsyncTaskID
   , log :: Array AsyncTaskLog