Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
6fe64380
Commit
6fe64380
authored
Jan 28, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
[FIX] merge
parents
3b1fe0df
c483ceb2
Changes
14
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
250 additions
and
194 deletions
+250
-194
packages.json
.psc-package/local/.set/packages.json
+2
-2
packages.dhall
packages.dhall
+1
-1
App.purs
src/Gargantext/Components/App.purs
+6
-5
Tree.purs
src/Gargantext/Components/Forest/Tree.purs
+15
-9
Action.purs
src/Gargantext/Components/Forest/Tree/Node/Action.purs
+14
-12
Upload.purs
...Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
+19
-17
Box.purs
src/Gargantext/Components/Forest/Tree/Node/Box.purs
+37
-28
ProgressBar.purs
src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs
+10
-9
Lang.purs
src/Gargantext/Components/Lang/Data/Lang.purs
+36
-1
Home.purs
src/Gargantext/Components/Nodes/Home.purs
+5
-5
SearchBar.purs
src/Gargantext/Components/Search/SearchBar.purs
+11
-6
SearchField.purs
src/Gargantext/Components/Search/SearchField.purs
+43
-44
Types.purs
src/Gargantext/Components/Search/Types.purs
+30
-50
Types.purs
src/Gargantext/Types.purs
+21
-5
No files found.
.psc-package/local/.set/packages.json
View file @
6fe64380
...
@@ -637,7 +637,7 @@
...
@@ -637,7 +637,7 @@
"unsafe-coerce"
"unsafe-coerce"
],
],
"repo"
:
"https://github.com/irresponsible/purescript-dom-simple"
,
"repo"
:
"https://github.com/irresponsible/purescript-dom-simple"
,
"version"
:
"v0.2.
4
"
"version"
:
"v0.2.
6
"
},
},
"dotenv"
:
{
"dotenv"
:
{
"dependencies"
:
[
"dependencies"
:
[
...
@@ -3336,4 +3336,4 @@
...
@@ -3336,4 +3336,4 @@
"repo"
:
"https://github.com/paf31/purescript-yargs.git"
,
"repo"
:
"https://github.com/paf31/purescript-yargs.git"
,
"version"
:
"v4.0.0"
"version"
:
"v4.0.0"
}
}
}
}
\ No newline at end of file
packages.dhall
View file @
6fe64380
...
@@ -185,7 +185,7 @@ let additions =
...
@@ -185,7 +185,7 @@ let additions =
, "unsafe-coerce"
, "unsafe-coerce"
]
]
"https://github.com/irresponsible/purescript-dom-simple"
"https://github.com/irresponsible/purescript-dom-simple"
"v0.2.
4
"
"v0.2.
6
"
, dom-filereader =
, dom-filereader =
mkPackage
mkPackage
[ "aff", "arraybuffer-types", "web-file", "web-html" ]
[ "aff", "arraybuffer-types", "web-file", "web-html" ]
...
...
src/Gargantext/Components/App.purs
View file @
6fe64380
...
@@ -6,7 +6,10 @@ import Data.Array (fromFoldable)
...
@@ -6,7 +6,10 @@ import Data.Array (fromFoldable)
import Data.Foldable (intercalate)
import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe')
import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd)
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.Folder (folder)
import Gargantext.Components.Forest (forest)
import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.GraphExplorer (explorerLayout)
...
@@ -27,8 +30,6 @@ import Gargantext.Routes (AppRoute(..))
...
@@ -27,8 +30,6 @@ import Gargantext.Routes (AppRoute(..))
import Gargantext.Sessions (Sessions, useSessions)
import Gargantext.Sessions (Sessions, useSessions)
import Gargantext.Sessions as Sessions
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
-- TODO (what does this mean?)
-- TODO (what does this mean?)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
...
@@ -49,12 +50,12 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
...
@@ -49,12 +50,12 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
let forested = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
let forested = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
let mCurrentRoute = fst route
let mCurrentRoute = fst route
let backends = fromFoldable defaultBackends
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
pure $ case fst showLogin of
true -> forested $ login { sessions, backends, visible: showLogin }
true -> forested $ login { sessions, backends, visible: showLogin }
false ->
false ->
case fst route of
case fst route of
Home -> forested $ homeLayout EN
Home -> forested $ homeLayout
LL_
EN
Login -> login { sessions, backends, visible: showLogin }
Login -> login { sessions, backends, visible: showLogin }
Folder sid _ -> withSession sid $ \_ -> forested (folder {})
Folder sid _ -> withSession sid $ \_ -> forested (folder {})
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
...
...
src/Gargantext/Components/Forest/Tree.purs
View file @
6fe64380
...
@@ -12,6 +12,9 @@ import Data.Tuple (Tuple(..), fst, snd)
...
@@ -12,6 +12,9 @@ import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
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.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
import Gargantext.Components.Loader (loader)
import Gargantext.Components.Loader (loader)
...
@@ -19,9 +22,8 @@ import Gargantext.Components.Login.Types (TreeId)
...
@@ -19,9 +22,8 @@ import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Ends (Frontends)
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session)
import Gargantext.Sessions (Session)
import Gargantext.Types (AsyncTask(..))
import Gargantext.Types as GT
import Reactix as R
import Gargantext.Utils.Reactix as R2
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
------------------------------------------------------------------------
type Props = ( root :: ID
type Props = ( root :: ID
...
@@ -117,9 +119,9 @@ toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asy
...
@@ -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
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
childNodes :: Session
...
@@ -149,18 +151,22 @@ performAction :: Session
...
@@ -149,18 +151,22 @@ performAction :: Session
-> R.State Tree
-> R.State Tree
-> Action
-> Action
-> Aff Unit
-> 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
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode session id
void $ deleteNode session id
liftEffect $ setReload (_ + 1)
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
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode session id $ RenameValue {name}
void $ renameNode session id $ RenameValue {name}
liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
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
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (UploadFile fileType contents) = do
task <- uploadFile session id fileType contents
task <- uploadFile session id fileType contents
liftEffect $ setTree $ \t@{asyncTasks} -> t { asyncTasks = A.cons task asyncTasks }
liftEffect $ setTree $ \t@{asyncTasks} -> t { asyncTasks = A.cons task asyncTasks }
...
...
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @
6fe64380
...
@@ -7,15 +7,17 @@ import Data.Generic.Rep.Show (genericShow)
...
@@ -7,15 +7,17 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Prelude hiding (div)
import Gargantext.Components.Data.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Types (NodeType(..), AsyncTask(..))
import Gargantext.Types as GT
import Gargantext.Components.Search.Types (Lang(..))
import Prelude hiding (div)
data Action =
Submit String
data Action =
CreateSubmit String GT.NodeType
| DeleteNode
| DeleteNode
| CreateSubmit String NodeType
| SearchQuery GT.AsyncTaskWithType
| Submit String
| UploadFile FileType UploadFileContents
| UploadFile FileType UploadFileContents
-----------------------------------------------------
-----------------------------------------------------
...
@@ -52,16 +54,16 @@ type Reload = Int
...
@@ -52,16 +54,16 @@ type Reload = Int
newtype UploadFileContents = UploadFileContents String
newtype UploadFileContents = UploadFileContents String
createNode :: Session -> ID -> CreateValue -> Aff (Array ID)
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 -> 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 -> 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 -> 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
newtype RenameValue = RenameValue
...
@@ -77,7 +79,7 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
...
@@ -77,7 +79,7 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
newtype CreateValue = CreateValue
newtype CreateValue = CreateValue
{
{
name :: Name
name :: Name
, nodeType :: NodeType
, nodeType ::
GT.
NodeType
}
}
instance encodeJsonCreateValue :: EncodeJson CreateValue where
instance encodeJsonCreateValue :: EncodeJson CreateValue where
...
@@ -88,14 +90,14 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
...
@@ -88,14 +90,14 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
data NTree a = NTree a (Array (NTree a))
data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode
type FTree = NTree LNode
type Tree = { tree :: FTree, asyncTasks :: Array
AsyncTask
}
type Tree = { tree :: FTree, asyncTasks :: Array
GT.AsyncTaskWithType
}
instance ntreeFunctor :: Functor NTree where
instance ntreeFunctor :: Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary)
map f (NTree x ary) = NTree (f x) (map (map f) ary)
newtype LNode = LNode { id :: ID
newtype LNode = LNode { id :: ID
, name :: Name
, name :: Name
, nodeType :: NodeType
, nodeType ::
GT.
NodeType
}
}
derive instance newtypeLNode :: Newtype LNode _
derive instance newtypeLNode :: Newtype LNode _
...
...
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @
6fe64380
...
@@ -13,11 +13,12 @@ import Reactix as R
...
@@ -13,11 +13,12 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsText)
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.Components.Forest.Tree.Node.Action
import Gargantext.Routes
(SessionRoute(..))
import Gargantext.Routes
as GR
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types
(class ToQuery, AsyncTask, NodeType(..))
import Gargantext.Types
as GT
import Gargantext.Utils (id)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
...
@@ -50,11 +51,11 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
...
@@ -50,11 +51,11 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
, H.div {} [ R2.select {className: "col-md-12 form-control"
, H.div {} [ R2.select {className: "col-md-12 form-control"
, on: {change: onChangeFileType fileType}
, on: {change: onChangeFileType fileType}
}
}
( map renderOption [ CSV
( map renderOption
FT
[ CSV
, CSV_HAL
, CSV_HAL
, WOS
, WOS
, PresseRIS
, PresseRIS
]
]
)
)
]
]
...
@@ -67,8 +68,8 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
...
@@ -67,8 +68,8 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
, H.div {} [ uploadButton d id mContents fileType lang ]
, H.div {} [ uploadButton d id mContents fileType lang ]
]
]
renderOption
Lang
:: FileType -> R.Element
renderOption
FT
:: FileType -> R.Element
renderOption opt = H.option {} [ H.text $ show opt ]
renderOption
FT
opt = H.option {} [ H.text $ show opt ]
renderOptionLang :: Lang -> R.Element
renderOptionLang :: Lang -> R.Element
renderOptionLang opt = H.option {} [ H.text $ show opt ]
renderOptionLang opt = H.option {} [ H.text $ show opt ]
...
@@ -121,7 +122,7 @@ uploadButton d id (mContents /\ setMContents) (fileType /\ setFileType) (lang /\
...
@@ -121,7 +122,7 @@ uploadButton d id (mContents /\ setMContents) (fileType /\ setFileType) (lang /\
-- START File Type View
-- START File Type View
type FileTypeProps =
type FileTypeProps =
( id :: ID
( id :: ID
, nodeType :: NodeType)
, nodeType ::
GT.
NodeType)
fileTypeView :: (Action -> Aff Unit)
fileTypeView :: (Action -> Aff Unit)
-> Record FileTypeProps
-> Record FileTypeProps
...
@@ -200,21 +201,22 @@ newtype FileUploadQuery = FileUploadQuery {
...
@@ -200,21 +201,22 @@ newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
fileType :: FileType
}
}
derive instance newtypeSearchQuery :: Newtype FileUploadQuery _
derive instance newtypeSearchQuery :: Newtype FileUploadQuery _
instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
instance fileUploadQueryToQuery ::
GT.
ToQuery FileUploadQuery where
toQuery (FileUploadQuery {fileType}) =
toQuery (FileUploadQuery {fileType}) =
QP.print id id $ QP.QueryPairs $
QP.print id id $ QP.QueryPairs $
pair "fileType" fileType
pair "fileType" fileType
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
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) ]
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff AsyncTask
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff GT.AsyncTaskWithType
uploadFile session id fileType (UploadFileContents fileContents) =
uploadFile session id fileType (UploadFileContents fileContents) = do
postWwwUrlencoded session p bodyParams
task <- postWwwUrlencoded session p bodyParams
pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
--postMultipartFormData session p fileContents
--postMultipartFormData session p fileContents
where
where
q = FileUploadQuery { fileType: fileType }
q = FileUploadQuery { fileType: fileType }
--p = NodeAPI Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
--p = NodeAPI
GT.
Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p =
NodeAPI Corpus (Just id) $ "add/form/async" -- <> Q.print (toQuery q)
p =
GR.NodeAPI GT.Corpus (Just id) $ GT.asyncTaskTypePath GT.Form
bodyParams = [
bodyParams = [
Tuple "_wf_data" (Just fileContents)
Tuple "_wf_data" (Just fileContents)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_filetype" (Just $ show fileType)
...
...
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @
6fe64380
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs
View file @
6fe64380
...
@@ -12,7 +12,7 @@ import Effect.Timer (clearInterval, setInterval)
...
@@ -12,7 +12,7 @@ import Effect.Timer (clearInterval, setInterval)
import Gargantext.Components.Forest.Tree.Node.Action (ID)
import Gargantext.Components.Forest.Tree.Node.Action (ID)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Sessions (Session, get)
import Gargantext.Types
(AsyncProgress(..), AsyncTask(..), AsyncTaskStatus(..), NodeType(..), progressPercent)
import Gargantext.Types
as GT
import Partial.Unsafe (unsafePartial)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix as R
...
@@ -21,7 +21,7 @@ import Reactix.DOM.HTML as H
...
@@ -21,7 +21,7 @@ import Reactix.DOM.HTML as H
type Props =
type Props =
(
(
asyncTask ::
AsyncTask
asyncTask ::
GT.AsyncTaskWithType
, corpusId :: ID
, corpusId :: ID
, onFinish :: Unit -> Effect Unit
, onFinish :: Unit -> Effect Unit
, session :: Session
, session :: Session
...
@@ -34,17 +34,17 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p []
...
@@ -34,17 +34,17 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p []
asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
where
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
(progress /\ setProgress) <- R.useState' 0.0
intervalIdRef <- R.useRef Nothing
intervalIdRef <- R.useRef Nothing
R.useEffectOnce' $ do
R.useEffectOnce' $ do
intervalId <- setInterval 1000 $ do
intervalId <- setInterval 1000 $ do
launchAff_ $ do
launchAff_ $ do
asyncProgress@(AsyncProgress {status}) <- queryProgress props
asyncProgress@(
GT.
AsyncProgress {status}) <- queryProgress props
liftEffect do
liftEffect do
setProgress \p -> min 100.0 $ progressPercent asyncProgress
setProgress \p -> min 100.0 $
GT.
progressPercent asyncProgress
if (status ==
Finished) || (status == Killed) || (status ==
Failed) then do
if (status ==
GT.Finished) || (status == GT.Killed) || (status == GT.
Failed) then do
_ <- case R.readRef intervalIdRef of
_ <- case R.readRef intervalIdRef of
Nothing -> pure unit
Nothing -> pure unit
Just iid -> clearInterval iid
Just iid -> clearInterval iid
...
@@ -68,7 +68,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
...
@@ -68,7 +68,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
toInt :: Number -> Int
toInt :: Number -> Int
toInt n = unsafePartial $ fromJust $ fromNumber n
toInt n = unsafePartial $ fromJust $ fromNumber n
queryProgress :: Record Props -> Aff AsyncProgress
queryProgress :: Record Props -> Aff
GT.
AsyncProgress
queryProgress {asyncTask:
AsyncTask {id
}, corpusId, session} = get session p
queryProgress {asyncTask:
GT.AsyncTaskWithType {task: GT.AsyncTask {id}, typ
}, corpusId, session} = get session p
where
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
View file @
6fe64380
module Gargantext.Components.Data.Lang where
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
View file @
6fe64380
...
@@ -10,7 +10,7 @@ import Gargantext.Components.Lang.Landing.EnUS as En
...
@@ -10,7 +10,7 @@ import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing
import Gargantext.Components.Data.Landing
(BlockText(..), BlockTexts(..), Button(..), LandingData(..))
(BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Data.Lang (Lan
dingLan
g(..))
type Props = ()
type Props = ()
...
@@ -36,13 +36,13 @@ performAction Enter = void $ setHash "/search"
...
@@ -36,13 +36,13 @@ performAction Enter = void $ setHash "/search"
performAction Login = void $ setHash "/login"
performAction Login = void $ setHash "/login"
performAction SignUp = pure unit
performAction SignUp = pure unit
langLandingData :: Lang -> LandingData
langLandingData :: Lan
dingLan
g -> LandingData
langLandingData FR = Fr.landingData
langLandingData
LL_
FR = Fr.landingData
langLandingData EN = En.landingData
langLandingData
LL_
EN = En.landingData
------------------------------------------------------------------------
------------------------------------------------------------------------
homeLayout :: Lang -> R.Element
homeLayout :: Lan
dingLan
g -> R.Element
homeLayout lang = R.createElement homeLayoutCpt {landingData} []
homeLayout lang = R.createElement homeLayoutCpt {landingData} []
where landingData = langLandingData lang
where landingData = langLandingData lang
...
...
src/Gargantext/Components/Search/SearchBar.purs
View file @
6fe64380
...
@@ -2,18 +2,23 @@ module Gargantext.Components.Search.SearchBar
...
@@ -2,18 +2,23 @@ module Gargantext.Components.Search.SearchBar
( Props, searchBar, searchBarCpt
( Props, searchBar, searchBarCpt
) where
) where
import Prelude (pure, ($))
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
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.Components.Search.SearchField (Search, searchField)
import Gargantext.Sessions (Session)
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
type Props = (
session :: Session
type Props = (
langs :: Array Lang
,
langs :: Array Lang
,
onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: R.State Search
, search :: R.State Search
, session :: Session
)
)
searchBar :: Record Props -> R.Element
searchBar :: Record Props -> R.Element
...
@@ -22,7 +27,7 @@ searchBar props = R.createElement searchBarCpt props []
...
@@ -22,7 +27,7 @@ searchBar props = R.createElement searchBarCpt props []
searchBarCpt :: R.Component Props
searchBarCpt :: R.Component Props
searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
where
where
cpt {
session, langs, search: search@(s /\ _)
} _ = do
cpt {
langs, onSearch, search: search@(s /\ _), session
} _ = do
--onSearchChange session s
--onSearchChange session s
pure $ H.div {"style": {"margin" :"10px"}}
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
View file @
6fe64380
module Gargantext.Components.Search.SearchField
module Gargantext.Components.Search.SearchField
( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex) where
( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex) where
import Prelude (const, map, pure, show, discard, ($), (&&), (<), (<$>), (<>), (==), (<<<), Unit, bind)
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (over)
import Data.Newtype (over)
import Data.String (length)
import Data.String (length)
import Data.Set as Set
import Data.Set as Set
import Data.Tuple (fst)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import DOM.Simple.Console (log
, log
2)
import Effect.Aff (
Aff,
launchAff_)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Effect (Effect)
import Effect (Effect)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, ($), (&&), (<), (<$>), (<<<), (<>), (==))
import Gargantext.Components.Search.Types -- (Database(..), readDatabase, Lang(..), readLang, Org(..), readOrg, allOrgs, allIMTorgs, HAL_Filters(..), IMT_org(..))
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.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
select :: forall props.
select :: forall props.
R.IsComponent String props (Array R.Element)
R.IsComponent String props (Array R.Element)
...
@@ -27,23 +29,26 @@ select :: forall props.
...
@@ -27,23 +29,26 @@ select :: forall props.
-> R.Element
-> R.Element
select = R.createElement "select"
select = R.createElement "select"
type Search = { data
field :: Maybe DataField
type Search = { data
bases :: Array Database
,
term :: String
,
datafield :: Maybe DataField
, lang :: Maybe Lang
, lang :: Maybe Lang
, node_id :: Maybe Int
, node_id :: Maybe Int
, term :: String
}
}
eqSearch :: Search -> Search -> Boolean
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.term == s'.term)
&& (s.lang == s'.lang)
&& (s.lang == s'.lang)
&& (s.node_id == s'.node_id)
&& (s.node_id == s'.node_id)
defaultSearch :: Search
defaultSearch :: Search
defaultSearch = { datafield: Nothing
defaultSearch = { databases: []
, term: ""
, datafield: Nothing
, lang: Nothing
, node_id: Nothing
, node_id: Nothing
, lang: Nothing
, term: ""
}
}
type Props =
type Props =
...
@@ -51,6 +56,7 @@ type Props =
...
@@ -51,6 +56,7 @@ type Props =
( databases :: Array Database
( databases :: Array Database
, langs :: Array Lang
, langs :: Array Lang
-- State hook for a search, how we get data in and out
-- State hook for a search, how we get data in and out
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: R.State Search
, search :: R.State Search
, session :: Session
, session :: Session
)
)
...
@@ -63,7 +69,7 @@ searchField p = R.createElement searchFieldComponent p []
...
@@ -63,7 +69,7 @@ searchField p = R.createElement searchFieldComponent p []
searchFieldComponent :: R.Component Props
searchFieldComponent :: R.Component Props
searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
where
where
cpt props@{search: search@(s /\ _)} _ = do
cpt props@{
onSearch,
search: search@(s /\ _)} _ = do
pure $
pure $
H.div { className: "search-field-group", style: { width: "100%" } }
H.div { className: "search-field-group", style: { width: "100%" } }
[
[
...
@@ -97,7 +103,7 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
...
@@ -97,7 +103,7 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
, H.div { className : "panel-footer" }
, H.div { className : "panel-footer" }
[ if needsLang s.datafield then langNav search props.langs else H.div {} []
[ if needsLang s.datafield then langNav search props.langs else H.div {} []
, 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
eqProps :: Record Props -> Record Props -> Boolean
...
@@ -182,21 +188,6 @@ updateFilter org _ = (Just (External (Just (HAL (Just (IMT imtOrgs'))))))
...
@@ -182,21 +188,6 @@ updateFilter org _ = (Just (External (Just (HAL (Just (IMT imtOrgs'))))))
else Set.fromFoldable [org]
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 :: R.State Search -> Array Lang -> R.Element
langNav ({lang} /\ setSearch) langs =
langNav ({lang} /\ setSearch) langs =
R.fragment [ H.div {className: "text-primary center"} [H.text "with lang"]
R.fragment [ H.div {className: "text-primary center"} [H.text "with lang"]
...
@@ -329,7 +320,8 @@ searchInputComponent = R.hooksComponent "G.C.S.SearchInput" cpt
...
@@ -329,7 +320,8 @@ searchInputComponent = R.hooksComponent "G.C.S.SearchInput" cpt
type SubmitButtonProps =
type SubmitButtonProps =
(
(
search :: R.State Search
onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: R.State Search
, session :: Session
, session :: Session
)
)
...
@@ -339,41 +331,48 @@ submitButton p = R.createElement submitButtonComponent p []
...
@@ -339,41 +331,48 @@ submitButton p = R.createElement submitButtonComponent p []
submitButtonComponent :: R.Component SubmitButtonProps
submitButtonComponent :: R.Component SubmitButtonProps
submitButtonComponent = R.hooksComponent "G.C.S.SubmitButton" cpt
submitButtonComponent = R.hooksComponent "G.C.S.SubmitButton" cpt
where
where
cpt {
search: search /\ setSearch
, session} _ =
cpt {
onSearch, search: (search /\ _)
, session} _ =
pure $
pure $
H.button { className: "btn btn-primary"
H.button { className: "btn btn-primary"
, type: "button"
, type: "button"
, on: {click: doSearch session search}
, on: {click: doSearch
onSearch
session search}
, style: { width: "100%" }
, style: { width: "100%" }
} [ H.text "Launch Search" ]
} [ H.text "Launch Search" ]
doSearch s q = \_ -> do
doSearch
os
s q = \_ -> do
log2 "[submitButton] searching" q
log2 "[submitButton] searching" q
triggerSearch s q
triggerSearch
os
s q
--case search.term of
--case search.term of
-- "" -> setSearch $ const defaultSearch
-- "" -> setSearch $ const defaultSearch
-- _ -> setSearch $ const q
-- _ -> setSearch $ const q
triggerSearch :: Session -> Search -> Effect Unit
triggerSearch ::
(GT.AsyncTaskWithType -> Effect Unit) ->
Session -> Search -> Effect Unit
triggerSearch s q =
triggerSearch
os
s q =
launchAff_ $ do
launchAff_ $ do
liftEffect $ do
liftEffect $ do
-- log2 "Searching datafield: " $ show q.database
-- log2 "Searching datafield: " $ show q.database
log2 "Searching term: " q.term
log2 "
[triggerSearch]
Searching term: " q.term
log2 "Searching lang: " q.lang
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
--
liftEffect $ do
log2 "Return:" r
--
log2 "Return:" r
modalShow "addCorpus"
--
modalShow "addCorpus"
searchQuery :: Search -> SearchQuery
searchQuery :: Search -> SearchQuery
searchQuery {datafield: Nothing, term} =
searchQuery {datafield: Nothing, term} =
over SearchQuery (_ {query=term}) defaultSearchQuery
over SearchQuery (_ {query=term}) defaultSearchQuery
searchQuery {datafield, lang, term, node_id} =
searchQuery {databases, datafield, lang, term, node_id} =
over SearchQuery (_ { datafield=datafield
over SearchQuery (_ { databases=databases
, datafield=datafield
, lang=lang
, lang=lang
, query=term
, query=term
, node_id=node_id
, node_id=node_id
...
...
src/Gargantext/Components/Search/Types.purs
View file @
6fe64380
module Gargantext.Components.Search.Types where
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.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.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype)
import Data.Newtype (class Newtype)
import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (Tuple)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
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.Ends (class ToUrl, backendUrl)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post)
import Gargantext.Sessions (Session(..), post)
import Gargantext.Types
(class ToQuery, toQuery)
import Gargantext.Types
as GT
import Gargantext.Utils (id)
import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP
import URI.Query as Q
------------------------------------------------------------------------
------------------------------------------------------------------------
class Doc a where
class Doc a where
doc :: a -> String
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
-- | DataField search specifications
...
@@ -302,14 +276,16 @@ instance showSearchOrder :: Show SearchOrder where
...
@@ -302,14 +276,16 @@ instance showSearchOrder :: Show SearchOrder where
show ScoreDesc = "ScoreDesc"
show ScoreDesc = "ScoreDesc"
------------------------------------------------------------------------
------------------------------------------------------------------------
newtype SearchQuery = SearchQuery
newtype SearchQuery = SearchQuery
{ query :: String
{ query :: String
, databases :: Array Database
, datafield :: Maybe DataField
, datafield :: Maybe DataField
, files_id :: Array String
, lang :: Maybe Lang
, lang :: Maybe Lang
, limit :: Maybe Int
, node_id :: Maybe Int
, node_id :: Maybe Int
, files_id :: Array String
, offset :: Maybe Int
, offset :: Maybe Int
, limit :: Maybe Int
, order :: Maybe SearchOrder
, order :: Maybe SearchOrder
}
}
...
@@ -318,20 +294,21 @@ derive instance newtypeSearchQuery :: Newtype SearchQuery _
...
@@ -318,20 +294,21 @@ derive instance newtypeSearchQuery :: Newtype SearchQuery _
defaultSearchQuery :: SearchQuery
defaultSearchQuery :: SearchQuery
defaultSearchQuery = SearchQuery
defaultSearchQuery = SearchQuery
{ query: ""
{ query: ""
, databases: []
, datafield: Nothing
, datafield: Nothing
, files_id : []
, lang : Nothing
, lang : Nothing
, limit: Nothing
, node_id : Nothing
, node_id : Nothing
, files_id : []
, offset: Nothing
, offset: Nothing
, limit: Nothing
, order: Nothing
, order: Nothing
}
}
instance toUrlSessionSearchQuery :: ToUrl Session SearchQuery where
instance toUrlSessionSearchQuery :: ToUrl Session SearchQuery where
toUrl (Session {backend}) q = backendUrl backend q2
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}) =
toQuery (SearchQuery {offset, limit, order}) =
QP.print id id $ QP.QueryPairs
QP.print id id $ QP.QueryPairs
$ pair "offset" offset
$ pair "offset" offset
...
@@ -342,15 +319,18 @@ instance searchQueryToQuery :: ToQuery SearchQuery where
...
@@ -342,15 +319,18 @@ instance searchQueryToQuery :: ToQuery SearchQuery where
[ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ]
[ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ]
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery {query, datafield, node_id, lang})
encodeJson (SearchQuery {query, data
bases, data
field, node_id, lang})
= "query" := query
= "query" := query
~> "datafield" := "" -- fromMaybe "" datafield
-- ~> "datafield" := "" -- fromMaybe "" datafield
~> "databases" := databases
~> "lang" := maybe "EN" show lang
~> "node_id" := fromMaybe 0 node_id
~> "node_id" := fromMaybe 0 node_id
-- ~> "files_id" := files_id
-- ~> "files_id" := files_id
~> "lang" := maybe "EN" show lang
~> jsonEmptyObject
~> jsonEmptyObject
performSearch :: forall a. DecodeJson a => Session -> SearchQuery -> Aff a
performSearch :: Session -> Int -> SearchQuery -> Aff GT.AsyncTaskWithType
performSearch session q = post session q q
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
View file @
6fe64380
...
@@ -4,15 +4,16 @@ import Prelude
...
@@ -4,15 +4,16 @@ import Prelude
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Array as A
import Data.Array as A
import Data.Either (Either(..))
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.Int (toNumber)
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple)
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Prim.Row (class Union)
import Prim.Row (class Union)
import URI.Query (Query)
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
newtype SessionId = SessionId String
...
@@ -437,6 +438,16 @@ modeFromString "Institutes" = Just Institutes
...
@@ -437,6 +438,16 @@ modeFromString "Institutes" = Just Institutes
modeFromString "Terms" = Just Terms
modeFromString "Terms" = Just Terms
modeFromString _ = Nothing
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
type AsyncTaskID = String
data AsyncTaskStatus = Running | Failed | Finished | Killed
data AsyncTaskStatus = Running | Failed | Finished | Killed
...
@@ -455,7 +466,7 @@ readAsyncTaskStatus "running" = Running
...
@@ -455,7 +466,7 @@ readAsyncTaskStatus "running" = Running
readAsyncTaskStatus _ = Running
readAsyncTaskStatus _ = Running
newtype AsyncTask = AsyncTask {
newtype AsyncTask = AsyncTask {
id :: AsyncTaskID
id
:: AsyncTaskID
, status :: AsyncTaskStatus
, status :: AsyncTaskStatus
}
}
derive instance genericAsyncTask :: Generic AsyncTask _
derive instance genericAsyncTask :: Generic AsyncTask _
...
@@ -467,6 +478,11 @@ instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
...
@@ -467,6 +478,11 @@ instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
status <- obj .: "status"
status <- obj .: "status"
pure $ AsyncTask {id, status}
pure $ AsyncTask {id, status}
newtype AsyncTaskWithType = AsyncTaskWithType {
task :: AsyncTask
, typ :: AsyncTaskType
}
newtype AsyncProgress = AsyncProgress {
newtype AsyncProgress = AsyncProgress {
id :: AsyncTaskID
id :: AsyncTaskID
, log :: Array AsyncTaskLog
, log :: Array AsyncTaskLog
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment