Annuaire.purs 11.3 KB
Newer Older
1
module Gargantext.Components.Nodes.Annuaire where
2

3
import Prelude (bind, const, identity, pure, show, ($), (<$>), (<>))
4
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
5
import Data.Array as A
6
import Data.Maybe (Maybe(..), maybe, fromMaybe)
7
import Data.Sequence as Seq
8
import Data.Tuple (fst, snd)
9
import Data.Tuple.Nested ((/\))
10
import Effect.Aff (Aff, launchAff_)
11 12 13
import Reactix as R
import Reactix.DOM.HTML as H

14 15
import Gargantext.Prelude

16
import Gargantext.Components.NgramsTable.Loader (clearCache)
17
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
18
import Gargantext.Components.Nodes.Lists.Types as NT
19
import Gargantext.Components.Table as T
20
import Gargantext.Components.Table.Types as T
21
import Gargantext.Ends (url, Frontends)
22
import Gargantext.Hooks.Loader (useLoader)
23
import Gargantext.Routes (SessionRoute(..))
24
import Gargantext.Routes as Routes
25
import Gargantext.Sessions (Session, sessionId, get)
26
import Gargantext.Types (NodeType(..), AffTableResult, TableResult)
27 28 29
import Gargantext.Utils.Reactix as R2

thisModule = "Gargantext.Components.Nodes.Annuaire"
30

31 32 33 34 35 36
newtype IndividuView =
  CorpusView
  { id      :: Int
  , name    :: String
  , role    :: String
  , company :: String }
37

38 39
--toRows :: AnnuaireTable -> Array (Maybe Contact)
--toRows (AnnuaireTable a) = a.annuaireTable
40

41 42
-- | Top level layout component. Loads an annuaire by id and renders
-- | the annuaire using the result
43 44 45 46 47
type LayoutProps = (
    frontends :: Frontends
  , nodeId :: Int
  , session :: Session
  )
48 49 50 51 52

annuaireLayout :: Record LayoutProps -> R.Element
annuaireLayout props = R.createElement annuaireLayoutCpt props []

annuaireLayoutCpt :: R.Component LayoutProps
53
annuaireLayoutCpt = R.hooksComponentWithModule thisModule "annuaireLayout" cpt
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
  where
    cpt { frontends, nodeId, session } _ = do
      let sid = sessionId session

      pure $ annuaireLayoutWithKey { frontends, key: show sid <> "-" <> show nodeId, nodeId, session }

type KeyLayoutProps = (
  key :: String
  | LayoutProps
  )

annuaireLayoutWithKey :: Record KeyLayoutProps -> R.Element
annuaireLayoutWithKey props = R.createElement annuaireLayoutWithKeyCpt props []

annuaireLayoutWithKeyCpt :: R.Component KeyLayoutProps
69
annuaireLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "annuaireLayoutWithKey" cpt
70
  where
71
    cpt { frontends, nodeId, session } _ = do
72
      path <- R.useState' nodeId
73

74
      useLoader (fst path) (getAnnuaireInfo session) $
75
        \info -> annuaire { frontends, info, path, session }
76

77
type AnnuaireProps =
78 79 80 81 82
  ( session   :: Session
  , path      :: R.State Int
  , info      :: AnnuaireInfo
  , frontends :: Frontends
  )
83 84 85 86 87 88 89

-- | Renders a basic table and the page loader
annuaire :: Record AnnuaireProps -> R.Element
annuaire props = R.createElement annuaireCpt props []

-- Abuses closure to work around the Loader
annuaireCpt :: R.Component AnnuaireProps
90
annuaireCpt = R.hooksComponentWithModule thisModule "annuaire" cpt
91
  where
