Commit 2832f44b authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FOREST][SEARCH] form as tree from beginner to advanced user (demo).

parent 04eb4bb0
...@@ -142,9 +142,9 @@ settingsBox Corpus = SettingsBox { show : true ...@@ -142,9 +142,9 @@ settingsBox Corpus = SettingsBox { show : true
, Link Annuaire , Link Annuaire
, Upload , Upload
, Download , Download
, Share --, Share
, Move --, Move
, Clone --, Clone
, Delete , Delete
] ]
} }
......
module Gargantext.Components.Search.SearchField module Gargantext.Components.Search.SearchField
( Search, Props, searchField, searchFieldComponent )where ( Search, Props, searchField, searchFieldComponent )where
import Prelude (bind, const, identity, pure, show, ($), (/=), (<$>), (||)) import Prelude (bind, const, identity, pure, show, ($), (/=), (<$>), (||), (==), map, (<>))
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
...@@ -9,8 +9,8 @@ import Gargantext.Utils.Reactix as R2 ...@@ -9,8 +9,8 @@ import Gargantext.Utils.Reactix as R2
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..)) import FFI.Simple ((..))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML (text, button, div, input, span, ul, li, a, option) import Reactix.DOM.HTML (text, button, div, input, span, ul, li, a, option, text)
import Gargantext.Components.Search.Types (Database(..), readDatabase, Lang(..), readLang) import Gargantext.Components.Search.Types (Database(..), readDatabase, Lang(..), readLang, Org(..), readOrg, allOrgs, allIMTorgs)
select :: forall props. select :: forall props.
R.IsComponent String props (Array R.Element) R.IsComponent String props (Array R.Element)
...@@ -43,24 +43,30 @@ type Props = ...@@ -43,24 +43,30 @@ type Props =
searchField :: Record Props -> R.Element searchField :: Record Props -> R.Element
searchField p = R.createElement searchFieldComponent p [] searchField p = R.createElement searchFieldComponent p []
placeholder :: String
placeholder = "Query, URL or FILE"
-- TODO add elsewhere "(works with Firefox or Chromium browsers)"
searchFieldComponent :: R.Memo Props searchFieldComponent :: R.Memo Props
searchFieldComponent = R.memo (R.hooksComponent "SearchField" cpt) hasChanged searchFieldComponent = R.memo (R.hooksComponent "SearchField" cpt) hasChanged
where where
cpt props _ = do cpt props _ = do
let search = maybe defaultSearch identity (fst props.search) let search = maybe defaultSearch identity (fst props.search)
term <- R.useState' search.term term <- R.useState' search.term
db <- R.useState' (Nothing :: Maybe Database) db@(db' /\ _) <- R.useState' (Nothing :: Maybe Database)
lang <- R.useState' (Nothing :: Maybe Lang) lang <- R.useState' (Nothing :: Maybe Lang)
org@(o /\ _) <- R.useState' (Nothing :: Maybe Org)
fi <- R.useState' ""
pure $ pure $
div { className: "search-field-group" } div { className: "search-field-group" }
[ searchInput term [ searchInput term
, div {className: "text-primary center"} [text "in"] , div {className: "text-primary center"} [text "in"]
, databaseInput db props.databases , databaseInput db props.databases
, langInput lang props.langs
, if db' /= Just PubMed then langInput lang props.langs else div {} []
, if db' == Just HAL then orgInput org allOrgs else div {} []
, if o == (Just $ CNRS {orgs:[]})
then filterInput fi
else if o == (Just $ IMT {orgs:[]})
then ul {} $ map (\o -> li {} [input { type: "checkbox" }, text $ " " <> show o]) allIMTorgs
else div {} []
, div { className: "panel-footer" } [ submitButton db term lang props.search ] , div { className: "panel-footer" } [ submitButton db term lang props.search ]
] ]
hasChanged p p' = (fst p.search /= fst p'.search) hasChanged p p' = (fst p.search /= fst p'.search)
...@@ -87,7 +93,8 @@ databaseInput (db /\ setDB) dbs = ...@@ -87,7 +93,8 @@ databaseInput (db /\ setDB) dbs =
langInput :: R.State (Maybe Lang) -> Array Lang -> R.Element langInput :: R.State (Maybe Lang) -> Array Lang -> R.Element
langInput (lang /\ setLang) langs = langInput (lang /\ setLang) langs =
div { className: "form-group" } div { className: "form-group" }
[ R2.select { className: "form-control" [ text "with lang"
, R2.select { className: "form-control"
, onChange: mkEffectFn1 , onChange: mkEffectFn1
$ \e -> setLang $ \e -> setLang
$ const $ const
...@@ -99,6 +106,30 @@ langInput (lang /\ setLang) langs = ...@@ -99,6 +106,30 @@ langInput (lang /\ setLang) langs =
liItem :: Lang -> R.Element liItem :: Lang -> R.Element
liItem lang = option {className : "text-primary center"} [ text (show lang) ] liItem lang = option {className : "text-primary center"} [ text (show lang) ]
orgInput :: R.State (Maybe Org) -> Array Org -> R.Element
orgInput (org /\ setOrg) orgs =
div { className: "form-group" }
[ text "filter with organization: "
, R2.select { className: "form-control"
, onChange: mkEffectFn1
$ \e -> setOrg
$ const
$ readOrg
$ e .. "target" .. "value"
} (liItem <$> orgs)
]
where
liItem :: Org -> R.Element
liItem org = option {className : "text-primary center"} [ text (show org) ]
filterInput :: R.State String -> R.Element
filterInput (term /\ setTerm) =
input { defaultValue: term
, className: "form-control"
, type: "text"
, onChange: mkEffectFn1 $ \e -> setTerm $ const $ e .. "target" .. "value"
, placeHolder : "Struct_Ids as integer" }
searchInput :: R.State String -> R.Element searchInput :: R.State String -> R.Element
searchInput (term /\ setTerm) = searchInput (term /\ setTerm) =
...@@ -106,7 +137,7 @@ searchInput (term /\ setTerm) = ...@@ -106,7 +137,7 @@ searchInput (term /\ setTerm) =
, className: "form-control" , className: "form-control"
, type: "text" , type: "text"
, onChange , onChange
, placeholder } , placeHolder: "Your Query here" }
where onChange = mkEffectFn1 $ \e -> setTerm $ const $ e .. "target" .. "value" where onChange = mkEffectFn1 $ \e -> setTerm $ const $ e .. "target" .. "value"
......
...@@ -24,14 +24,16 @@ allLangs :: Array Lang ...@@ -24,14 +24,16 @@ allLangs :: Array Lang
allLangs = [ EN allLangs = [ EN
, FR , FR
, Universal , Universal
, No_extraction
] ]
data Lang = FR | EN | Universal data Lang = FR | EN | Universal | No_extraction
instance showLang :: Show Lang where instance showLang :: Show Lang where
show FR = "FR" show FR = "FR"
show EN = "EN" show EN = "EN"
show Universal = "Universal" show Universal = "Universal"
show No_extraction = "No_extraction"
derive instance eqLang :: Eq Lang derive instance eqLang :: Eq Lang
...@@ -39,8 +41,12 @@ readLang :: String -> Maybe Lang ...@@ -39,8 +41,12 @@ readLang :: String -> Maybe Lang
readLang "FR" = Just FR readLang "FR" = Just FR
readLang "EN" = Just EN readLang "EN" = Just EN
readLang "Universal" = Just Universal readLang "Universal" = Just Universal
readLang "No_extraction" = Just No_extraction
readLang _ = Nothing readLang _ = Nothing
instance encodeJsonLang :: EncodeJson Lang where
encodeJson a = encodeJson (show a)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Database search specifications -- | Database search specifications
allDatabases :: Array Database allDatabases :: Array Database
...@@ -75,7 +81,126 @@ derive instance eqDatabase :: Eq Database ...@@ -75,7 +81,126 @@ derive instance eqDatabase :: Eq Database
instance encodeJsonDatabase :: EncodeJson Database where instance encodeJsonDatabase :: EncodeJson Database where
encodeJson a = encodeJson (show a) encodeJson a = encodeJson (show a)
------------------------------------------------------------------------
-- | Database Filter specifications
-- filter by organization
allOrgs :: Array Org
allOrgs = [ All_Orgs
, IMT {orgs:[]}
, CNRS {orgs:[]}
]
data Org = All_Orgs
| CNRS { orgs :: Array Int }
| IMT { orgs :: Array IMT_org }
| Others { orgs :: Array Int }
instance showOrg :: Show Org where
show All_Orgs = "All__Orgs"
show (CNRS _) = "CNRS"
show (IMT _) = "IMT"
show (Others _) = "Others"
readOrg :: String -> Maybe Org
readOrg "All_Orgs" = Just $ All_Orgs
readOrg "CNRS" = Just $ CNRS {orgs: []}
readOrg "IMT" = Just $ IMT {orgs: []}
readOrg "Others" = Just $ Others {orgs: []}
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
instance encodeJsonOrg :: EncodeJson Org where
encodeJson a = encodeJson (show a)
------------------------------------------------------------------------
allIMTorgs :: Array IMT_org
allIMTorgs = [ ARMINES
, Eurecom
, IMT_Atlantique
, IMT_Business_School
, IMT_Lille_Douai
, IMT_Mines_ALES
, IMT_Mines_Albi
, Institut_MinesTelecom_Paris
, MINES_ParisTech
, Mines_Douai
, Mines_Nantes
, Mines_SaintEtienne
, Telecom_Bretagne
, Telecom_Ecole_de_Management
, Telecom_Lille
, Telecom_ParisTech
, Telecom_SudParis
]
data IMT_org = ARMINES
| Eurecom
| IMT_Atlantique
| IMT_Business_School
| IMT_Lille_Douai
| IMT_Mines_ALES
| IMT_Mines_Albi
| Institut_MinesTelecom_Paris
| MINES_ParisTech
| Mines_Douai
| Mines_Nantes
| Mines_SaintEtienne
| Telecom_Bretagne
| Telecom_Ecole_de_Management
| Telecom_Lille
| Telecom_ParisTech
| Telecom_SudParis
instance showIMT_org :: Show IMT_org where
show ARMINES = "ARMINES"
show Eurecom = "Eurecom"
show IMT_Atlantique = "IMT_Atlantique"
show IMT_Business_School = "IMT_Business_School"
show IMT_Lille_Douai = "IMT_Lille_Douai"
show IMT_Mines_ALES = "IMT_Mines_ALES"
show IMT_Mines_Albi = "IMT_Mines_Albi"
show Institut_MinesTelecom_Paris = "Institut_MinesTelecom_Paris"
show MINES_ParisTech = "MINES_ParisTech"
show Mines_Douai = "Mines_Douai"
show Mines_Nantes = "Mines_Nantes"
show Mines_SaintEtienne = "Mines_SaintEtienne"
show Telecom_Bretagne = "Telecom_Bretagne"
show Telecom_Ecole_de_Management = "Telecom_Ecole_de_Management"
show Telecom_Lille = "Telecom_Lille"
show Telecom_ParisTech = "Telecom_ParisTech"
show Telecom_SudParis = "Telecom_SudParis"
{-
Mines_Douai 224096
Telecom_Lille 144103
Mines_Nantes 84538
ARMINES 300104
Telecom_ParisTech 300362
Telecom_Bretagne 301262
Telecom_Ecole_de_Management 301442
MINES_ParisTech 301492
Institut_MinesTelecom_Paris 302102
Eurecom 421532
IMT_Lille_Douai 497330
Telecom_SudParis 352124
IMT_Atlantique 481355
IMT_Mines_Albi 469216
IMT_Business_School 542824
IMT_Mines_ALES 6279
Mines_SaintEtienne 29212
-}
------------------------------------------------------------------------
data SearchOrder data SearchOrder
= DateAsc = DateAsc
| DateDesc | DateDesc
...@@ -92,6 +217,7 @@ instance showSearchOrder :: Show SearchOrder where ...@@ -92,6 +217,7 @@ instance showSearchOrder :: Show SearchOrder where
show ScoreAsc = "ScoreAsc" show ScoreAsc = "ScoreAsc"
show ScoreDesc = "ScoreDesc" show ScoreDesc = "ScoreDesc"
------------------------------------------------------------------------
newtype SearchQuery = SearchQuery newtype SearchQuery = SearchQuery
{ query :: String { query :: String
, databases :: Array Database , databases :: Array Database
...@@ -110,7 +236,7 @@ defaultSearchQuery = SearchQuery ...@@ -110,7 +236,7 @@ defaultSearchQuery = SearchQuery
{ query: "" { query: ""
, databases: allDatabases , databases: allDatabases
, lang : Nothing , lang : Nothing
, node_id: Nothing , node_id : Nothing
, files_id : [] , files_id : []
, offset: Nothing , offset: Nothing
, limit: Nothing , limit: Nothing
......
...@@ -5,8 +5,8 @@ ...@@ -5,8 +5,8 @@
<title>CNRS GarganText</title> <title>CNRS GarganText</title>
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet"> <link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet">
<!--<link href="https://use.fontawesome.com/releases/v5.0.8/styles/all.css" rel="stylesheet">--> <!--<link href="https://use.fontawesome.com/releases/v5.0.8/styles/all.css" rel="stylesheet">-->
<link rel="stylesheet" href="icons/fork-awesome/css/fork-awesome.css"> <!--<link rel="stylesheet" href="icons/fork-awesome/css/fork-awesome.css">-->
<!--<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/fork-awesome@1.1.7/css/fork-awesome.min.css" integrity="sha256-gsmEoJAws/Kd3CjuOQzLie5Q3yshhvmo7YNtBG7aaEY=" crossorigin="anonymous">--> <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/fork-awesome@1.1.7/css/fork-awesome.min.css" integrity="sha256-gsmEoJAws/Kd3CjuOQzLie5Q3yshhvmo7YNtBG7aaEY=" crossorigin="anonymous">
<link href="styles/login.min.css" rel="stylesheet"> <link href="styles/login.min.css" rel="stylesheet">
<link href="styles/bootstrap.min.css" rel="stylesheet"> <link href="styles/bootstrap.min.css" rel="stylesheet">
<!-- <link href="styles/lavish-bootstrap.css" rel="stylesheet"> --> <!-- <link href="styles/lavish-bootstrap.css" rel="stylesheet"> -->
......
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