Tabs.purs 4.72 KB
Newer Older
Alexandre Delanoë's avatar
Alexandre Delanoë committed
1
-- TODO copy of Gargantext.Components.Nodes.Corpus.Tabs.Specs
2
module Gargantext.Components.Nodes.Annuaire.Tabs where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
3 4

import Prelude hiding (div)
5

Alexandre Delanoë's avatar
Alexandre Delanoë committed
6 7
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
8
import Data.Show.Generic (genericShow)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
9
import Data.Tuple.Nested ((/\))
10
import Effect.Aff (Aff)
arturo's avatar
arturo committed
11
import Gargantext.Components.App.Store (Boxes)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
12
import Gargantext.Components.DocsTable as DT
13
import Gargantext.Components.DocsTable.Types (Year)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
14
import Gargantext.Components.NgramsTable as NT
15
import Gargantext.Core.NgramsTable.Functions as NTC
Alexandre Delanoë's avatar
Alexandre Delanoë committed
16
import Gargantext.Components.Nodes.Lists.Types as LTypes
17 18
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Tab as Tab
Alexandre Delanoë's avatar
Alexandre Delanoë committed
19 20
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
21
import Gargantext.Types (CTabNgramType(..), PTabNgramType(..), TabSubType(..), TabType(..))
Alexandre Delanoë's avatar
Alexandre Delanoë committed
22
import Gargantext.Utils.Reactix as R2
23
import Gargantext.Utils.Toestand as T2
24 25 26 27
import Reactix as R
import Record as Record
import Record.Extra as RX
import Toestand as T
Alexandre Delanoë's avatar
Alexandre Delanoë committed
28

James Laver's avatar
James Laver committed
29 30
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
31 32 33

data Mode = Patents | Books | Communication

34
derive instance Generic Mode _
Alexandre Delanoë's avatar
Alexandre Delanoë committed
35

36
instance Show Mode where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
37 38
  show = genericShow

39
derive instance Eq Mode
Alexandre Delanoë's avatar
Alexandre Delanoë committed
40 41 42 43 44 45 46 47 48 49 50 51

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

James Laver's avatar
James Laver committed
52
type TabsProps =
53 54 55 56 57 58 59
  ( boxes         :: Boxes
  , cacheState    :: T.Box LTypes.CacheState
  , defaultListId :: Int
  , frontends     :: Frontends
  , nodeId        :: Int
  , session       :: Session
  , sidePanel     :: T.Box (Maybe (Record TextsT.SidePanel))
Alexandre Delanoë's avatar
Alexandre Delanoë committed
60 61
  )

James Laver's avatar
James Laver committed
62
tabs :: R2.Leaf TabsProps
63
tabs = R2.leaf tabsCpt
Alexandre Delanoë's avatar
Alexandre Delanoë committed
64
tabsCpt :: R.Component TabsProps
James Laver's avatar
James Laver committed
65 66
tabsCpt = here.component "tabs" cpt where
  cpt props _ = do
67
    activeTab <- T.useBox 0
68
    yearFilter <- T.useBox (Nothing :: Maybe Year)
69
    chartReload <- T.useBox T2.newReload
70

71 72 73 74 75 76
    pure $
      Tab.tabs
      { activeTab
      , tabs: tabs' yearFilter chartReload props
      , className: "nodes-annuaire-layout-tabs"
      }
77
  tabs' yearFilter chartReload props@{ boxes, defaultListId, sidePanel } =
78
    [ "Documents"     /\ docs
James Laver's avatar
James Laver committed
79 80 81
    , "Patents"       /\ ngramsView (viewProps Patents)
    , "Books"         /\ ngramsView (viewProps Books)
    , "Communication" /\ ngramsView (viewProps Communication)
82
    , "Trash"         /\ docs -- TODO pass-in trash mode
James Laver's avatar
James Laver committed
83
    ] where
84 85
      viewProps mode = Record.merge props { mode }
      totalRecords = 4736  -- TODO lol
86
      docs = DT.docViewLayout (Record.merge { boxes, chartReload, sidePanel } $ Record.merge dtCommon dtExtra)
James Laver's avatar
James Laver committed
87
      dtCommon = RX.pick props :: Record DTCommon
88 89
      dtExtra =
        { chart: mempty
90 91
        --, listId: props.contactData.defaultListId
        , listId: defaultListId
92 93 94 95
        , mCorpusId: Nothing
        , showSearch: true
        , tabType: TabPairing TabDocs
        , totalRecords
96
        , yearFilter
James Laver's avatar
James Laver committed
97 98 99
        }

type DTCommon =
100
  ( cacheState        :: T.Box LTypes.CacheState
101
  -- , contactData       :: ContactData
James Laver's avatar
James Laver committed
102
  , frontends         :: Frontends
Alexandre Delanoë's avatar
Alexandre Delanoë committed
103 104
  , nodeId            :: Int
  , session           :: Session
105
  -- , sidePanel    :: T.Box (Record SidePanel)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
106 107
  )

108
type NgramsViewTabsProps =
109
  ( mode          :: Mode
110 111
  | TabsProps )

James Laver's avatar
James Laver committed
112
ngramsView :: R2.Leaf NgramsViewTabsProps
113
ngramsView = R2.leaf ngramsViewCpt
Alexandre Delanoë's avatar
Alexandre Delanoë committed
114
ngramsViewCpt :: R.Component NgramsViewTabsProps
James Laver's avatar
James Laver committed
115
ngramsViewCpt = here.component "ngramsView" cpt where
116
  cpt props@{ defaultListId, mode, nodeId, session } _ = do
117
    path <- T.useBox $
James Laver's avatar
James Laver committed
118 119
      NTC.initialPageParams session nodeId
      [ defaultListId ] (TabDocument TabDocs)
120

121 122 123 124
    onCancelRef <- R.useRef Nothing
    onNgramsClickRef <- R.useRef Nothing
    onSaveRef <- R.useRef Nothing
    treeEditBox <- T.useBox NT.initialTreeEdit
125

126 127
    let most = RX.pick props :: Record NTCommon
        props' =
128 129 130 131 132
          (Record.merge most
           { afterSync
           , path
           , tabType:        TabPairing (TabNgramType $ modeTabType mode)
           , tabNgramType:   modeTabType' mode
133
           , treeEdit: { box: treeEditBox
134 135
                       , getNgramsChildrenAff: Nothing
                       , getNgramsChildren: Nothing
136 137 138
                       , onCancelRef
                       , onNgramsClickRef
                       , onSaveRef }
139 140 141
           , withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
        afterSync :: Unit -> Aff Unit
        afterSync _ = pure unit
James Laver's avatar
James Laver committed
142

143 144 145

    pure $ NT.mainNgramsTable props' []

James Laver's avatar
James Laver committed
146
type NTCommon =
147 148 149 150
  ( boxes         :: Boxes
  , cacheState    :: T.Box LTypes.CacheState
  , defaultListId :: Int
  , session       :: Session
James Laver's avatar
James Laver committed
151
  )