Search.purs 2.72 KB
Newer Older
Alexandre Delanoë's avatar
Alexandre Delanoë committed
1 2
module Gargantext.Components.Forest.Tree.Node.Action.Search where

3
import Data.Maybe (Maybe(..))
Alexandre Delanoë's avatar
Alexandre Delanoë committed
4 5
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
6
import Gargantext.Components.App.Store as Store
Alexandre Delanoë's avatar
Alexandre Delanoë committed
7 8
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
9
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
10
import Gargantext.Components.Forest.Tree.Node.Action.Utils (loadLanguages)
11
import Gargantext.Components.Lang (Lang)
12
import Gargantext.Hooks.Loader (useLoader)
13
import Gargantext.Prelude
Alexandre Delanoë's avatar
Alexandre Delanoë committed
14
import Gargantext.Sessions (Session)
15
import Gargantext.Types (ID)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
16
import Gargantext.Types as GT
17
import Gargantext.Utils.Reactix as R2
18 19
import Reactix as R
import Reactix.DOM.HTML as H
20
import Record as Record
21
import Toestand as T
Alexandre Delanoë's avatar
Alexandre Delanoë committed
22

23 24 25 26 27
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search"


type Props =
28
  ( dispatch  :: Action -> Aff Unit
29 30
  , id        :: Maybe ID
  , session   :: Session )
Alexandre Delanoë's avatar
Alexandre Delanoë committed
31 32

-- | Action : Search
33 34 35
actionSearch :: R2.Component Props
actionSearch = R.createElement actionSearchCpt
actionSearchCpt :: R.Component Props
36 37
actionSearchCpt = R2.hereComponent here "actionSearch" hCpt where
  hCpt hp props@({ session }) _ = do
38
    useLoader { errorHandler: Nothing
39
              , herePrefix: hp
40 41 42 43 44 45
              , loader: loadLanguages
              , path: { session }
              , render: \langs ->
                 actionSearchWithLangs (Record.merge props { langs }) [] }

type PropsWithLangs =
46 47
  ( langs :: Array Lang
  | Props )
48 49 50 51 52 53

-- | Action : Search
actionSearchWithLangs :: R2.Component PropsWithLangs
actionSearchWithLangs = R.createElement actionSearchWithLangsCpt
actionSearchWithLangsCpt :: R.Component PropsWithLangs
actionSearchWithLangsCpt = here.component "actionSearchWithLangs" cpt
54
  where
55 56
    cpt { dispatch, id, langs, session } _ = do
      { errors } <- Store.use
57
      search <- T.useBox $ defaultSearch { node_id = id }
58
      pure $ R.fragment
59
        [ H.p { className: "action-search mx-2" }
60 61 62
          [ H.text $ "Search and create a private "
            <> "corpus with the search query as corpus name." ]
        , searchBar { errors
63
                    , langs
64
                    , onSearch: searchOn dispatch
65 66 67 68
                    , search
                    , session
                    } []
        ]
69 70
        where
          searchOn :: (Action -> Aff Unit)
71 72 73
                   -> GT.AsyncTaskWithType
                   -> Effect Unit
          searchOn dispatch' task = do
74 75
            _ <- launchAff $ dispatch' (DoSearch task)
            -- close popup
76
            _ <- launchAff $ dispatch' CloseBox
77 78 79
            -- TODO
            --snd p $ const Nothing
            pure unit