92 93 94
    cpt {session, path, info: info@(AnnuaireInfo {name, date: date'}), frontends} _ = do
      pagePath <- R.useState' $ initialPagePath (fst path)

95
      cacheState <- R.useState' NT.CacheOff
96

97
      pure $ R.fragment
98
        [ T.tableHeaderLayout { afterCacheStateChange: \_ -> launchAff_ $ clearCache unit
99 100 101
                              , cacheState
                              , date
                              , desc: name
102
                              , key: "annuaire-" <> (show $ fst cacheState)
103 104 105
                              , query: ""
                              , title: name
                              , user: "" }
106 107 108 109 110
          , H.p {} []
          , H.div {className: "col-md-3"}
            [ H.text "    Filter ", H.input { className: "form-control", style } ]
          , H.br {}
          , pageLayout { info, session, pagePath, frontends} ]
111 112 113
      where
        date = "Last update: " <> date'
        style = {width: "250px", display: "inline-block"}
114
        initialPagePath nodeId = {nodeId, params: T.initialParams}
115

116 117 118
type PagePath = { nodeId :: Int
                , params :: T.Params
                }
119 120

type PageLayoutProps =
121 122
  ( session      :: Session
  , frontends    :: Frontends
123 124
  , info         :: AnnuaireInfo
  , pagePath     :: R.State PagePath
125
  )
126 127 128 129 130

pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []

pageLayoutCpt :: R.Component PageLayoutProps
131
pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt
132
  where
133
    cpt {info, frontends, pagePath, session} _ = do
134
      useLoader (fst pagePath) (loadPage session) $
135
        \table -> page {session, table, frontends, pagePath}
136 137

type PageProps = 
138
  ( session :: Session
139
  , frontends :: Frontends
140 141
  , pagePath :: R.State PagePath
  -- , info :: AnnuaireInfo
142
  , table :: TableResult CT.NodeContact
143
  )
144 145 146 147 148

page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []

pageCpt :: R.Component PageProps
149
pageCpt = R.hooksComponentWithModule thisModule "page" cpt
150
  where
151
    cpt { session, pagePath, frontends
152
        , table: ({count: totalRecords, docs})} _ = do
153 154 155 156 157
      pure $ T.table { syncResetButton : [ H.div {} [] ]
                     , rows, params, container
                     , colNames, totalRecords
                     , wrapColElts
                     }
158
      where
159
        path = fst pagePath
160 161 162 163 164
        rows = (\c -> {
                   row: contactCells { annuaireId: (fst pagePath).nodeId
                                     , frontends
                                     , contact: c
                                     , session }
165
                   , delete: false }) <$> Seq.fromFoldable docs
166
        container = T.defaultContainer { title: "Annuaire" } -- TODO
167
        colNames = T.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Lab", "Role"]
168
        wrapColElts = const identity
169 170 171
        setParams f = snd pagePath $ \pp@{params: ps} ->
          pp {params = f ps}
        params = (fst pagePath).params /\ setParams
172

173 174
type AnnuaireId = Int

175
type ContactCellsProps =
176 177
  ( annuaireId :: AnnuaireId
  , contact    :: CT.NodeContact
178 179 180 181 182 183 184 185
  , frontends  :: Frontends
  , session   :: Session
  )

contactCells :: Record ContactCellsProps -> R.Element
contactCells p = R.createElement contactCellsCpt p []

contactCellsCpt :: R.Component ContactCellsProps
186
contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt
187
  where
188
    cpt { annuaireId
189
        , contact: (CT.NodeContact { id, hyperdata: (CT.HyperdataContact {who : Nothing}) })
190 191
        , frontends
        , session } _ =
192
      pure $ T.makeRow [ H.text ""
193
                       , H.span {} [ H.text "Name" ]
194 195 196 197 198 199
                       --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
                       , H.text "No ContactWhere"
                       , H.text "No ContactWhereDept"
                       , H.div { className: "nooverflow"}
                               [ H.text "No ContactWhereRole" ]
                       ]
200
    cpt { annuaireId
201 202 203 204 205 206 207 208 209
        , contact: (CT.NodeContact { id
                               , hyperdata: ( CT.HyperdataContact { who : Just (CT.ContactWho { firstName
                                                                                              , lastName
                                                                                              }
                                                                               )
                                                                  }
                                            )
                               }
                   )
210
        , frontends
211 212
        , session } _ = do

213 214
        pure $ T.makeRow [
          H.text ""
215
          , H.text $ fromMaybe "First Name" firstName
216 217
          , H.text $ fromMaybe "First Name" lastName
          , H.text  "CNRS"
218
          -- , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
219
            --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
220
          --, H.text $ maybe "No ContactWhere" contactWhereOrg  (A.head $ ou)
221 222 223
         -- , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
         -- , H.div {className: "nooverflow"} [
         --     H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
224 225 226 227 228 229 230 231
            ]
          where
            --nodepath = NodePath (sessionId session) NodeContact (Just id)
            nodepath = Routes.ContactPage (sessionId session) annuaireId id
            href = url frontends nodepath

            contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
            contactWhereOrg (CT.ContactWhere { organization: orga }) =
232
              fromMaybe "No orga (list)" (A.head orga)
233 234
            contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
            contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
235
              fromMaybe "No Dept (list)" (A.head dept)
236 237
            contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
            contactWhereRole (CT.ContactWhere { role: Just role }) = role
238

239 240 241 242

data HyperdataAnnuaire = HyperdataAnnuaire
  { title :: Maybe String
  , desc  :: Maybe String }
243

244 245 246
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
  decodeJson json = do
    obj   <- decodeJson json
247 248
    title <- obj .:? "title"
    desc  <- obj .:? "desc"
249
    pure $ HyperdataAnnuaire { title, desc }
250

251 252 253 254 255 256 257
------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id        :: Int
                                    , typename  :: Int
                                    , userId    :: Int
                                    , parentId  :: Int
                                    , name      :: String
                                    , date      :: String
258
                                    , hyperdata :: HyperdataAnnuaire
259 260 261
                                    }

instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
262 263
  decodeJson json = do
    obj <- decodeJson json
264 265 266 267 268 269 270
    id        <- obj .: "id"
    typename  <- obj .: "typename"
    userId    <- obj .: "userId"
    parentId  <- obj .: "parentId"
    name      <- obj .: "name"
    date      <- obj .: "date"
    hyperdata <- obj .: "hyperdata"
271 272 273 274 275 276 277 278 279 280
    pure $ AnnuaireInfo { id : id
                        , typename : typename
                        , userId   : userId
                        , parentId : parentId
                        , name     : name
                        , date     : date
                        , hyperdata: hyperdata
                        }


281
--newtype AnnuaireTable  = AnnuaireTable  { annuaireTable :: Array (Maybe Contact)}
282

283 284 285 286
--instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
--  decodeJson json = do
--    rows <- decodeJson json
--    pure $ AnnuaireTable { annuaireTable : rows}
287

288
------------------------------------------------------------------------
289

290
loadPage :: Session -> PagePath -> AffTableResult CT.NodeContact
291
loadPage session {nodeId, params: { offset, limit, orderBy }} =
292
    get session children
293 294 295 296 297 298
 -- TODO orderBy
 -- where
 --   convOrderBy (T.ASC  (T.ColumnName "Name")) = NameAsc
 --   convOrderBy (T.DESC (T.ColumnName "Name")) = NameDesc
 --   ...
 --   convOrderBy _ = NameAsc -- TODO
299

300 301 302
  where
    children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)

303
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
304
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
305