Tabs.purs 3.35 KB
Newer Older
1 2
-- TODO copy of Gargantext.Components.Nodes.Corpus.Tabs.Specs
module Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs where
3 4 5 6 7

import Prelude hiding (div)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
8
import Data.Tuple (fst)
9
import Data.Tuple.Nested ((/\))
10
import Reactix as R
11

12 13 14
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab
15
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
16
import Gargantext.Components.Nodes.Lists.Types as NTypes
James Laver's avatar
James Laver committed
17
import Gargantext.Ends (Frontends)
18 19
import Gargantext.Sessions (Session)
import Gargantext.Types (TabType(..), TabSubType(..), CTabNgramType(..), PTabNgramType(..))
20 21
import Gargantext.Utils.Reactix as R2

22
thisModule :: String
23
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs"
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45


data Mode = Patents | Books | Communication

derive instance genericMode :: Generic Mode _

instance showMode :: Show Mode where
  show = genericShow

derive instance eqMode :: Eq Mode

modeTabType :: Mode -> PTabNgramType
modeTabType Patents = PTabPatents
modeTabType Books = PTabBooks
modeTabType Communication = PTabCommunication

-- TODO fix this type
modeTabType' :: Mode -> CTabNgramType
modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors

46
type TabsProps =
47
  ( cacheState :: R.State NTypes.CacheState
48
  , contactData :: ContactData
James Laver's avatar
James Laver committed
49
  , frontends :: Frontends
50 51 52
  , nodeId :: Int
  , session :: Session
  )
53

54
tabs :: Record TabsProps -> R.Element
55 56
tabs props = R.createElement tabsCpt props []

57
tabsCpt :: R.Component TabsProps
58
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
59
  where
60
    cpt { cacheState, contactData: {defaultListId}, frontends, nodeId, session} _ = do
61 62
      active <- R.useState' 0
      pure $
63
        Tab.tabs { selected: fst active, tabs: tabs' }
64 65 66 67 68 69 70 71 72
      where
        tabs' =
          [ "Documents"     /\ docs
          , "Patents"       /\ ngramsView patentsView
          , "Books"         /\ ngramsView booksView
          , "Communication" /\ ngramsView commView
          , "Trash"         /\ docs -- TODO pass-in trash mode
          ]
          where
73 74 75
            patentsView = { cacheState, defaultListId, mode: Patents, nodeId, session }
            booksView   = { cacheState, defaultListId, mode: Books, nodeId, session }
            commView    = { cacheState, defaultListId, mode: Communication, nodeId, session }
76
            chart       = mempty
77
            totalRecords = 4736 -- TODO
78
            docs = DT.docViewLayout
James Laver's avatar
James Laver committed
79
              { frontends, session, nodeId, chart, totalRecords
80 81 82 83 84 85
              , tabType: TabPairing TabDocs
              , listId: defaultListId
              , corpusId: Nothing
              , showSearch: true }


86
type NgramsViewTabsProps =
87
  ( cacheState :: R.State NTypes.CacheState
88
  , defaultListId :: Int
89 90 91 92
  , mode :: Mode
  , nodeId :: Int
  , session :: Session
  )
93

94
ngramsView :: Record NgramsViewTabsProps -> R.Element
95 96
ngramsView { cacheState, defaultListId, mode, nodeId, session } =
  NT.mainNgramsTable {
97 98
      afterSync: \_ -> pure unit
    , cacheState
99 100 101 102 103 104 105
    , defaultListId
    , nodeId
    , tabType
    , session
    , tabNgramType
    , withAutoUpdate: false
    }
106 107
  where
    tabNgramType = modeTabType' mode
108
    tabType      = TabPairing $ TabNgramType $ modeTabType mode