Annuaire.purs 10.1 KB
Newer Older
James Laver's avatar
James Laver committed
1 2 3
module Gargantext.Components.Nodes.Annuaire
 -- ( annuaire )
 where
4

5 6
import Gargantext.Prelude

7
import Data.Array as A
8
import Data.Eq.Generic (genericEq)
9
import Data.Generic.Rep (class Generic)
10
import Data.Maybe (Maybe(..), maybe, fromMaybe)
11
import Data.Newtype (class Newtype)
12
import Data.Sequence as Seq
13
import Effect.Aff (launchAff_)
14
import Gargantext.Components.NgramsTable.Loader (clearCache)
15
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
16
import Gargantext.Components.Nodes.Lists.Types as NT
17 18
import Gargantext.Components.Table (defaultContainer, initialParams, makeRow, table, tableHeaderLayout) as TT
import Gargantext.Components.Table.Types (ColumnName(..), Params) as TT
19
import Gargantext.Config.REST (AffRESTError, logRESTError)
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(..), AffETableResult, TableResult)
26
import Gargantext.Utils.Reactix as R2
27 28 29 30 31
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Simple.JSON as JSON
import Toestand as T
32
import Type.Proxy (Proxy(..))
33

James Laver's avatar
James Laver committed
34 35
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire"
36

37 38 39 40 41
newtype IndividuView =
  CorpusView
  { id      :: Int
  , name    :: String
  , role    :: String
James Laver's avatar
James Laver committed
42 43
  , company :: String
  }
44

45 46
--toRows :: AnnuaireTable -> Array (Maybe Contact)
--toRows (AnnuaireTable a) = a.annuaireTable
47

48 49
-- | Top level layout component. Loads an annuaire by id and renders
-- | the annuaire using the result
James Laver's avatar
James Laver committed
50 51 52
type LayoutProps =
  ( frontends :: Frontends
  , nodeId    :: Int
53
  , session   :: Session
54
  )
55

James Laver's avatar
James Laver committed
56
annuaireLayout :: R2.Leaf LayoutProps
57
annuaireLayout = R2.leaf annuaireLayoutCpt
58
annuaireLayoutCpt :: R.Component LayoutProps
James Laver's avatar
James Laver committed
59
annuaireLayoutCpt = here.component "annuaireLayout" cpt where
60 61 62 63
  cpt { frontends, nodeId, session } _ = do
    pure $ annuaireLayoutWithKey { frontends, key, nodeId, session }
      where
        key = show (sessionId session) <> "-" <> show nodeId
James Laver's avatar
James Laver committed
64 65

type KeyLayoutProps =
66 67
  ( key       :: String
  | LayoutProps
68 69
  )

James Laver's avatar
James Laver committed
70
annuaireLayoutWithKey :: R2.Leaf KeyLayoutProps
71
annuaireLayoutWithKey = R2.leaf annuaireLayoutWithKeyCpt
72 73

annuaireLayoutWithKeyCpt :: R.Component KeyLayoutProps
James Laver's avatar
James Laver committed
74 75
annuaireLayoutWithKeyCpt = here.component "annuaireLayoutWithKey" cpt where
  cpt { frontends, nodeId, session } _ = do
76 77 78
    path <- T.useBox nodeId
    path' <- T.useLive T.unequal path

79 80 81 82 83
    useLoader { errorHandler
              , loader: getAnnuaireInfo session
              , path: path'
              , render: \info -> annuaire { frontends, info, path, session } }
    where
84
      errorHandler = logRESTError here "[annuaireLayoutWithKey]"
85

86
type AnnuaireProps =
87
  ( session   :: Session
88
  , path      :: T.Box Int
89 90 91
  , info      :: AnnuaireInfo
  , frontends :: Frontends
  )
92 93

-- | Renders a basic table and the page loader
James Laver's avatar
James Laver committed
94
annuaire :: R2.Leaf AnnuaireProps
95
annuaire = R2.leaf annuaireCpt
96 97 98

