diff --git a/src/Gargantext/Components/Forest/Tree.purs b/src/Gargantext/Components/Forest/Tree.purs index 95e8aaf603f51c45e7b0b26bada7ff681118e102..8ef0a71c312471173678870871e88b2658d6653e 100644 --- a/src/Gargantext/Components/Forest/Tree.purs +++ b/src/Gargantext/Components/Forest/Tree.purs @@ -19,7 +19,7 @@ import Gargantext.Components.Login.Types (TreeId) import Gargantext.Ends (Frontends) import Gargantext.Routes (AppRoute) import Gargantext.Sessions (Session) -import Gargantext.Types (AsyncTask(..)) +import Gargantext.Types as GT import Gargantext.Utils.Reactix as R2 import Reactix as R import Reactix.DOM.HTML as H @@ -110,9 +110,9 @@ toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asy ) ] - onAsyncTaskFinish (AsyncTask {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 @@ -142,18 +142,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 "search query, 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 } diff --git a/src/Gargantext/Components/Forest/Tree/Node/Action.purs b/src/Gargantext/Components/Forest/Tree/Node/Action.purs index 2cec11ed6712c253e5cc340df8fb8a6884a61a4a..fcd15221be5ab57277d41eeda98423c03838189e 100644 --- a/src/Gargantext/Components/Forest/Tree/Node/Action.purs +++ b/src/Gargantext/Components/Forest/Tree/Node/Action.purs @@ -9,12 +9,13 @@ import Data.Newtype (class Newtype) import Effect.Aff (Aff) import Gargantext.Routes (SessionRoute(..)) import Gargantext.Sessions (Session, get, put, post, delete) -import Gargantext.Types (NodeType(..), AsyncTask(..)) +import Gargantext.Types as GT import Prelude hiding (div) -data Action = Submit String +data Action = CreateSubmit String GT.NodeType | DeleteNode - | CreateSubmit String NodeType + | SearchQuery GT.AsyncTaskWithType + | Submit String | UploadFile FileType UploadFileContents ----------------------------------------------------- @@ -49,16 +50,16 @@ 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 @@ -74,7 +75,7 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where newtype CreateValue = CreateValue { name :: Name - , nodeType :: NodeType + , nodeType :: GT.NodeType } instance encodeJsonCreateValue :: EncodeJson CreateValue where @@ -85,7 +86,7 @@ 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) @@ -93,7 +94,7 @@ instance ntreeFunctor :: Functor NTree where newtype LNode = LNode { id :: ID , name :: Name - , nodeType :: NodeType + , nodeType :: GT.NodeType } derive instance newtypeLNode :: Newtype LNode _ diff --git a/src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs b/src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs index 7cf1d4a6c0fb50045fc8ece579918df1427394bb..221ed43d1df78f4f9a1ce4f995433d5a261d95d1 100644 --- a/src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs +++ b/src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs @@ -15,9 +15,9 @@ import URI.Extra.QueryPairs as QP import Web.File.FileReader.Aff (readAsText) 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 @@ -83,7 +83,7 @@ uploadButton d id (mContents /\ setMContents) (fileType /\ setFileType) = -- START File Type View type FileTypeProps = ( id :: ID - , nodeType :: NodeType) + , nodeType :: GT.NodeType) fileTypeView :: (Action -> Aff Unit) -> Record FileTypeProps @@ -159,21 +159,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) diff --git a/src/Gargantext/Components/Forest/Tree/Node/Box.purs b/src/Gargantext/Components/Forest/Tree/Node/Box.purs index 6e4704a9f73fa7caf5a2efc3fcfb946080b06e01..b10ce05f4aacebcbb55fa93519545192b145236e 100644 --- a/src/Gargantext/Components/Forest/Tree/Node/Box.purs +++ b/src/Gargantext/Components/Forest/Tree/Node/Box.purs @@ -1,10 +1,11 @@ module Gargantext.Components.Forest.Tree.Node.Box where +import Data.Array as A import Data.Maybe (Maybe(..)) -import Data.Tuple (Tuple(..)) +import Data.Tuple (Tuple(..), snd) import Data.Tuple.Nested ((/\)) import Effect (Effect) -import Effect.Aff (Aff, launchAff) +import Effect.Aff (Aff, launchAff, launchAff_) import Effect.Class (liftEffect) import Effect.Uncurried (mkEffectFn1) import React.SyntheticEvent as E @@ -30,7 +31,7 @@ import Gargantext.Ends (Frontends, url) import Gargantext.Routes (AppRoute) import Gargantext.Routes as Routes import Gargantext.Sessions (Session, sessionId) -import Gargantext.Types (NodeType(..), NodePath(..), fldr, AsyncTask(..)) +import Gargantext.Types as GT import Gargantext.Utils (glyphicon, glyphiconActive) import Gargantext.Utils.Reactix as R2 @@ -38,11 +39,11 @@ import Gargantext.Utils.Reactix as R2 -- Main Node type NodeMainSpanProps = ( id :: ID - , asyncTasks :: Array AsyncTask + , asyncTasks :: Array GT.AsyncTaskWithType , mCurrentRoute :: Maybe AppRoute , name :: Name - , nodeType :: NodeType - , onAsyncTaskFinish :: AsyncTask -> Effect Unit + , nodeType :: GT.NodeType + , onAsyncTaskFinish :: GT.AsyncTaskWithType -> Effect Unit ) nodeMainSpan :: (Action -> Aff Unit) @@ -63,7 +64,7 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p [] pure $ H.span (dropProps droppedFile isDragOver) $ [ folderIcon nodeType folderOpen - , H.a { href: (url frontends (NodePath (sessionId session) nodeType (Just id))) + , H.a { href: (url frontends (GT.NodePath (sessionId session) nodeType (Just id))) , style: {marginLeft: "22px"} } [ nodeText { isSelected: (mCorpusId mCurrentRoute) == (Just id) @@ -79,11 +80,11 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p [] where SettingsBox {show: showBox} = settingsBox nodeType - name' {name, nodeType} = if nodeType == NodeUser then show session else name + name' {name, nodeType} = if nodeType == GT.NodeUser then show session else name folderIcon nodeType folderOpen'@(open /\ _) = H.a {onClick: R2.effToggler folderOpen'} - [ H.i {className: fldr nodeType open} [] ] + [ H.i {className: GT.fldr nodeType open} [] ] popOverIcon false _ _ = H.div {} [] popOverIcon true (popOver /\ setPopOver) (_ /\ setPopupPosition) = @@ -102,7 +103,7 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p [] mNodePopupView _ false _ _ = H.div {} [] mNodePopupView _ _ (Nothing /\ _) _ = H.div {} [] mNodePopupView _ _ _ (Nothing /\ _) = H.div {} [] - mNodePopupView props@{id, nodeType} true popupOpen (Just position /\ _) = + mNodePopupView props@{asyncTasks, id, nodeType} true popupOpen (Just position /\ _) = nodePopupView d { id , action: Nothing , name: name' props @@ -147,7 +148,7 @@ fldr nt open = if open else "fa fa-folder-globe" -- <> color nt --else "glyphicon glyphicon-folder-close" <> color nt where - color NodeUser = "" + color GT.NodeUser = "" color FolderPublic = "" color FolderShared = " text-warning" color _ = " text-danger" @@ -181,7 +182,7 @@ type NodePopupProps = ( id :: ID , action :: Maybe NodeAction , name :: Name - , nodeType :: NodeType + , nodeType :: GT.NodeType , position :: R2.Point , session :: Session ) @@ -209,7 +210,7 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [ [ H.div { className: "panel panel-default" } [ H.div {className: ""} [ H.div { className : "col-md-11"} - [ H.h3 { className: fldr nodeType true} [H.text $ show nodeType] + [ H.h3 { className: GT.fldr nodeType true} [H.text $ show nodeType] , H.p {className: "text-primary center"} [H.text name] ] ] @@ -287,7 +288,7 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [ if isIsTex search'.datafield then H.div { className: "istex-search panel panel-default" } [ - H.h3 { className: fldr nodeType true} [] + H.h3 { className: GT.fldr nodeType true} [] , componentIsTex search ] else @@ -313,7 +314,7 @@ nodePopupView _ p _ = R.createElement el p [] buttonClick :: R.State { id :: ID , name :: Name - , nodeType :: NodeType + , nodeType :: GT.NodeType , action :: Maybe NodeAction } -> (Action -> Aff Unit) @@ -342,16 +343,16 @@ buttonClick (node@{action} /\ setNodePopup) _ todo = H.div {className: "col-md-1 type NodeProps = ( id :: ID , name :: Name - , nodeType :: NodeType + , nodeType :: GT.NodeType ) type Open = Boolean type PanelActionProps = ( id :: ID - , name :: Name - , nodeType :: NodeType , action :: Maybe NodeAction + , name :: Name + , nodeType :: GT.NodeType , session :: Session , search :: R.State Search ) @@ -361,14 +362,14 @@ panelAction :: (Action -> Aff Unit) -> R.State (Maybe NodePopup) -> R.Element panelAction d {id, name, nodeType, action, session, search} p = case action of - (Just (Documentation NodeUser)) -> R.fragment [H.div {style: {margin: "10px"}} [ infoTitle NodeUser + (Just (Documentation GT.NodeUser)) -> R.fragment [H.div {style: {margin: "10px"}} [ infoTitle GT.NodeUser , H.p {} [ H.text "This account is personal"] , H.p {} [ H.text "See the instances terms of uses."] ] ] - (Just (Documentation FolderPrivate)) -> fragmentPT "This folder and its children are private only!" - (Just (Documentation FolderPublic)) -> fragmentPT "Soon, you will be able to build public folders to share your work with the world!" - (Just (Documentation FolderShared)) -> fragmentPT "Soon, you will be able to build teams folders to share your work" + (Just (Documentation GT.FolderPrivate)) -> fragmentPT "This folder and its children are private only!" + (Just (Documentation GT.FolderPublic)) -> fragmentPT "Soon, you will be able to build public folders to share your work with the world!" + (Just (Documentation GT.FolderShared)) -> fragmentPT "Soon, you will be able to build teams folders to share your work" (Just (Documentation x)) -> fragmentPT $ "More information on" <> show nodeType (Just (Link _)) -> fragmentPT "Soon, you will be able to link the corpus with your Annuaire (and reciprocally)." @@ -376,20 +377,27 @@ panelAction d {id, name, nodeType, action, session, search} p = case action of (Just Download) -> fragmentPT "Soon, you will be able to dowload your file here" (Just SearchBox) -> R.fragment [ H.p {"style": {"margin" :"10px"}} [ H.text $ "Search and create a private corpus with the search query as corpus name." ] - , searchBar {session, langs:allLangs, search} + , searchBar {langs: allLangs, onSearch, search, session} ] (Just Delete) -> case nodeType of - NodeUser -> R.fragment [ H.div {style: {margin: "10px"}} [H.text "Yes, we are RGPD compliant! But you can not delete User Node yet (we are still on development). Thanks for your comprehensin."]] + GT.NodeUser -> R.fragment [ H.div {style: {margin: "10px"}} [H.text "Yes, we are RGPD compliant! But you can not delete User Node yet (we are still on development). Thanks for your comprehensin."]] _ -> R.fragment [ H.div {style: {margin: "10px"}} (map (\t -> H.p {} [H.text t]) ["Are your sure you want to delete it ?", "If yes, click again below."]), reallyDelete d] (Just (Add xs)) -> createNodeView d {id, name, nodeType} p xs _ -> H.div {} [] where fragmentPT text = H.div {style: {margin: "10px"}} [H.text text] + onSearch :: GT.AsyncTaskWithType -> Effect Unit + onSearch task = do + _ <- launchAff $ d (SearchQuery task) + -- close popup + snd p $ const Nothing + pure unit + -infoTitle :: NodeType -> R.Element +infoTitle :: GT.NodeType -> R.Element infoTitle nt = H.div {style: {margin: "10px"}} [ H.h3 {} [H.text "Documentation about " ] - , H.h3 {className: fldr nt true} [ H.text $ show nt ] + , H.h3 {className: GT.fldr nt true} [ H.text $ show nt ] ] reallyDelete :: (Action -> Aff Unit) -> R.Element @@ -398,7 +406,8 @@ reallyDelete d = H.div {className: "panel-footer"} , className: "btn glyphicon glyphicon-trash" , id: "delete" , title: "Delete" - , onClick: mkEffectFn1 $ \_ -> launchAff $ d $ DeleteNode} + , on: {click: \_ -> launchAff $ d $ DeleteNode} + } [H.text " Yes, delete!"] ] diff --git a/src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs b/src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs index 1321b6650e823c8eea57aad410a80b08a38bedb1..bc7f64cc8c9c03b5aaf4008b2b4a50bab5cceae0 100644 --- a/src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs +++ b/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 import Reactix.DOM.HTML as H @@ -20,7 +20,7 @@ import Reactix.DOM.HTML as H type Props = ( - asyncTask :: AsyncTask + asyncTask :: GT.AsyncTaskWithType , corpusId :: ID , onFinish :: Unit -> Effect Unit , session :: Session @@ -33,17 +33,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 @@ -67,7 +67,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 diff --git a/src/Gargantext/Components/Search/SearchBar.purs b/src/Gargantext/Components/Search/SearchBar.purs index ec9fcf38e4e23453aa481eb82b3e74582711d751..a86fa4e104d00871d27b95c16ac169c4f1dcbaff 100644 --- a/src/Gargantext/Components/Search/SearchBar.purs +++ b/src/Gargantext/Components/Search/SearchBar.purs @@ -2,18 +2,22 @@ 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.Prelude + import Gargantext.Components.Search.Types -- (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 +26,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}] diff --git a/src/Gargantext/Components/Search/SearchField.purs b/src/Gargantext/Components/Search/SearchField.purs index bebfc04453a87882621556ea0de4d6712733ff48..7e1cb799751af597ebe76d70f09a6d3cffe3b2be 100644 --- a/src/Gargantext/Components/Search/SearchField.purs +++ b/src/Gargantext/Components/Search/SearchField.purs @@ -1,24 +1,26 @@ 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 DOM.Simple.Console (log, log2) import Effect.Aff (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.Prelude + 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.Sessions (Session) +import Gargantext.Types as GT +import Gargantext.Utils.Reactix as R2 select :: forall props. R.IsComponent String props (Array R.Element) @@ -51,6 +53,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 +66,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 +100,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 +185,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 +317,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,40 +328,46 @@ 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} = +searchQuery {databases, datafield, lang, term, node_id} = over SearchQuery (_ { datafield=datafield , lang=lang , query=term diff --git a/src/Gargantext/Components/Search/Types.purs b/src/Gargantext/Components/Search/Types.purs index 76f6cb83a634aa901000ce353d1da85e5711ebeb..346c9034f013171e72b996436f8882569c424244 100644 --- a/src/Gargantext/Components/Search/Types.purs +++ b/src/Gargantext/Components/Search/Types.purs @@ -1,22 +1,24 @@ 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.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 @@ -329,9 +331,9 @@ defaultSearchQuery = SearchQuery 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 @@ -350,7 +352,9 @@ instance encodeJsonSearchQuery :: EncodeJson SearchQuery where ~> "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 diff --git a/src/Gargantext/Types.purs b/src/Gargantext/Types.purs index 654e94db791fe32e569338136c33d736dc12e094..72074328a4994004266ab99571cc3f63264c59e3 100644 --- a/src/Gargantext/Types.purs +++ b/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