Annuaire.purs 10.5 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 6
import Data.Array as A
import Data.List as L
7
import Data.Maybe (Maybe(..), maybe, fromMaybe)
8
import Data.Tuple (fst, snd)
9
import Data.Tuple.Nested ((/\))
10
import Effect.Aff (Aff)
11
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
12
import Gargantext.Components.Table as T
13
import Gargantext.Ends (url, Frontends)
14
import Gargantext.Hooks.Loader (useLoader)
15
import Gargantext.Routes (SessionRoute(..))
16
import Gargantext.Routes as Routes
17
import Gargantext.Sessions (Session, sessionId, get)
18
import Gargantext.Types (NodeType(..), AffTableResult, TableResult)
19 20 21
import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
import Reactix as R
import Reactix.DOM.HTML as H
22

23 24 25 26 27 28
newtype IndividuView =
  CorpusView
  { id      :: Int
  , name    :: String
  , role    :: String
  , company :: String }
29

30 31
--toRows :: AnnuaireTable -> Array (Maybe Contact)
--toRows (AnnuaireTable a) = a.annuaireTable
32

33 34
-- | Top level layout component. Loads an annuaire by id and renders
-- | the annuaire using the result
35 36 37 38 39
type LayoutProps = (
    frontends :: Frontends
  , nodeId :: Int
  , session :: Session
  )
40 41 42 43 44

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

annuaireLayoutCpt :: R.Component LayoutProps
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
annuaireLayoutCpt = R.hooksComponent "G.C.N.A.annuaireLayout" cpt
  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
annuaireLayoutWithKeyCpt = R.hooksComponent "G.C.N.A.annuaireLayoutWithKey" cpt
62
  where
63
    cpt { frontends, nodeId, session } _ = do
64
      path <- R.useState' nodeId
65
      useLoader (fst path) (getAnnuaireInfo session) $
66
        \info -> annuaire { frontends, info, path, session }
67

68
type AnnuaireProps =
69 70 71 72 73
  ( session   :: Session
  , path      :: R.State Int
  , info      :: AnnuaireInfo
  , frontends :: Frontends
  )
74 75 76 77 78 79 80

-- | 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
81
annuaireCpt = R.hooksComponent "G.P.Annuaire.annuaire" cpt
82
  where