-- Abuses closure to work around the Loader
annuaireCpt :: R.Component AnnuaireProps
James Laver's avatar
James Laver committed
99
annuaireCpt = here.component "annuaire" cpt
100
  where
101
    cpt {session, path, info: info@(AnnuaireInfo {name, date: date'}), frontends} _ = do
102 103 104
      path' <- T.useLive T.unequal path

      pagePath <- T.useBox $ initialPagePath path'
105 106 107 108 109 110
      cacheState <- T.useBox NT.CacheOff
      cacheState' <- T.useLive T.unequal cacheState

      R.useEffectOnce' $ do
        T.listen (\_ -> launchAff_ $ clearCache unit) cacheState

111
      pure $ R.fragment
112
        [ TT.tableHeaderLayout
113
            { cacheState
James Laver's avatar
James Laver committed
114 115
            , date
            , desc: name
116
            , key: "annuaire-" <> (show cacheState')
James Laver's avatar
James Laver committed
117 118
            , query: ""
            , title: name
119
            , user: "" } []
James Laver's avatar
James Laver committed
120
        , H.p {} []
121
          -- , H.div {className: "col-md-3"} [ H.text "    Filter ", H.input { className: "form-control", style } ]
122 123
          , H.br {}
          , pageLayout { info, session, pagePath, frontends} ]
124 125
      where
        date = "Last update: " <> date'
126
        initialPagePath nodeId = {nodeId, params: TT.initialParams}
127

128
type PagePath = { nodeId :: Int, params :: TT.Params }
129 130

type PageLayoutProps =
131 132
  ( session      :: Session
  , frontends    :: Frontends
133
  , info         :: AnnuaireInfo
134
  , pagePath     :: T.Box PagePath
135
  )
136 137 138 139 140

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

pageLayoutCpt :: R.Component PageLayoutProps
James Laver's avatar
James Laver committed
141
pageLayoutCpt = here.component "pageLayout" cpt
142
  where
143
    cpt { frontends, pagePath, session } _ = do
144 145
      pagePath' <- T.useLive T.unequal pagePath

146 147 148 149 150
      useLoader { errorHandler
                , loader: loadPage session
                , path: pagePath'
                , render: \table -> page { session, table, frontends, pagePath } }
      where
151
        errorHandler = logRESTError here "[pageLayout]"
152

153
type PageProps =
154
  ( frontends :: Frontends
155
  , pagePath  :: T.Box PagePath
156
  -- , info :: AnnuaireInfo
157
  , session   :: Session
James Laver's avatar
James Laver committed
158
  , table     :: TableResult CT.NodeContact
159
  )
160 161 162 163

page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps
James Laver's avatar
James Laver committed
164
pageCpt = here.component "page" cpt
165
  where
166 167 168 169 170 171 172
    cpt { frontends
        , pagePath
        , session
        , table: ({count: totalRecords, docs}) } _ = do
      pagePath' <- T.useLive T.unequal pagePath
      params <- T.useFocused (_.params) (\a b -> b { params = a }) pagePath

173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
      pure $

        H.div
        { className: "page-annuaire" }
        [
          TT.table
          { colNames
          , container
          , params
          , rows: rows pagePath'
          , syncResetButton : [ H.div {} [] ]
          , totalRecords
          , wrapColElts
          }
        ]
188
      where
189
        rows pagePath' = (row pagePath') <$> Seq.fromFoldable docs
190 191
        row { nodeId } contact = { row: contactCells { annuaireId: nodeId, frontends, contact, session }
                                 , delete: false }
192
        container = TT.defaultContainer -- TODO
193
        colNames = TT.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Role"]
194
        wrapColElts = const identity
195

196 197
type AnnuaireId = Int

198
type ContactCellsProps =
199 200
  ( annuaireId :: AnnuaireId
  , contact    :: CT.NodeContact
201
  , frontends  :: Frontends
James Laver's avatar
James Laver committed
202
  , session    :: Session
203 204 205 206 207
  )

contactCells :: Record ContactCellsProps -> R.Element
contactCells p = R.createElement contactCellsCpt p []
contactCellsCpt :: R.Component ContactCellsProps
James Laver's avatar
James Laver committed
208
contactCellsCpt = here.component "contactCells" cpt where
209 210
  cpt { contact: CT.NodeContact
        { hyperdata: CT.HyperdataContact { who : Nothing } } } _ =
211
    pure $ TT.makeRow
James Laver's avatar
James Laver committed
212 213 214 215 216
    [ H.text ""
    , H.span {} [ H.text "Name" ]
      --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
    , H.text "No ContactWhere"
    , H.text "No ContactWhereDept"
217
    , H.div { className: "page-annuaire__nooverflow" }
James Laver's avatar
James Laver committed
218 219 220 221 222 223 224
      [ H.text "No ContactWhereRole" ]
    ]
  cpt { annuaireId, frontends, session
      , contact: CT.NodeContact
        { id, hyperdata: CT.HyperdataContact
              { who: Just (CT.ContactWho { firstName, lastName })
              , ou:  ou }}} _ = do
225
    pure $ TT.makeRow [
James Laver's avatar
James Laver committed
226 227 228 229 230 231 232 233 234 235 236 237
      H.text ""
      , H.a { target: "_blank", href: contactUrl annuaireId id }
        [ H.text $ fromMaybe "First Name" firstName ]
      , H.text $ fromMaybe "First Name" lastName
        -- , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
        --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
      , H.text $ maybe "No ContactWhere"     contactWhereOrg  (A.head $ ou)
      , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
        -- , H.div {className: "nooverflow"} [
        --     H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
      ]
      where
238
        contactUrl aId id' = url frontends $ Routes.ContactPage (sessionId session) aId id'
James Laver's avatar
James Laver committed
239 240 241 242 243 244
        contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
        contactWhereOrg (CT.ContactWhere { organization: orga }) =
          fromMaybe "No orga (list)" (A.head orga)
        contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
        contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
          fromMaybe "No Dept (list)" (A.head dept)
245

246
newtype HyperdataAnnuaire = HyperdataAnnuaire
247 248
  { title :: Maybe String
  , desc  :: Maybe String }
249
derive instance Generic HyperdataAnnuaire _
250 251 252
derive instance Newtype HyperdataAnnuaire _
instance Eq HyperdataAnnuaire where eq = genericEq
derive newtype instance JSON.ReadForeign HyperdataAnnuaire
253

254
------------------------------------------------------------------------------
James Laver's avatar
James Laver committed
255 256 257 258 259 260 261 262 263 264
newtype AnnuaireInfo =
  AnnuaireInfo
  { id        :: Int
  , typename  :: Int
  , userId    :: Int
  , parentId  :: Int
  , name      :: String
  , date      :: String
  , hyperdata :: HyperdataAnnuaire
  }
265
derive instance Generic AnnuaireInfo _
266 267 268 269 270 271 272
derive instance Newtype AnnuaireInfo _
instance Eq AnnuaireInfo where eq = genericEq
instance JSON.ReadForeign AnnuaireInfo where
  readImpl f = do
    inst <- JSON.readImpl f
    pure $ AnnuaireInfo $ Record.rename user_idP userIdP $ Record.rename parent_idP parentIdP inst
    where
273 274 275 276
      user_idP = Proxy :: Proxy "user_id"
      userIdP = Proxy :: Proxy "userId"
      parent_idP = Proxy :: Proxy "parent_id"
      parentIdP = Proxy :: Proxy "parentId"
277

278
--newtype AnnuaireTable  = AnnuaireTable  { annuaireTable :: Array (Maybe Contact)}
279

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

285
------------------------------------------------------------------------
286

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

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

300
getAnnuaireInfo :: Session -> Int -> AffRESTError AnnuaireInfo
301
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")