Skip to content

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

[FOREST] Search form, ergo almost done.

parent 2832f44b
Hide whitespace changes
Inline Side-by-side
Showing with 262 additions and 141 deletions
src/Gargantext/Components/Search/SearchBar.purs
View file @ a417fb7f
...@@ -13,7 +13,7 @@ import Reactix as R ...@@ -13,7 +13,7 @@ import Reactix as R
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Components.Search.Types (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..)) import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Components.Modals.Modal (modalShow) import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Search.SearchField (Search, searchField) import Gargantext.Components.Search.SearchField (Search, searchField)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
......
src/Gargantext/Components/Search/SearchField.purs
View file @ a417fb7f
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, ($), (/=), (<$>), (||), (==), map, (<>)) import Prelude (bind, const, identity, pure, show, ($), (/=), (<$>), (||), (==), map, (<>), (&&), (*>), (>>=), (>=>))
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Set as Set
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -10,7 +11,7 @@ import Effect.Uncurried (mkEffectFn1) ...@@ -10,7 +11,7 @@ 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, text) import Reactix.DOM.HTML (text, button, div, input, span, ul, li, a, option, text)
import Gargantext.Components.Search.Types (Database(..), readDatabase, Lang(..), readLang, Org(..), readOrg, allOrgs, allIMTorgs) import Gargantext.Components.Search.Types -- (Database(..), readDatabase, Lang(..), readLang, Org(..), readOrg, allOrgs, allIMTorgs, HAL_Filters(..), IMT_org(..))
select :: forall props. select :: forall props.
R.IsComponent String props (Array R.Element) R.IsComponent String props (Array R.Element)
...@@ -19,25 +20,27 @@ select :: forall props. ...@@ -19,25 +20,27 @@ select :: forall props.
-> R.Element -> R.Element
select = R.createElement "select" select = R.createElement "select"
type Search = { database :: Maybe Database type Search = { database :: Maybe Database
, term :: String , term :: String
, lang :: Maybe Lang , lang :: Maybe Lang
, org :: Maybe Org
, filters :: Maybe HAL_Filters
} }
defaultSearch :: Search defaultSearch :: Search
defaultSearch = { database: Nothing defaultSearch = { database: Nothing
, term: "" , term: ""
, lang: Nothing , lang: Nothing
, org : Nothing
, filters: Nothing
} }
type Props = type Props =
-- list of databases to search, or parsers to use on uploads -- list of databases to search, or parsers to use on uploads
( 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
, search :: R.State (Maybe Search) , search :: R.State (Maybe Search)
) )
searchField :: Record Props -> R.Element searchField :: Record Props -> R.Element
...@@ -49,40 +52,98 @@ searchFieldComponent = R.memo (R.hooksComponent "SearchField" cpt) hasChanged ...@@ -49,40 +52,98 @@ searchFieldComponent = R.memo (R.hooksComponent "SearchField" cpt) hasChanged
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@(db' /\ _) <- R.useState' (Nothing :: Maybe Database) db@(curDb /\ setDb) <- R.useState' (Nothing :: Maybe Database)
lang <- R.useState' (Nothing :: Maybe Lang) lang <- R.useState' (Nothing :: Maybe Lang)
org@(o /\ _) <- R.useState' (Nothing :: Maybe Org) org@(curOrg /\ setOrg) <- R.useState' (Nothing :: Maybe Org)
fi <- R.useState' "" filters@(curFilters /\ setFilters) <- R.useState' (Nothing :: Maybe HAL_Filters)
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 filters org props.databases
, if db' /= Just PubMed then langInput lang props.langs else div {} [] , if curDb /= Just PubMed
, if db' == Just HAL then orgInput org allOrgs else div {} [] then langInput lang props.langs
, if o == (Just $ CNRS {orgs:[]}) else div {} []
then filterInput fi
else if o == (Just $ IMT {orgs:[]}) , if isHAL curDb
then ul {} $ map (\o -> li {} [input { type: "checkbox" }, text $ " " <> show o]) allIMTorgs then orgInput org allOrgs
else div {} [] else div {} []
, div { className: "panel-footer" } [ submitButton db term lang props.search ] , if isHAL curDb
then
if curOrg == (Just IMT)
then
R.fragment
[ ul {} $ map ( \org' -> li {}
[ input { type: "checkbox"
, checked: isInFilters org' curFilters
, on: {click: mkEffectFn1
$ \_ -> setFilters
$ const
$ updateFilter org' curFilters
}
}
, text $ " " <> show org'
]
) allIMTorgs
, filterInput fi
]
else
if curOrg == (Just CNRS)
then
R.fragment [ div {} [], filterInput fi]
else
div {} []
else
div {} []
, div { className: "panel-footer" }
[ submitButton db term lang org filters props.search ]
] ]
hasChanged p p' = (fst p.search /= fst p'.search) hasChanged p p' = (fst p.search /= fst p'.search)
|| (p.databases /= p'.databases ) || (p.databases /= p'.databases )
|| (p.langs /= p'.langs ) || (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
updateFilter :: IMT_org -> Maybe HAL_Filters -> Maybe HAL_Filters
updateFilter org (Just (HAL_IMT { imtOrgs})) =
Just $ HAL_IMT { imtOrgs: imtOrgs'
, structIds: Set.empty
}
where
imtOrgs' = if Set.member org imtOrgs
then Set.delete org imtOrgs
else Set.insert org imtOrgs
databaseInput :: R.State (Maybe Database) -> Array Database -> R.Element updateFilter org _ = Just $ HAL_IMT { imtOrgs: imtOrgs', structIds: Set.empty}
databaseInput (db /\ setDB) dbs = where
div { className: "form-group" } imtOrgs' = Set.fromFoldable [org]
databaseInput :: R.State (Maybe Database)
-> R.State (Maybe HAL_Filters)
-> R.State (Maybe Org)
-> Array Database
-> R.Element
databaseInput (db /\ setDB) (_ /\ setFilters) (_ /\ setOrg) dbs =
div { className: "form-group" }
[ R2.select { className: "form-control" [ R2.select { className: "form-control"
, onChange: mkEffectFn1 , on: { change: \e -> (setDB
$ \e -> setDB
$ const $ const
$ readDatabase $ readDatabase
$ e .. "target" .. "value" $ e .. "target" .. "value")
*> (setFilters $ const Nothing)
*> (setOrg $ const Nothing)
}
} (liItem <$> dbs) } (liItem <$> dbs)
] ]
where where
...@@ -92,7 +153,7 @@ databaseInput (db /\ setDB) dbs = ...@@ -92,7 +153,7 @@ 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" }
[ text "with lang" [ text "with lang"
, R2.select { className: "form-control" , R2.select { className: "form-control"
, onChange: mkEffectFn1 , onChange: mkEffectFn1
...@@ -108,7 +169,7 @@ langInput (lang /\ setLang) langs = ...@@ -108,7 +169,7 @@ langInput (lang /\ setLang) langs =
orgInput :: R.State (Maybe Org) -> Array Org -> R.Element orgInput :: R.State (Maybe Org) -> Array Org -> R.Element
orgInput (org /\ setOrg) orgs = orgInput (org /\ setOrg) orgs =
div { className: "form-group" } div { className: "form-group" }
[ text "filter with organization: " [ text "filter with organization: "
, R2.select { className: "form-control" , R2.select { className: "form-control"
, onChange: mkEffectFn1 , onChange: mkEffectFn1
...@@ -124,35 +185,45 @@ orgInput (org /\ setOrg) orgs = ...@@ -124,35 +185,45 @@ orgInput (org /\ setOrg) orgs =
filterInput :: R.State String -> R.Element filterInput :: R.State String -> R.Element
filterInput (term /\ setTerm) = filterInput (term /\ setTerm) =
input { defaultValue: term div {className: ""} [ input { defaultValue: term
, className: "form-control" , className: "form-control"
, type: "text" , type: "text"
, onChange: mkEffectFn1 $ \e -> setTerm $ const $ e .. "target" .. "value" , onChange: mkEffectFn1 $ \e -> setTerm $ const $ e .. "target" .. "value"
, placeHolder : "Struct_Ids as integer" } , placeHolder : "Filter with struct_Ids as integer" }
]
searchInput :: R.State String -> R.Element searchInput :: R.State String -> R.Element
searchInput (term /\ setTerm) = searchInput (term /\ setTerm) =
input { defaultValue: term div { className : "" }
, className: "form-control" [ input { defaultValue: term
, type: "text" , className: "form-control"
, onChange , type: "text"
, placeHolder: "Your Query here" } , onChange
where onChange = mkEffectFn1 $ \e -> setTerm $ const $ e .. "target" .. "value" , placeHolder: "Your Query here" }
]
where
onChange = mkEffectFn1 $ \e -> setTerm
$ const
$ e .. "target" .. "value"
submitButton :: R.State (Maybe Database) submitButton :: R.State (Maybe Database)
-> R.State String -> R.State String
-> R.State (Maybe Lang) -> R.State (Maybe Lang)
-> R.State (Maybe Org)
-> R.State (Maybe HAL_Filters)
-> R.State (Maybe Search) -> R.State (Maybe Search)
-> R.Element -> R.Element
submitButton (database /\ _) (term /\ _) (lang /\ _) (_ /\ setSearch) = submitButton (database /\ _) (term /\ _) (lang /\ _) (org/\_) (filters /\ _) (_ /\ setSearch) =
button { className: "btn btn-primary text-center" R.fragment [ div { className : "" } []
, type: "button" , button { className: "btn btn-primary text-center"
, onClick: click , type: "button"
} [ text "Search" ] , onClick: click
} [ text "Search" ]
]
where where
click = mkEffectFn1 $ \_ -> do click = mkEffectFn1 $ \_ -> do
case term of case term of
"" -> setSearch $ const Nothing "" -> setSearch $ const Nothing
_ -> setSearch $ const $ Just { database, lang, term } _ -> setSearch $ const $ Just { database, lang, filters, term, org}
src/Gargantext/Components/Search/Types.purs
View file @ a417fb7f
module Gargantext.Components.Search.Types where module Gargantext.Components.Search.Types where
import Prelude (class Eq, class Show, show, ($), (<>)) 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, class DecodeJson, jsonEmptyObject, (:=), (~>), encodeJson)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
...@@ -50,13 +54,15 @@ instance encodeJsonLang :: EncodeJson Lang where ...@@ -50,13 +54,15 @@ instance encodeJsonLang :: EncodeJson Lang where
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Database search specifications -- | Database search specifications
allDatabases :: Array Database allDatabases :: Array Database
allDatabases = [All, PubMed allDatabases = [ All
, PubMed
, HAL , HAL
, IsTex , IsTex
, Isidore , Isidore
] ]
data Database = All | PubMed data Database = All
| PubMed
| HAL | HAL
| IsTex | IsTex
| Isidore | Isidore
...@@ -87,118 +93,162 @@ instance encodeJsonDatabase :: EncodeJson Database where ...@@ -87,118 +93,162 @@ instance encodeJsonDatabase :: EncodeJson Database where
allOrgs :: Array Org allOrgs :: Array Org
allOrgs = [ All_Orgs allOrgs = [ All_Orgs
, IMT {orgs:[]} , IMT
, CNRS {orgs:[]} , CNRS
] ]
data Org = All_Orgs data Org = All_Orgs
| CNRS { orgs :: Array Int } | CNRS
| IMT { orgs :: Array IMT_org } | IMT
| Others { orgs :: Array Int } | Others
instance showOrg :: Show Org where instance showOrg :: Show Org where
show All_Orgs = "All__Orgs" show All_Orgs = "All__Orgs"
show (CNRS _) = "CNRS" show CNRS = "CNRS"
show (IMT _) = "IMT" show IMT = "IMT"
show (Others _) = "Others" show Others = "Others"
readOrg :: String -> Maybe Org readOrg :: String -> Maybe Org
readOrg "All_Orgs" = Just $ All_Orgs readOrg "All_Orgs" = Just $ All_Orgs
readOrg "CNRS" = Just $ CNRS {orgs: []} readOrg "CNRS" = Just $ CNRS
readOrg "IMT" = Just $ IMT {orgs: []} readOrg "IMT" = Just $ IMT
readOrg "Others" = Just $ Others {orgs: []} readOrg "Others" = Just $ Others
readOrg _ = Nothing readOrg _ = Nothing
instance eqOrg :: Eq Org instance eqOrg :: Eq Org
where where
eq All_Orgs All_Orgs = true eq All_Orgs All_Orgs = true
eq (CNRS _) (CNRS _) = true eq CNRS CNRS = true
eq (IMT _) (IMT _) = true eq IMT IMT = true
eq (Others _) (Others _) = true eq Others Others = true
eq _ _ = false eq _ _ = false
instance encodeJsonOrg :: EncodeJson Org where instance encodeJsonOrg :: EncodeJson Org where
encodeJson a = encodeJson (show a) 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 :: Array IMT_org
allIMTorgs = [ ARMINES allIMTorgs = [All_IMT] <> allIMTSubOrgs
, Eurecom
, IMT_Atlantique allIMTSubOrgs :: Array IMT_org
, IMT_Business_School allIMTSubOrgs = [ ARMINES
, IMT_Lille_Douai , Eurecom
, IMT_Mines_ALES , IMT_Atlantique
, IMT_Mines_Albi , IMT_Business_School
, Institut_MinesTelecom_Paris , IMT_Lille_Douai
, MINES_ParisTech , IMT_Mines_ALES
, Mines_Douai , IMT_Mines_Albi
, Mines_Nantes , Institut_MinesTelecom_Paris
, Mines_SaintEtienne , MINES_ParisTech
, Telecom_Bretagne , Mines_Douai
, Telecom_Ecole_de_Management , Mines_Nantes
, Telecom_Lille , Mines_SaintEtienne
, Telecom_ParisTech , Telecom_Bretagne
, Telecom_SudParis , Telecom_Ecole_de_Management
] , Telecom_Lille
, Telecom_ParisTech
data IMT_org = ARMINES , Telecom_SudParis
| Eurecom ]
| IMT_Atlantique
| IMT_Business_School data IMT_org = All_IMT
| IMT_Lille_Douai | ARMINES
| IMT_Mines_ALES | Eurecom
| IMT_Mines_Albi | IMT_Atlantique
| Institut_MinesTelecom_Paris | IMT_Business_School
| MINES_ParisTech | IMT_Lille_Douai
| Mines_Douai | IMT_Mines_ALES
| Mines_Nantes | IMT_Mines_Albi
| Mines_SaintEtienne | Institut_MinesTelecom_Paris
| Telecom_Bretagne | MINES_ParisTech
| Telecom_Ecole_de_Management | Mines_Douai
| Telecom_Lille | Mines_Nantes
| Telecom_ParisTech | Mines_SaintEtienne
| Telecom_SudParis | Telecom_Bretagne
| Telecom_Ecole_de_Management
| Telecom_Lille
| Telecom_ParisTech
| Telecom_SudParis
derive instance ordIMT_org :: Ord IMT_org
derive instance eqIMT_org :: Eq IMT_org
instance showIMT_org :: Show IMT_org where instance showIMT_org :: Show IMT_org where
show ARMINES = "ARMINES" show All_IMT = "All_IMT"
show Eurecom = "Eurecom" show ARMINES = "ARMINES"
show IMT_Atlantique = "IMT_Atlantique" show Eurecom = "Eurecom"
show IMT_Atlantique = "IMT_Atlantique"
show IMT_Business_School = "IMT_Business_School" show IMT_Business_School = "IMT_Business_School"
show IMT_Lille_Douai = "IMT_Lille_Douai" show IMT_Lille_Douai = "IMT_Lille_Douai"
show IMT_Mines_ALES = "IMT_Mines_ALES" show IMT_Mines_ALES = "IMT_Mines_ALES"
show IMT_Mines_Albi = "IMT_Mines_Albi" show IMT_Mines_Albi = "IMT_Mines_Albi"
show Institut_MinesTelecom_Paris = "Institut_MinesTelecom_Paris" show Institut_MinesTelecom_Paris = "Institut_MinesTelecom_Paris"
show MINES_ParisTech = "MINES_ParisTech" show MINES_ParisTech = "MINES_ParisTech"
show Mines_Douai = "Mines_Douai" show Mines_Douai = "Mines_Douai"
show Mines_Nantes = "Mines_Nantes" show Mines_Nantes = "Mines_Nantes"
show Mines_SaintEtienne = "Mines_SaintEtienne" show Mines_SaintEtienne = "Mines_SaintEtienne"
show Telecom_Bretagne = "Telecom_Bretagne" show Telecom_Bretagne = "Telecom_Bretagne"
show Telecom_Ecole_de_Management = "Telecom_Ecole_de_Management" show Telecom_Ecole_de_Management = "Telecom_Ecole_de_Management"
show Telecom_Lille = "Telecom_Lille" show Telecom_Lille = "Telecom_Lille"
show Telecom_ParisTech = "Telecom_ParisTech" show Telecom_ParisTech = "Telecom_ParisTech"
show Telecom_SudParis = "Telecom_SudParis" show Telecom_SudParis = "Telecom_SudParis"
readIMT_org :: String -> Maybe IMT_org
readIMT_org "All_IMT" = Just All_IMT
{- readIMT_org "ARMINES" = Just ARMINES
Mines_Douai 224096 readIMT_org "Eurecom" = Just Eurecom
Telecom_Lille 144103 readIMT_org "IMT_Atlantique" = Just IMT_Atlantique
Mines_Nantes 84538 readIMT_org "IMT_Business_School" = Just IMT_Business_School
ARMINES 300104 readIMT_org "IMT_Lille_Douai" = Just IMT_Lille_Douai
Telecom_ParisTech 300362 readIMT_org "IMT_Mines_ALES" = Just IMT_Mines_ALES
Telecom_Bretagne 301262 readIMT_org "IMT_Mines_Albi" = Just IMT_Mines_Albi
Telecom_Ecole_de_Management 301442 readIMT_org "Institut_MinesTelecom_Paris" = Just Institut_MinesTelecom_Paris
MINES_ParisTech 301492 readIMT_org "MINES_ParisTech" = Just MINES_ParisTech
Institut_MinesTelecom_Paris 302102 readIMT_org "Mines_Douai" = Just Mines_Douai
Eurecom 421532 readIMT_org "Mines_Nantes" = Just Mines_Nantes
IMT_Lille_Douai 497330 readIMT_org "Mines_SaintEtienne" = Just Mines_SaintEtienne
Telecom_SudParis 352124 readIMT_org "Telecom_Bretagne" = Just Telecom_Bretagne
IMT_Atlantique 481355 readIMT_org "Telecom_Ecole_de_Management" = Just Telecom_Ecole_de_Management
IMT_Mines_Albi 469216 readIMT_org "Telecom_Lille" = Just Telecom_Lille
IMT_Business_School 542824 readIMT_org "Telecom_ParisTech" = Just Telecom_ParisTech
IMT_Mines_ALES 6279 readIMT_org "Telecom_SudParis" = Just Telecom_SudParis
Mines_SaintEtienne 29212 readIMT_org _ = Nothing
-}
imtStructId :: IMT_org -> Array StructId
imtStructId All_IMT = concat $ map imtStructId allIMTSubOrgs
imtStructId Mines_Douai = [224096]
imtStructId Telecom_Lille = [144103]
imtStructId Mines_Nantes = [84538]
imtStructId ARMINES = [300104]
imtStructId Telecom_ParisTech = [300362]
imtStructId Telecom_Bretagne = [301262]
imtStructId Telecom_Ecole_de_Management = [301442]
imtStructId MINES_ParisTech = [301492]
imtStructId Institut_MinesTelecom_Paris = [302102]
imtStructId Eurecom = [421532]
imtStructId IMT_Lille_Douai = [497330]
imtStructId Telecom_SudParis = [352124]
imtStructId IMT_Atlantique = [481355]
imtStructId IMT_Mines_Albi = [469216]
imtStructId IMT_Business_School = [542824]
imtStructId IMT_Mines_ALES = [6279]
imtStructId Mines_SaintEtienne = [29212]
------------------------------------------------------------------------ ------------------------------------------------------------------------
data SearchOrder data SearchOrder
......
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