83 84 85
    cpt {session, path, info: info@(AnnuaireInfo {name, date: date'}), frontends} _ = do
      pagePath <- R.useState' $ initialPagePath (fst path)

86
      pure $ R.fragment
87 88 89 90 91 92
        [ T.tableHeaderLayout headerProps
          , H.p {} []
          , H.div {className: "col-md-3"}
            [ H.text "    Filter ", H.input { className: "form-control", style } ]
          , H.br {}
          , pageLayout { info, session, pagePath, frontends} ]
93 94 95 96
      where
        headerProps = { title: name, desc: name, query: "", date, user: ""}
        date = "Last update: " <> date'
        style = {width: "250px", display: "inline-block"}
97
        initialPagePath nodeId = {nodeId, params: T.initialParams}
98

99 100 101
type PagePath = { nodeId :: Int
                , params :: T.Params
                }
102 103

type PageLayoutProps =
104 105
  ( session      :: Session
  , frontends    :: Frontends
106 107
  , info         :: AnnuaireInfo
  , pagePath     :: R.State PagePath
108
  )
109 110 111 112 113 114

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

pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponent "G.P.Annuaire.pageLayout" cpt
115
  where
116
    cpt {info, frontends, pagePath, session} _ = do
117
      useLoader (fst pagePath) (loadPage session) $
118
        \table -> page {session, table, frontends, pagePath}
119 120

type PageProps = 
121
  ( session :: Session
122
  , frontends :: Frontends
123 124
  , pagePath :: R.State PagePath
  -- , info :: AnnuaireInfo
125
  , table :: TableResult CT.NodeContact
126
  )
127 128 129 130 131

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

pageCpt :: R.Component PageProps
132
pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
133
  where
134
    cpt { session, pagePath, frontends
135
        , table: ({count: totalRecords, docs})} _ = do
136
      pure $ T.table { rows, params, container, colNames, totalRecords, wrapColElts }
137
      where
138
        path = fst pagePath
139 140 141 142 143
        rows = (\c -> {
                   row: contactCells { annuaireId: (fst pagePath).nodeId
                                     , frontends
                                     , contact: c
                                     , session }
144
                   , delete: false }) <$> L.fromFoldable docs
145
        container = T.defaultContainer { title: "Annuaire" } -- TODO
146
        colNames = T.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Lab", "Role"]
147
        wrapColElts = const identity
148 149 150
        setParams f = snd pagePath $ \pp@{params: ps} ->
          pp {params = f ps}
        params = (fst pagePath).params /\ setParams
151

152 153
type AnnuaireId = Int

154
type ContactCellsProps =
155 156
  ( annuaireId :: AnnuaireId
  , contact    :: CT.NodeContact
157 158 159 160 161 162 163 164 165
  , frontends  :: Frontends
  , session   :: Session
  )

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

contactCellsCpt :: R.Component ContactCellsProps
contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt
166
  where
167
    cpt { annuaireId
168
        , contact: (CT.NodeContact { id, hyperdata: (CT.HyperdataContact {who : Nothing}) })
169 170
        , frontends
        , session } _ =
171
      pure $ T.makeRow [ H.text ""
172
                       , H.span {} [ H.text "Name" ]
173 174 175 176 177 178
                       --, 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" ]
                       ]
179
    cpt { annuaireId
180 181 182 183 184 185 186 187 188
        , contact: (CT.NodeContact { id
                               , hyperdata: ( CT.HyperdataContact { who : Just (CT.ContactWho { firstName
                                                                                              , lastName
                                                                                              }
                                                                               )
                                                                  }
                                            )
                               }
                   )
189
        , frontends
190 191
        , session } _ = do

192 193
        pure $ T.makeRow [
          H.text ""
194
          , H.text $ fromMaybe "First Name" firstName
195 196
          , H.text $ fromMaybe "First Name" lastName
          , H.text  "CNRS"
197
          -- , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
198
            --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
199
          --, H.text $ maybe "No ContactWhere" contactWhereOrg  (A.head $ ou)
200 201 202
         -- , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
         -- , H.div {className: "nooverflow"} [
         --     H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
203 204 205 206 207 208 209 210
            ]
          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 }) =
211
              fromMaybe "No orga (list)" (A.head orga)
212 213
            contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
            contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
214
              fromMaybe "No Dept (list)" (A.head dept)
215 216
            contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
            contactWhereRole (CT.ContactWhere { role: Just role }) = role
217

218 219 220 221

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

223 224 225
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
  decodeJson json = do
    obj   <- decodeJson json
226 227
    title <- obj .:? "title"
    desc  <- obj .:? "desc"
228
    pure $ HyperdataAnnuaire { title, desc }
229

230 231 232 233 234 235 236
------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id        :: Int
                                    , typename  :: Int
                                    , userId    :: Int
                                    , parentId  :: Int
                                    , name      :: String
                                    , date      :: String
237
                                    , hyperdata :: HyperdataAnnuaire
238 239 240
                                    }

instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
241 242
  decodeJson json = do
    obj <- decodeJson json
243 244 245 246 247 248 249
    id        <- obj .: "id"
    typename  <- obj .: "typename"
    userId    <- obj .: "userId"
    parentId  <- obj .: "parentId"
    name      <- obj .: "name"
    date      <- obj .: "date"
    hyperdata <- obj .: "hyperdata"
250 251 252 253 254 255 256 257 258 259
    pure $ AnnuaireInfo { id : id
                        , typename : typename
                        , userId   : userId
                        , parentId : parentId
                        , name     : name
                        , date     : date
                        , hyperdata: hyperdata
                        }


260
--newtype AnnuaireTable  = AnnuaireTable  { annuaireTable :: Array (Maybe Contact)}
261

262 263 264 265
--instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
--  decodeJson json = do
--    rows <- decodeJson json
--    pure $ AnnuaireTable { annuaireTable : rows}
266

267
------------------------------------------------------------------------
268

269
loadPage :: Session -> PagePath -> AffTableResult CT.NodeContact
270
loadPage session {nodeId, params: { offset, limit, orderBy }} =
271
    get session children
272 273 274 275 276 277
 -- TODO orderBy
 -- where
 --   convOrderBy (T.ASC  (T.ColumnName "Name")) = NameAsc
 --   convOrderBy (T.DESC (T.ColumnName "Name")) = NameDesc
 --   ...
 --   convOrderBy _ = NameAsc -- TODO
278

279 280 281
  where
    children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)

282
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
283
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
284