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
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
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.Search.SearchField (Search, searchField)
import Gargantext.Sessions (Session)
......
src/Gargantext/Components/Search/SearchField.purs
View file @ a417fb7f
module Gargantext.Components.Search.SearchField
( Search, Props, searchField, searchFieldComponent )where
import Prelude (bind, const, identity, pure, show, ($), (/=), (<$>), (||), (==), map, (<>))
import Data.Maybe (Maybe(..), maybe)
import Prelude (bind, const, identity, pure, show, ($), (/=), (<$>), (||), (==), map, (<>), (&&), (*>), (>>=), (>=>))
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Set as Set
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Gargantext.Utils.Reactix as R2
......@@ -10,7 +11,7 @@ import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Reactix as R
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.
R.IsComponent String props (Array R.Element)
......@@ -19,25 +20,27 @@ select :: forall props.
-> R.Element
select = R.createElement "select"
type Search = { database :: Maybe Database
, term :: String
, lang :: Maybe Lang
, term :: String
, lang :: Maybe Lang
, org :: Maybe Org
, filters :: Maybe HAL_Filters
}
defaultSearch :: Search
defaultSearch = { database: Nothing
, term: ""
, lang: Nothing
, org : Nothing
, filters: Nothing
}
type Props =
-- list of databases to search, or parsers to use on uploads
( databases :: Array Database
, langs :: Array Lang
, langs :: Array Lang
-- 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
......@@ -49,40 +52,98 @@ searchFieldComponent = R.memo (R.hooksComponent "SearchField" cpt) hasChanged
cpt props _ = do
let search = maybe defaultSearch identity (fst props.search)
term <- R.useState' search.term
db@(db' /\ _) <- R.useState' (Nothing :: Maybe Database)
lang <- R.useState' (Nothing :: Maybe Lang)
org@(o /\ _) <- R.useState' (Nothing :: Maybe Org)
fi <- R.useState' ""
db@(curDb /\ setDb) <- R.useState' (Nothing :: Maybe Database)
lang <- 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' ""
pure $
div { className: "search-field-group" }
[ searchInput term
, div {className: "text-primary center"} [text "in"]
, databaseInput db props.databases
, 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 ]
, databaseInput db filters org props.databases
, if curDb /= Just PubMed
then langInput lang props.langs
else div {} []
, if isHAL curDb
then orgInput org allOrgs
else div {} []
, 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)
|| (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
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
databaseInput (db /\ setDB) dbs =
div { className: "form-group" }
updateFilter org _ = Just $ HAL_IMT { imtOrgs: imtOrgs', structIds: Set.empty}
where
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"
, onChange: mkEffectFn1
$ \e -> setDB
, on: { change: \e -> (setDB
$ const
$ readDatabase
$ e .. "target" .. "value"
$ e .. "target" .. "value")
*> (setFilters $ const Nothing)
*> (setOrg $ const Nothing)
}
} (liItem <$> dbs)
]
where
......@@ -92,7 +153,7 @@ databaseInput (db /\ setDB) dbs =
langInput :: R.State (Maybe Lang) -> Array Lang -> R.Element
langInput (lang /\ setLang) langs =
div { className: "form-group" }
div { className: "form-group" }
[ text "with lang"
, R2.select { className: "form-control"
, onChange: mkEffectFn1
......@@ -108,7 +169,7 @@ langInput (lang /\ setLang) langs =
orgInput :: R.State (Maybe Org) -> Array Org -> R.Element
orgInput (org /\ setOrg) orgs =
div { className: "form-group" }
div { className: "form-group" }
[ text "filter with organization: "
, R2.select { className: "form-control"
, onChange: mkEffectFn1
......@@ -124,35 +185,45 @@ orgInput (org /\ setOrg) orgs =
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" }
div {className: ""} [ input { defaultValue: term
, className: "form-control"
, type: "text"
, onChange: mkEffectFn1 $ \e -> setTerm $ const $ e .. "target" .. "value"
, placeHolder : "Filter with struct_Ids as integer" }
]
searchInput :: R.State String -> R.Element
searchInput (term /\ setTerm) =
input { defaultValue: term
, className: "form-control"
, type: "text"
, onChange
, placeHolder: "Your Query here" }
where onChange = mkEffectFn1 $ \e -> setTerm $ const $ e .. "target" .. "value"
div { className : "" }
[ input { defaultValue: term
, className: "form-control"
, type: "text"
, onChange
, placeHolder: "Your Query here" }
]
where
onChange = mkEffectFn1 $ \e -> setTerm
$ const
$ e .. "target" .. "value"
submitButton :: R.State (Maybe Database)
-> R.State String
-> R.State (Maybe Lang)
-> R.State (Maybe Org)
-> R.State (Maybe HAL_Filters)
-> R.State (Maybe Search)
-> R.Element
submitButton (database /\ _) (term /\ _) (lang /\ _) (_ /\ setSearch) =
button { className: "btn btn-primary text-center"
, type: "button"
, onClick: click
} [ text "Search" ]
submitButton (database /\ _) (term /\ _) (lang /\ _) (org/\_) (filters /\ _) (_ /\ setSearch) =
R.fragment [ div { className : "" } []
, button { className: "btn btn-primary text-center"
, type: "button"
, onClick: click
} [ text "Search" ]
]
where
click = mkEffectFn1 $ \_ -> do
case term of
"" -> 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
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.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
......@@ -50,13 +54,15 @@ instance encodeJsonLang :: EncodeJson Lang where
------------------------------------------------------------------------
-- | Database search specifications
allDatabases :: Array Database
allDatabases = [All, PubMed
allDatabases = [ All
, PubMed
, HAL
, IsTex
, Isidore
]
data Database = All | PubMed
data Database = All
| PubMed
| HAL
| IsTex
| Isidore
......@@ -87,118 +93,162 @@ instance encodeJsonDatabase :: EncodeJson Database where
allOrgs :: Array Org
allOrgs = [ All_Orgs
, IMT {orgs:[]}
, CNRS {orgs:[]}
, IMT
, CNRS
]
data Org = All_Orgs
| CNRS { orgs :: Array Int }
| IMT { orgs :: Array IMT_org }
| Others { orgs :: Array Int }
| CNRS
| IMT
| Others
instance showOrg :: Show Org where
show All_Orgs = "All__Orgs"
show (CNRS _) = "CNRS"
show (IMT _) = "IMT"
show (Others _) = "Others"
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 "CNRS" = Just $ CNRS
readOrg "IMT" = Just $ IMT
readOrg "Others" = Just $ Others
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
eq CNRS CNRS = true
eq IMT IMT = true
eq Others Others = true
eq _ _ = false
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 = [ 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
allIMTorgs = [All_IMT] <> allIMTSubOrgs
allIMTSubOrgs :: Array IMT_org
allIMTSubOrgs = [ 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 = All_IMT
| 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
derive instance ordIMT_org :: Ord IMT_org
derive instance eqIMT_org :: Eq IMT_org
instance showIMT_org :: Show IMT_org where
show ARMINES = "ARMINES"
show Eurecom = "Eurecom"
show IMT_Atlantique = "IMT_Atlantique"
show All_IMT = "All_IMT"
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 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 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
-}
show Telecom_Lille = "Telecom_Lille"
show Telecom_ParisTech = "Telecom_ParisTech"
show Telecom_SudParis = "Telecom_SudParis"
readIMT_org :: String -> Maybe IMT_org
readIMT_org "All_IMT" = Just All_IMT
readIMT_org "ARMINES" = Just ARMINES
readIMT_org "Eurecom" = Just Eurecom
readIMT_org "IMT_Atlantique" = Just IMT_Atlantique
readIMT_org "IMT_Business_School" = Just IMT_Business_School
readIMT_org "IMT_Lille_Douai" = Just IMT_Lille_Douai
readIMT_org "IMT_Mines_ALES" = Just IMT_Mines_ALES
readIMT_org "IMT_Mines_Albi" = Just IMT_Mines_Albi
readIMT_org "Institut_MinesTelecom_Paris" = Just Institut_MinesTelecom_Paris
readIMT_org "MINES_ParisTech" = Just MINES_ParisTech
readIMT_org "Mines_Douai" = Just Mines_Douai
readIMT_org "Mines_Nantes" = Just Mines_Nantes
readIMT_org "Mines_SaintEtienne" = Just Mines_SaintEtienne
readIMT_org "Telecom_Bretagne" = Just Telecom_Bretagne
readIMT_org "Telecom_Ecole_de_Management" = Just Telecom_Ecole_de_Management
readIMT_org "Telecom_Lille" = Just Telecom_Lille
readIMT_org "Telecom_ParisTech" = Just Telecom_ParisTech
readIMT_org "Telecom_SudParis" = Just Telecom_SudParis
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
......
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