Commit 842067f6 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Search] async corpus query work

parent 33bb55e6
......@@ -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 }
......
......@@ -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 _
......
......@@ -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)
......
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!"]
]
......@@ -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
......@@ -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}]
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
......
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
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment