Skip to content

P
purescript-gargantext
Commit 7aa76f18 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FOREST][SEARCH] fix types for search with datafield.

parent 360cb569
Hide whitespace changes
Inline Side-by-side
Showing with 107 additions and 138 deletions
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ 7aa76f18
......@@ -318,7 +318,7 @@ panelAction d {id,name,nodeType,action, session} p = case action of
(Just Download) -> R.fragment [ H.p {} [H.text $ "Soon, you will be able to dowload your file here"]]
(Just SearchBox) -> R.fragment [ H.p {} [ H.text $ "Search and create a private corpus with the search query as corpus name." ]
, searchBar {session, databases:allDatabases, langs:allLangs, node_id: (Just id)}
, searchBar {session, datafield:Nothing, langs:allLangs, node_id: (Just id)}
]
(Just Delete) -> case nodeType of
NodeUser -> R.fragment [ H.div {} [H.text "Yes, we are RGPD compliant! But you can not delete User Node yet (we are still on development). Thanks for your comprehensin."]]
......
src/Gargantext/Components/Search/SearchBar.purs
View file @ 7aa76f18
......@@ -21,7 +21,7 @@ import Gargantext.Components.Search.SearchField (Search, searchField)
import Gargantext.Sessions (Session)
type Props = ( session :: Session
, databases :: Array Database
, datafield :: Maybe DataField
, langs :: Array Lang
, node_id :: Maybe Int
)
......@@ -32,10 +32,10 @@ searchBar props = R.createElement searchBarCpt props []
searchBarCpt :: R.Component Props
searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
where
cpt {session, databases, langs, node_id} _ = do
cpt {session, datafield, langs, node_id} _ = do
search <- R.useState' Nothing
onSearchChange session search
pure $ H.div {} [ searchField {databases, langs, search, node_id}]
pure $ H.div {} [ searchField {databases:allDatabases, langs, search, node_id}]
onSearchChange :: Session -> R.State (Maybe Search) -> R.Hooks Unit
......@@ -46,9 +46,8 @@ onSearchChange session (search /\ setSearch) =
launchAff_ $ do
liftEffect $ do
log2 "Searching db: " $ show q.database
-- log2 "Searching datafield: " $ show q.database
log2 "Searching term: " q.term
log2 "Searching filters: " q.filters
log2 "Searching lang: " q.lang
r <- (performSearch session $ searchQuery q) :: Aff Unit
......@@ -57,19 +56,13 @@ onSearchChange session (search /\ setSearch) =
log2 "Return:" r
modalShow "addCorpus"
searchQuery {database: Nothing, lang, term} =
searchQuery {datafield: Nothing, lang, term} =
over SearchQuery (_ {query=term}) defaultSearchQuery
searchQuery {database: Just db, lang, term, filters, node_id} =
over SearchQuery (_ { databases=[db]
searchQuery {datafield: datafield, lang, term, node_id} =
over SearchQuery (_ { datafield=datafield
, lang=lang
, query=term
, filters=filters'
, node_id=node_id
}
) defaultSearchQuery
where
filters' = toInt filters
toInt (Just (HAL_StructId {structIds})) = Set.toUnfoldable structIds
toInt (Just (HAL_IMT {imtOrgs, structIds})) = nub $ (concat $ map imtStructId $ Set.toUnfoldable imtOrgs) <> (Set.toUnfoldable structIds)
toInt _ = []
src/Gargantext/Components/Search/SearchField.purs
View file @ 7aa76f18
......@@ -21,21 +21,15 @@ select :: forall props.
select = R.createElement "select"
type Search = { datafield :: Maybe DataField
, database :: Maybe Database
, term :: String
, lang :: Maybe Lang
, org :: Maybe Org
, filters :: Maybe HAL_Filters
, node_id :: Maybe Int
}
defaultSearch :: Search
defaultSearch = { datafield: Just Gargantext
, database: Just PubMed
, term: ""
, lang: Just EN
, org : Nothing
, filters: Nothing
, node_id: Nothing
}
......@@ -57,12 +51,9 @@ searchFieldComponent = R.memo (R.hooksComponent "SearchField" cpt) hasChanged
cpt props@{node_id} _ = do
let search = maybe defaultSearch identity (fst props.search)
term@(curTerm /\ _) <- R.useState' search.term
df@(curDf /\ setDf) <- R.useState' (Just Gargantext :: Maybe DataField)
db@(curDb /\ setDb) <- R.useState' (Nothing :: Maybe Database)
lang@(curLg /\ _) <- R.useState' (Nothing :: Maybe Lang)
org@(curOrg /\ setOrg) <- R.useState' (Nothing :: Maybe Org)
filters@(curFilters /\ setFilters) <- R.useState' (Nothing :: Maybe HAL_Filters)
fi <- R.useState' ""
df@(curDf /\ setDf) <- R.useState' (Just Gargantext :: Maybe DataField)
lang@(curLg /\ _) <- R.useState' (Nothing :: Maybe Lang)
fi <- R.useState' ""
pure $
div { className: "search-field-group" }
[ searchInput term
......@@ -75,65 +66,77 @@ searchFieldComponent = R.memo (R.hooksComponent "SearchField" cpt) hasChanged
then
div {}[]
else
div {} [ dataFieldNav df dataFields
, if curDf == Just (External Nothing)
then databaseInput df db filters org props.databases
div {} [ dataFieldNav df dataFields
, if isExternal curDf
then databaseInput df props.databases
else div {} []
, if isHAL curDb
then orgInput org allOrgs
, if isHAL curDf
then orgInput df allOrgs
else div {} []
, if isHAL curDb
, if isIMT curDf
then
if curOrg == (Just IMT)
then
R.fragment
[ ul {} $ map ( \org' -> li {}
R.fragment
[ ul {} $ map ( \org -> li {}
[ input { type: "checkbox"
, checked: isInFilters org' curFilters
, on: {change: \_ -> (setFilters
, checked: isIn org curDf
, on: {change: \_ -> (setDf
$ const
$ updateFilter org' curFilters)
$ updateFilter org curDf)
}
}
, if org' == All_IMT
then i {} [text $ " " <> show org']
else text $ " " <> show org'
, if org == All_IMT
then i {} [text $ " " <> show org]
else text $ " " <> show org
]
) allIMTorgs
, filterInput fi
]
else
if curOrg == (Just CNRS)
then
R.fragment [ div {} [], filterInput fi]
else
div {} []
else
div {} []
else div {} []
, if isCNRS curDf
then
R.fragment [ div {} [], filterInput fi]
else
div {} []
]
]
, submitButton node_id db term lang org filters props.search
, submitButton node_id df term lang props.search
]
hasChanged p p' = (fst p.search /= fst p'.search)
|| (p.databases /= p'.databases )
|| (p.langs /= p'.langs )
-- || (fst p.filters /= fst p'.filters )
isHAL :: Maybe Database -> Boolean
isHAL (Just HAL) = true
isHAL _ = false
isInFilters :: IMT_org -> Maybe HAL_Filters -> Boolean
isInFilters org (Just (HAL_IMT { imtOrgs })) = Set.member org imtOrgs
isInFilters _ _ = false
isExternal :: Maybe DataField -> Boolean
isExternal (Just (External _)) = true
isExternal _ = false
isHAL :: Maybe DataField -> Boolean
isHAL (Just (External (Just (HAL _)))) = true
isHAL _ = false
isIMT :: Maybe DataField -> Boolean
isIMT (Just ( External ( Just ( HAL ( Just ( IMT _)))))) = true
isIMT _ = false
isCNRS :: Maybe DataField -> Boolean
isCNRS (Just ( External ( Just ( HAL ( Just ( CNRS _)))))) = true
isCNRS _ = false
updateFilter :: IMT_org -> Maybe HAL_Filters -> Maybe HAL_Filters
updateFilter org (Just (HAL_IMT {imtOrgs})) =
Just $ HAL_IMT { imtOrgs: imtOrgs'
, structIds: Set.empty
}
isIn :: IMT_org -> Maybe DataField -> Boolean
isIn org (Just (External (Just (HAL (Just (IMT imtOrgs)))))) = Set.member org imtOrgs
isIn _ _ = false
updateFilter :: IMT_org -> Maybe DataField -> Maybe DataField
updateFilter org (Just (External (Just (HAL (Just (IMT imtOrgs)))))) =
(Just (External (Just (HAL (Just $ IMT imtOrgs')))))
where
imtOrgs' = if Set.member org imtOrgs
then
......@@ -145,15 +148,12 @@ updateFilter org (Just (HAL_IMT {imtOrgs})) =
then Set.fromFoldable allIMTorgs
else Set.insert org imtOrgs
updateFilter org _ = Just $ HAL_IMT { imtOrgs: imtOrgs'
, structIds: Set.empty
}
updateFilter org _ = (Just (External (Just (HAL (Just (IMT imtOrgs'))))))
where
imtOrgs' = if org == All_IMT
then Set.fromFoldable allIMTorgs
else Set.fromFoldable [org]
------------------------------------------------------------------------
langList :: R.State (Maybe Lang) -> Array Lang -> R.Element
langList (lang /\ setLang) langs =
......@@ -200,38 +200,39 @@ dataFieldNav (df /\ setDf) datafields =
------------------------------------------------------------------------
databaseInput :: R.State (Maybe DataField)
-> R.State (Maybe Database)
-> R.State (Maybe HAL_Filters)
-> R.State (Maybe Org)
-> Array Database
-> R.Element
databaseInput (df /\ setDf) (db /\ setDB) (_ /\ setFilters) (_ /\ setOrg) dbs =
databaseInput (df /\ setDf) dbs =
div { className: "form-group" }
[ div {className: "text-primary center"} [text "in database"]
, R2.select { className: "form-control"
, on: { change: \e -> (setDB
, on: { change: \e -> setDf
$ const
$ Just
$ External
$ readDatabase
$ e .. "target" .. "value")
*> (setOrg $ const Nothing)
*> (setFilters $ const Nothing)
*> (setDf $ const $ Just $ External db)
$ e .. "target" .. "value"
}
} (liItem <$> dbs)
, div {className:"center"} [ text $ maybe "" doc db ]
]
where
db = case df of
(Just (External (Just x))) -> Just x
_ -> Nothing
liItem :: Database -> R.Element
liItem db = option {className : "text-primary center"} [ text (show db) ]
orgInput :: R.State (Maybe Org) -> Array Org -> R.Element
orgInput (org /\ setOrg) orgs =
orgInput :: R.State (Maybe DataField) -> Array Org -> R.Element
orgInput (curDf /\ setDf) orgs =
div { className: "form-group" }
[ div {className: "text-primary center"} [text "filter with organization: "]
, R2.select { className: "form-control"
, on: { change: \e -> setOrg
, on: { change: \e -> setDf
$ const
$ Just $ External $ Just $ HAL
$ readOrg
$ e .. "target" .. "value"
}
......@@ -271,14 +272,12 @@ searchInput (term /\ setTerm) =
submitButton :: Maybe Int
-> R.State (Maybe Database)
-> R.State (Maybe DataField)
-> R.State String
-> R.State (Maybe Lang)
-> R.State (Maybe Org)
-> R.State (Maybe HAL_Filters)
-> R.State (Maybe Search)
-> R.Element
submitButton node_id (database /\ _) (term /\ _) (lang /\ _) (org/\_) (filters /\ _) (_ /\ setSearch) = div { className : "panel-footer" }
submitButton node_id (datafield /\ _) (term /\ _) (lang /\ _) (_ /\ setSearch) = div { className : "panel-footer" }
[ button { className: "btn btn-primary"
, type: "button"
, on: {click: doSearch}
......@@ -288,4 +287,4 @@ submitButton node_id (database /\ _) (term /\ _) (lang /\ _) (org/\_) (filters /
doSearch = \_ -> do
case term of
"" -> setSearch $ const Nothing
_ -> setSearch $ const $ Just {datafield: Nothing, database, lang, filters, term, org, node_id}
_ -> setSearch $ const $ Just {datafield, term, lang, node_id}
src/Gargantext/Components/Search/Types.purs
View file @ 7aa76f18
module Gargantext.Components.Search.Types where
import Prelude (class Eq, class Show, show, ($), (<>), map)
import Prelude (class Eq, class Show, show, ($), (<>), map, (&&), (==))
import Data.Set (Set)
import Data.Ord
import Data.Set as Set
......@@ -62,7 +62,7 @@ dataFields :: Array DataField
dataFields = [ Gargantext
, Web
, External Nothing
, Files
-- , Files
]
data DataField = Gargantext
......@@ -82,19 +82,19 @@ instance docDataField :: Doc DataField where
doc Web = "All the web crawled with meta-search-engine SearX"
doc Files = "Zip files with formats.."
-- derive instance eqDataField :: Eq DataField
instance eqDataField :: Eq DataField where
eq Gargantext Gargantext = true
eq (External _) (External _) = true
eq Web Web = true
eq Files Files = true
eq _ _ = false
eq _ _ = false
------------------------------------------------------------------------
-- | Database search specifications
allDatabases :: Array Database
allDatabases = [ PubMed
, HAL
, HAL Nothing
, IsTex
, Isidore
--, Web
......@@ -104,7 +104,7 @@ allDatabases = [ PubMed
data Database = All_Databases
| PubMed
| HAL
| HAL (Maybe Org)
| IsTex
| Isidore
-- | News
......@@ -113,7 +113,7 @@ data Database = All_Databases
instance showDatabase :: Show Database where
show All_Databases= "All Databases"
show PubMed = "PubMed"
show HAL = "HAL"
show (HAL _)= "HAL"
show IsTex = "IsTex"
show Isidore= "Isidore"
-- show News = "News"
......@@ -122,7 +122,7 @@ instance showDatabase :: Show Database where
instance docDatabase :: Doc Database where
doc All_Databases = "All databases"
doc PubMed = "All Medical publications"
doc HAL = "All open science (archives ouvertes)"
doc (HAL _) = "All open science (archives ouvertes)"
doc IsTex = "All Elsevier enriched by CNRS/INIST"
doc Isidore = "All (French) Social Sciences"
-- doc News = "Web filtered by News"
......@@ -131,7 +131,7 @@ instance docDatabase :: Doc Database where
readDatabase :: String -> Maybe Database
readDatabase "All Databases" = Just All_Databases
readDatabase "PubMed" = Just PubMed
readDatabase "HAL" = Just HAL
readDatabase "HAL" = Just $ HAL Nothing
readDatabase "IsTex" = Just IsTex
readDatabase "Isidore"= Just Isidore
-- readDatabase "Web" = Just Web
......@@ -141,65 +141,45 @@ readDatabase _ = Nothing
derive instance eqDatabase :: Eq Database
instance encodeJsonDatabase :: EncodeJson Database where
encodeJson a = encodeJson (show a)
------------------------------------------------------------------------
-- | Database Filter specifications
-- filter by organization
-- | Organization specifications
allOrgs :: Array Org
allOrgs = [ All_Orgs
, IMT
, CNRS
, IMT $ Set.fromFoldable []
, CNRS $ Set.fromFoldable []
]
data Org = All_Orgs
| CNRS
| IMT
| Others
| CNRS (Set StructId)
| Others (Set StructId)
| IMT (Set IMT_org)
type StructId = Int
instance showOrg :: Show Org where
show All_Orgs = "All_Orgs"
show CNRS = "CNRS"
show IMT = "IMT"
show Others = "Others"
show (CNRS _) = "CNRS"
show (IMT _) = "IMT"
show (Others _) = "Others"
readOrg :: String -> Maybe Org
readOrg "All_Orgs" = Just $ All_Orgs
readOrg "CNRS" = Just $ CNRS
readOrg "IMT" = Just $ IMT
readOrg "Others" = Just $ Others
readOrg "CNRS" = Just $ CNRS $ Set.fromFoldable []
readOrg "IMT" = Just $ IMT $ Set.fromFoldable []
readOrg "Others" = Just $ Others $ Set.fromFoldable []
readOrg _ = Nothing
instance eqOrg :: Eq Org
where
eq All_Orgs All_Orgs = true
eq CNRS CNRS = true
eq IMT IMT = true
eq Others Others = true
eq _ _ = false
derive instance eqOrg :: Eq Org
instance encodeJsonOrg :: EncodeJson Org where
encodeJson a = encodeJson (show a)
------------------------------------------------------------------------
type StructId = Int
data HAL_Filters = HAL_StructId { structIds :: Set StructId}
| HAL_IMT { imtOrgs :: Set IMT_org
, structIds :: Set StructId
}
instance eqHAL_Filters :: Eq HAL_Filters
where
eq (HAL_StructId _) (HAL_StructId _) = true
eq (HAL_IMT _ ) (HAL_IMT _) = true
eq _ _ = false
allIMTorgs :: Array IMT_org
allIMTorgs = [All_IMT] <> allIMTSubOrgs
......@@ -326,9 +306,8 @@ instance showSearchOrder :: Show SearchOrder where
------------------------------------------------------------------------
newtype SearchQuery = SearchQuery
{ query :: String
, databases :: Array Database
, datafield :: Maybe DataField
, lang :: Maybe Lang
, filters :: (Array Int)
, node_id :: Maybe Int
, files_id :: Array String
, offset :: Maybe Int
......@@ -341,10 +320,9 @@ derive instance newtypeSearchQuery :: Newtype SearchQuery _
defaultSearchQuery :: SearchQuery
defaultSearchQuery = SearchQuery
{ query: ""
, databases: allDatabases
, datafield: Nothing
, lang : Nothing
, node_id : Nothing
, filters : []
, files_id : []
, offset: Nothing
, limit: Nothing
......@@ -366,12 +344,11 @@ instance searchQueryToQuery :: ToQuery SearchQuery where
[ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ]
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery {query, databases, node_id, files_id, filters, lang})
encodeJson (SearchQuery {query, datafield, node_id, lang})
= "query" := query
~> "databases" := databases
~> "datafield" := "" -- fromMaybe "" datafield
~> "node_id" := fromMaybe 0 node_id
~> "files_id" := files_id
~> "filters" := filters
-- ~> "files_id" := files_id
~> "lang" := maybe "EN" show lang
~> jsonEmptyObject
......
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