[FOREST] Search form, ergo almost done.

src/Gargantext/Components/Search/SearchBar.purs

@@ -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

 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,17 +20,19 @@ select :: forall props.
           -> R.Element
 select = R.createElement "select"
 
-
-
 type Search = { database :: Maybe Database
               , 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 =
@@ -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)
+      db@(curDb /\ setDb)                <- R.useState' (Nothing :: Maybe Database)
       lang                               <- R.useState' (Nothing :: Maybe Lang)
-      org@(o /\ _)           <- R.useState' (Nothing :: Maybe Org)
+      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
+              , databaseInput db filters org props.databases
+
+              , if curDb /= Just PubMed
+                   then langInput lang props.langs
                    else div {} []
 
-              , div { className: "panel-footer" } [ submitButton db term lang props.search ]
+              , 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 =
+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
@@ -124,35 +185,45 @@ orgInput (org /\ setOrg) orgs =
 
 filterInput :: R.State String -> R.Element
 filterInput (term /\ setTerm) =
-  input { defaultValue: term
+  div {className: ""} [ input { defaultValue: term
                                , className: "form-control"
                                , type: "text"
                                , 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 (term /\ setTerm) =
-  input { defaultValue: term
+  div { className : "" }
+      [ input { defaultValue: term
       , className: "form-control"
       , type: "text"
       , onChange
       , placeHolder: "Your Query here" }
-  where onChange = mkEffectFn1 $ \e -> setTerm $ const $ e .. "target" .. "value"
+      ]
+  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"
+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

 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,42 +93,62 @@ 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 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 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
+allIMTorgs = [All_IMT] <> allIMTSubOrgs
+
+allIMTSubOrgs :: Array IMT_org
+allIMTSubOrgs = [ ARMINES
                 , Eurecom
                 , IMT_Atlantique
                 , IMT_Business_School
@@ -141,7 +167,8 @@ allIMTorgs = [ ARMINES
                 , Telecom_SudParis
                 ]
 
-data IMT_org = ARMINES
+data IMT_org = All_IMT
+             | ARMINES
              | Eurecom
              | IMT_Atlantique
              | IMT_Business_School
@@ -159,7 +186,11 @@ data IMT_org = ARMINES
              | 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 All_IMT             = "All_IMT"
   show ARMINES             = "ARMINES"
   show Eurecom             = "Eurecom"
   show IMT_Atlantique      = "IMT_Atlantique"
@@ -178,27 +209,46 @@ instance showIMT_org :: Show IMT_org where
   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
--}
+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