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)
import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd)
import Gargantext.Components.Data.Lang (Lang(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Data.Lang (LandingLang(..))
import Gargantext.Components.Folder (folder)
import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout)
......@@ -27,8 +30,6 @@ import Gargantext.Routes (AppRoute(..))
import Gargantext.Sessions (Sessions, useSessions)
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
-- TODO (what does this mean?)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
......@@ -49,12 +50,12 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
let forested = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
let mCurrentRoute = fst route
let backends = fromFoldable defaultBackends
let withSession = \sid f -> maybe' (\_ -> forested $ homeLayout EN) f $ Sessions.lookup sid (fst sessions)
let withSession = \sid f -> maybe' (\_ -> forested $ homeLayout LL_EN) f $ Sessions.lookup sid (fst sessions)
pure $ case fst showLogin of
true -> forested $ login { sessions, backends, visible: showLogin }
false ->
case fst route of
Home -> forested $ homeLayout EN
Home -> forested $ homeLayout LL_EN
Login -> login { sessions, backends, visible: showLogin }
Folder sid _ -> withSession sid $ \_ -> forested (folder {})
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
......
......@@ -12,6 +12,9 @@ import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
import Gargantext.Components.Loader (loader)
......@@ -19,9 +22,8 @@ import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session)
import Gargantext.Types (AsyncTask(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
------------------------------------------------------------------------
type Props = ( root :: ID
......@@ -117,9 +119,9 @@ toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asy
)
]
onAsyncTaskFinish (AsyncTask {id: id_}) = setTreeState $ const $ ts { asyncTasks = newAsyncTasks }
onAsyncTaskFinish (GT.AsyncTaskWithType {task: GT.AsyncTask {id}}) = setTreeState $ const $ ts { asyncTasks = newAsyncTasks }
where
newAsyncTasks = A.filter (\(AsyncTask {id: id'}) -> id_ /= id') asyncTasks
newAsyncTasks = A.filter (\(GT.AsyncTaskWithType {task: GT.AsyncTask {id: id'}}) -> id /= id') asyncTasks
childNodes :: Session
......@@ -149,18 +151,22 @@ performAction :: Session
-> R.State Tree
-> Action
-> Aff Unit
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode session id $ CreateValue {name, nodeType}
liftEffect $ setReload (_ + 1)
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode session id
liftEffect $ setReload (_ + 1)
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (SearchQuery task) = do
liftEffect $ setTree $ \t@{asyncTasks} -> t { asyncTasks = A.cons task asyncTasks }
liftEffect $ log2 "[performAction] SearchQuery task:" task
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode session id $ RenameValue {name}
liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode session id $ CreateValue {name, nodeType}
liftEffect $ setReload (_ + 1)
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (UploadFile fileType contents) = do
task <- uploadFile session id fileType contents
liftEffect $ setTree $ \t@{asyncTasks} -> t { asyncTasks = A.cons task asyncTasks }
......
......@@ -7,15 +7,17 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Prelude hiding (div)
import Gargantext.Components.Data.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Types (NodeType(..), AsyncTask(..))
import Gargantext.Components.Search.Types (Lang(..))
import Prelude hiding (div)
import Gargantext.Types as GT
data Action = Submit String
data Action = CreateSubmit String GT.NodeType
| DeleteNode
| CreateSubmit String NodeType
| SearchQuery GT.AsyncTaskWithType
| Submit String
| UploadFile FileType UploadFileContents
-----------------------------------------------------
......@@ -52,16 +54,16 @@ type Reload = Int
newtype UploadFileContents = UploadFileContents String
createNode :: Session -> ID -> CreateValue -> Aff (Array ID)
createNode session parentId = post session $ NodeAPI Node (Just parentId) ""
createNode session parentId = post session $ NodeAPI GT.Node (Just parentId) ""
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put session $ NodeAPI Node (Just renameNodeId) "rename"
renameNode session renameNodeId = put session $ NodeAPI GT.Node (Just renameNodeId) "rename"
deleteNode :: Session -> ID -> Aff ID
deleteNode session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
loadNode :: Session -> ID -> Aff FTree
loadNode session nodeId = get session $ NodeAPI Tree (Just nodeId) ""
loadNode session nodeId = get session $ NodeAPI GT.Tree (Just nodeId) ""
newtype RenameValue = RenameValue
......@@ -77,7 +79,7 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
newtype CreateValue = CreateValue
{
name :: Name
, nodeType :: NodeType
, nodeType :: GT.NodeType
}
instance encodeJsonCreateValue :: EncodeJson CreateValue where
......@@ -88,14 +90,14 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode
type Tree = { tree :: FTree, asyncTasks :: Array AsyncTask }
type Tree = { tree :: FTree, asyncTasks :: Array GT.AsyncTaskWithType }
instance ntreeFunctor :: Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary)
newtype LNode = LNode { id :: ID
, name :: Name
, nodeType :: NodeType
, nodeType :: GT.NodeType
}
derive instance newtypeLNode :: Newtype LNode _
......
......@@ -13,11 +13,12 @@ import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Search.Types (readLang, Lang(..))
import Gargantext.Components.Data.Lang (readLang, Lang(..))
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (class ToQuery, AsyncTask, NodeType(..))
import Gargantext.Types as GT
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
......@@ -121,7 +122,7 @@ uploadButton d id (mContents /\ setMContents) (fileType /\ setFileType) (lang /\
-- START File Type View
type FileTypeProps =
( id :: ID
, nodeType :: NodeType)
, nodeType :: GT.NodeType)
fileTypeView :: (Action -> Aff Unit)
-> Record FileTypeProps
......@@ -200,21 +201,22 @@ newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
}
derive instance newtypeSearchQuery :: Newtype FileUploadQuery _
instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
instance fileUploadQueryToQuery :: GT.ToQuery FileUploadQuery where
toQuery (FileUploadQuery {fileType}) =
QP.print id id $ QP.QueryPairs $
pair "fileType" fileType
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff AsyncTask
uploadFile session id fileType (UploadFileContents fileContents) =
postWwwUrlencoded session p bodyParams
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff GT.AsyncTaskWithType
uploadFile session id fileType (UploadFileContents fileContents) = do
task <- postWwwUrlencoded session p bodyParams
pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
--postMultipartFormData session p fileContents
where
q = FileUploadQuery { fileType: fileType }
--p = NodeAPI Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p = NodeAPI Corpus (Just id) $ "add/form/async" -- <> Q.print (toQuery q)
--p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p = GR.NodeAPI GT.Corpus (Just id) $ GT.asyncTaskTypePath GT.Form
bodyParams = [
Tuple "_wf_data" (Just fileContents)
, Tuple "_wf_filetype" (Just $ show fileType)
......
......@@ -12,7 +12,7 @@ import Effect.Timer (clearInterval, setInterval)
import Gargantext.Components.Forest.Tree.Node.Action (ID)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (AsyncProgress(..), AsyncTask(..), AsyncTaskStatus(..), NodeType(..), progressPercent)
import Gargantext.Types as GT
import Partial.Unsafe (unsafePartial)
import Reactix as R
......@@ -21,7 +21,7 @@ import Reactix.DOM.HTML as H
type Props =
(
asyncTask :: AsyncTask
asyncTask :: GT.AsyncTaskWithType
, corpusId :: ID
, onFinish :: Unit -> Effect Unit
, session :: Session
......@@ -34,17 +34,17 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p []
asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
where
cpt props@{asyncTask: (AsyncTask {id}), corpusId, onFinish} _ = do
cpt props@{asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}}), corpusId, onFinish} _ = do
(progress /\ setProgress) <- R.useState' 0.0
intervalIdRef <- R.useRef Nothing
R.useEffectOnce' $ do
intervalId <- setInterval 1000 $ do
launchAff_ $ do
asyncProgress@(AsyncProgress {status}) <- queryProgress props
asyncProgress@(GT.AsyncProgress {status}) <- queryProgress props
liftEffect do
setProgress \p -> min 100.0 $ progressPercent asyncProgress
if (status == Finished) || (status == Killed) || (status == Failed) then do
setProgress \p -> min 100.0 $ GT.progressPercent asyncProgress
if (status == GT.Finished) || (status == GT.Killed) || (status == GT.Failed) then do
_ <- case R.readRef intervalIdRef of
Nothing -> pure unit
Just iid -> clearInterval iid
......@@ -68,7 +68,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
toInt :: Number -> Int
toInt n = unsafePartial $ fromJust $ fromNumber n
queryProgress :: Record Props -> Aff AsyncProgress
queryProgress {asyncTask: AsyncTask {id}, corpusId, session} = get session p
queryProgress :: Record Props -> Aff GT.AsyncProgress
queryProgress {asyncTask: GT.AsyncTaskWithType {task: GT.AsyncTask {id}, typ}, corpusId, session} = get session p
where
p = NodeAPI Corpus (Just corpusId) $ "add/form/async/" <> id <> "/poll?limit=1"
p = NodeAPI GT.Corpus (Just corpusId) $ path <> id <> "/poll?limit=1"
path = GT.asyncTaskTypePath typ
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
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing
(BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Data.Lang (LandingLang(..))
type Props = ()
......@@ -36,13 +36,13 @@ performAction Enter = void $ setHash "/search"
performAction Login = void $ setHash "/login"
performAction SignUp = pure unit
langLandingData :: Lang -> LandingData
langLandingData FR = Fr.landingData
langLandingData EN = En.landingData
langLandingData :: LandingLang -> LandingData
langLandingData LL_FR = Fr.landingData
langLandingData LL_EN = En.landingData
------------------------------------------------------------------------
homeLayout :: Lang -> R.Element
homeLayout :: LandingLang -> R.Element
homeLayout lang = R.createElement homeLayoutCpt {landingData} []
where landingData = langLandingData lang
......
......@@ -2,18 +2,23 @@ module Gargantext.Components.Search.SearchBar
( Props, searchBar, searchBarCpt
) where
import Prelude (pure, ($))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Prelude (Unit, pure, ($))
import Gargantext.Components.Data.Lang (Lang)
import Gargantext.Components.Search.Types (allDatabases) -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Components.Search.SearchField (Search, searchField)
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
type Props = ( session :: Session
, langs :: Array Lang
type Props = ( langs :: Array Lang
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: R.State Search
, session :: Session
)
searchBar :: Record Props -> R.Element
......@@ -22,7 +27,7 @@ searchBar props = R.createElement searchBarCpt props []
searchBarCpt :: R.Component Props
searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
where
cpt {session, langs, search: search@(s /\ _)} _ = do
cpt {langs, onSearch, search: search@(s /\ _), session} _ = do
--onSearchChange session s
pure $ H.div {"style": {"margin" :"10px"}}
[ searchField {databases:allDatabases, langs, search, session}]
[ searchField {databases:allDatabases, langs, onSearch, search, session}]
module Gargantext.Components.Search.SearchField
( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex) where
import Prelude (const, map, pure, show, discard, ($), (&&), (<), (<$>), (<>), (==), (<<<), Unit, bind)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (over)
import Data.String (length)
import Data.Set as Set
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
import DOM.Simple.Console (log, log2)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Effect (Effect)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Search.Types -- (Database(..), readDatabase, Lang(..), readLang, Org(..), readOrg, allOrgs, allIMTorgs, HAL_Filters(..), IMT_org(..))
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, ($), (&&), (<), (<$>), (<<<), (<>), (==))
import Gargantext.Components.Data.Lang (Lang)
import Gargantext.Components.Search.Types (DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, readDatabase, readOrg) -- (Database(..), readDatabase, Lang(..), readLang, Org(..), readOrg, allOrgs, allIMTorgs, HAL_Filters(..), IMT_org(..))
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
select :: forall props.
R.IsComponent String props (Array R.Element)
......@@ -27,23 +29,26 @@ select :: forall props.
-> R.Element
select = R.createElement "select"
type Search = { datafield :: Maybe DataField
, term :: String
type Search = { databases :: Array Database
, datafield :: Maybe DataField
, lang :: Maybe Lang
, node_id :: Maybe Int
, term :: String
}
eqSearch :: Search -> Search -> Boolean
eqSearch s s' = (s.datafield == s'.datafield)
eqSearch s s' = (s.databases == s'.databases)
&& (s.datafield == s'.datafield)
&& (s.term == s'.term)
&& (s.lang == s'.lang)
&& (s.node_id == s'.node_id)
defaultSearch :: Search
defaultSearch = { datafield: Nothing
, term: ""
, lang: Nothing
defaultSearch = { databases: []
, datafield: Nothing
, node_id: Nothing
, lang: Nothing
, term: ""
}
type Props =
......@@ -51,6 +56,7 @@ type Props =
( databases :: Array Database
, langs :: Array Lang
-- State hook for a search, how we get data in and out
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: R.State Search
, session :: Session
)
......@@ -63,7 +69,7 @@ searchField p = R.createElement searchFieldComponent p []
searchFieldComponent :: R.Component Props
searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
where
cpt props@{search: search@(s /\ _)} _ = do
cpt props@{onSearch, search: search@(s /\ _)} _ = do
pure $
H.div { className: "search-field-group", style: { width: "100%" } }
[
......@@ -97,7 +103,7 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
, H.div { className : "panel-footer" }
[ if needsLang s.datafield then langNav search props.langs else H.div {} []
, H.div {} []
, H.div {className: "flex-center"} [submitButton {search, session: props.session}]
, H.div {className: "flex-center"} [submitButton {onSearch, search, session: props.session}]
]
]
eqProps :: Record Props -> Record Props -> Boolean
......@@ -182,21 +188,6 @@ updateFilter org _ = (Just (External (Just (HAL (Just (IMT imtOrgs'))))))
else Set.fromFoldable [org]
------------------------------------------------------------------------
langList :: R.State Search -> Array Lang -> R.Element
langList (lang /\ setLang) langs =
H.div { className: "form-group" }
[ H.div {className: "text-primary center"} [H.text "with lang"]
, R2.select { className: "form-control"
, on: { change: \e -> setLang $ _ {lang = lang' e}}
} (liItem <$> langs)
]
where
liItem :: Lang -> R.Element
liItem l = H.option {className : "text-primary center"} [ H.text (show l) ]
lang' = readLang <<< R2.unsafeEventValue
langNav :: R.State Search -> Array Lang -> R.Element
langNav ({lang} /\ setSearch) langs =
R.fragment [ H.div {className: "text-primary center"} [H.text "with lang"]
......@@ -329,7 +320,8 @@ searchInputComponent = R.hooksComponent "G.C.S.SearchInput" cpt
type SubmitButtonProps =
(
search :: R.State Search
onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: R.State Search
, session :: Session
)
......@@ -339,41 +331,48 @@ submitButton p = R.createElement submitButtonComponent p []
submitButtonComponent :: R.Component SubmitButtonProps
submitButtonComponent = R.hooksComponent "G.C.S.SubmitButton" cpt
where
cpt {search: search /\ setSearch, session} _ =
cpt {onSearch, search: (search /\ _), session} _ =
pure $
H.button { className: "btn btn-primary"
, type: "button"
, on: {click: doSearch session search}
, on: {click: doSearch onSearch session search}
, style: { width: "100%" }
} [ H.text "Launch Search" ]
doSearch s q = \_ -> do
doSearch os s q = \_ -> do
log2 "[submitButton] searching" q
triggerSearch s q
triggerSearch os s q
--case search.term of
-- "" -> setSearch $ const defaultSearch
-- _ -> setSearch $ const q
triggerSearch :: Session -> Search -> Effect Unit
triggerSearch s q =
triggerSearch :: (GT.AsyncTaskWithType -> Effect Unit) -> Session -> Search -> Effect Unit
triggerSearch os s q =
launchAff_ $ do
liftEffect $ do
-- log2 "Searching datafield: " $ show q.database
log2 "Searching term: " q.term
log2 "Searching lang: " q.lang
log2 "[triggerSearch] Searching term: " q.term
log2 "[triggerSearch] Searching lang: " q.lang
r <- (performSearch s $ searchQuery q) :: Aff Unit
case q.node_id of
Nothing -> liftEffect $ log "[triggerSearch] node_id is Nothing, don't know what to do"
Just id -> do
task <- performSearch s id $ searchQuery q
liftEffect $ do
log2 "[triggerSearch] task" task
os task
liftEffect $ do
log2 "Return:" r
modalShow "addCorpus"
--liftEffect $ do
-- log2 "Return:" r
-- modalShow "addCorpus"
searchQuery :: Search -> SearchQuery
searchQuery {datafield: Nothing, term} =
over SearchQuery (_ {query=term}) defaultSearchQuery
searchQuery {datafield, lang, term, node_id} =
over SearchQuery (_ { datafield=datafield
searchQuery {databases, datafield, lang, term, node_id} =
over SearchQuery (_ { databases=databases
, datafield=datafield
, lang=lang
, query=term
, node_id=node_id
......
module Gargantext.Components.Search.Types where
import Prelude (class Eq, class Show, show, ($), (<>), map)
import Data.Set (Set)
import Data.Ord
import Data.Set as Set
import Data.Array (concat)
import Data.Argonaut (class EncodeJson, class DecodeJson, jsonEmptyObject, (:=), (~>), encodeJson)
import Data.Argonaut (class EncodeJson, encodeJson, jsonEmptyObject, (:=), (~>))
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype)
import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Gargantext.Prelude (class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>))
import Gargantext.Components.Data.Lang
import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post)
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Types as GT
import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP
import URI.Query as Q
------------------------------------------------------------------------
class Doc a where
doc :: a -> String
------------------------------------------------------------------------
-- | Lang search specifications
allLangs :: Array Lang
allLangs = [ EN
, FR
, Universal
, No_extraction
]
data Lang = FR | EN | Universal | No_extraction
instance showLang :: Show Lang where
show FR = "FR"
show EN = "EN"
show Universal = "All"
show No_extraction = "Nothing"
derive instance eqLang :: Eq Lang
readLang :: String -> Maybe Lang
readLang "FR" = Just FR
readLang "EN" = Just EN
readLang "All" = Just Universal
readLang "Nothing" = Just No_extraction
readLang _ = Nothing
instance encodeJsonLang :: EncodeJson Lang where
encodeJson a = encodeJson (show a)
------------------------------------------------------------------------
-- | DataField search specifications
......@@ -302,14 +276,16 @@ instance showSearchOrder :: Show SearchOrder where
show ScoreDesc = "ScoreDesc"
------------------------------------------------------------------------
newtype SearchQuery = SearchQuery
{ query :: String
, databases :: Array Database
, datafield :: Maybe DataField
, files_id :: Array String
, lang :: Maybe Lang
, limit :: Maybe Int
, node_id :: Maybe Int
, files_id :: Array String
, offset :: Maybe Int
, limit :: Maybe Int
, order :: Maybe SearchOrder
}
......@@ -318,20 +294,21 @@ derive instance newtypeSearchQuery :: Newtype SearchQuery _
defaultSearchQuery :: SearchQuery
defaultSearchQuery = SearchQuery
{ query: ""
, databases: []
, datafield: Nothing
, files_id : []
, lang : Nothing
, limit: Nothing
, node_id : Nothing
, files_id : []
, offset: Nothing
, limit: Nothing
, order: Nothing
}
instance toUrlSessionSearchQuery :: ToUrl Session SearchQuery where
toUrl (Session {backend}) q = backendUrl backend q2
where q2 = "new" <> Q.print (toQuery q)
where q2 = "new" <> Q.print (GT.toQuery q)
instance searchQueryToQuery :: ToQuery SearchQuery where
instance searchQueryToQuery :: GT.ToQuery SearchQuery where
toQuery (SearchQuery {offset, limit, order}) =
QP.print id id $ QP.QueryPairs
$ pair "offset" offset
......@@ -342,15 +319,18 @@ instance searchQueryToQuery :: ToQuery SearchQuery where
[ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ]
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery {query, datafield, node_id, lang})
encodeJson (SearchQuery {query, databases, datafield, node_id, lang})
= "query" := query
~> "datafield" := "" -- fromMaybe "" datafield
-- ~> "datafield" := "" -- fromMaybe "" datafield
~> "databases" := databases
~> "lang" := maybe "EN" show lang
~> "node_id" := fromMaybe 0 node_id
-- ~> "files_id" := files_id
~> "lang" := maybe "EN" show lang
~> jsonEmptyObject
performSearch :: forall a. DecodeJson a => Session -> SearchQuery -> Aff a
performSearch session q = post session q q
performSearch :: Session -> Int -> SearchQuery -> Aff GT.AsyncTaskWithType
performSearch session nodeId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.Query}
where
p = GR.NodeAPI GT.Corpus (Just nodeId) $ GT.asyncTaskTypePath GT.Query
......@@ -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