Commit c483ceb2 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

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

parents 8d608e2d 10f470b7
...@@ -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 }
......
...@@ -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 }
......
...@@ -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 _
......
...@@ -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
...@@ -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)
......
...@@ -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
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
...@@ -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 (LandingLang(..))
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 :: LandingLang -> LandingData
langLandingData FR = Fr.landingData langLandingData LL_FR = Fr.landingData
langLandingData EN = En.landingData langLandingData LL_EN = En.landingData
------------------------------------------------------------------------ ------------------------------------------------------------------------
homeLayout :: Lang -> R.Element homeLayout :: LandingLang -> R.Element
homeLayout lang = R.createElement homeLayoutCpt {landingData} [] homeLayout lang = R.createElement homeLayoutCpt {landingData} []
where landingData = langLandingData lang where landingData = langLandingData lang
......
...@@ -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}]
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, log2)
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 = { datafield :: Maybe DataField type Search = { databases :: 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
......
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, databases, datafield, 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
...@@ -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
......
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