Annuaire.purs 11.1 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.Ends (url, Frontends)
21
import Gargantext.Hooks.Loader (useLoader)
22
import Gargantext.Routes (SessionRoute(..))
23
import Gargantext.Routes as Routes
24
import Gargantext.Sessions (Session, sessionId, get)
25
import Gargantext.Types (NodeType(..), AffTableResult, TableResult)
26 27 28
import Gargantext.Utils.Reactix as R2

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

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

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

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

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

annuaireLayoutCpt :: R.Component LayoutProps
52
annuaireLayoutCpt = R.hooksComponentWithModule thisModule "annuaireLayout" cpt
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
  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
68
annuaireLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "annuaireLayoutWithKey" cpt
69
  where
70
    cpt { frontends, nodeId, session } _ = do
71
      path <- R.useState' nodeId
72

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

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

-- | 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
89
annuaireCpt = R.hooksComponentWithModule thisModule "annuaire" cpt
90
  where
91 92 93
    cpt {session, path, info: info@(AnnuaireInfo {name, date: date'}), frontends} _ = do
      pagePath <- R.useState' $ initialPagePath (fst path)

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

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

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

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

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

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

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

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

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

168 169
type AnnuaireId = Int

170
type ContactCellsProps =
171 172
  ( annuaireId :: AnnuaireId
  , contact    :: CT.NodeContact
173 174 175 176 177 178 179 180
  , frontends  :: Frontends
  , session   :: Session
  )

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

contactCellsCpt :: R.Component ContactCellsProps
181
contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt
182
  where
183
    cpt { annuaireId
184
        , contact: (CT.NodeContact { id, hyperdata: (CT.HyperdataContact {who : Nothing}) })
185 186
        , frontends
        , session } _ =
187
      pure $ T.makeRow [ H.text ""
188
                       , H.span {} [ H.text "Name" ]
189 190 191 192 193 194
                       --, 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" ]
                       ]
195
    cpt { annuaireId
196 197 198 199 200 201 202 203 204
        , contact: (CT.NodeContact { id
                               , hyperdata: ( CT.HyperdataContact { who : Just (CT.ContactWho { firstName
                                                                                              , lastName
                                                                                              }
                                                                               )
                                                                  }
                                            )
                               }
                   )
205
        , frontends
206 207
        , session } _ = do

208 209
        pure $ T.makeRow [
          H.text ""
210
          , H.text $ fromMaybe "First Name" firstName
211 212
          , H.text $ fromMaybe "First Name" lastName
          , H.text  "CNRS"
213
          -- , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
214
            --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
215
          --, H.text $ maybe "No ContactWhere" contactWhereOrg  (A.head $ ou)
216 217 218
         -- , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
         -- , H.div {className: "nooverflow"} [
         --     H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
219 220 221 222 223 224 225 226
            ]
          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 }) =
227
              fromMaybe "No orga (list)" (A.head orga)
228 229
            contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
            contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
230
              fromMaybe "No Dept (list)" (A.head dept)
231 232
            contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
            contactWhereRole (CT.ContactWhere { role: Just role }) = role
233

234 235 236 237

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

239 240 241
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
  decodeJson json = do
    obj   <- decodeJson json
242 243
    title <- obj .:? "title"
    desc  <- obj .:? "desc"
244
    pure $ HyperdataAnnuaire { title, desc }
245

246 247 248 249 250 251 252
------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id        :: Int
                                    , typename  :: Int
                                    , userId    :: Int
                                    , parentId  :: Int
                                    , name      :: String
                                    , date      :: String
253
                                    , hyperdata :: HyperdataAnnuaire
254 255 256
                                    }

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


276
--newtype AnnuaireTable  = AnnuaireTable  { annuaireTable :: Array (Maybe Contact)}
277

278 279 280 281
--instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
--  decodeJson json = do
--    rows <- decodeJson json
--    pure $ AnnuaireTable { annuaireTable : rows}
282

283
------------------------------------------------------------------------
284

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

295 296 297
  where
    children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)

298
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
299
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
300