Annuaire.purs 10.2 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.Either (Either)
9
import Data.Eq.Generic (genericEq)
10
import Data.Generic.Rep (class Generic)
11
import Data.Maybe (Maybe(..), maybe, fromMaybe)
12
import Data.Newtype (class Newtype)
13
import Data.Sequence as Seq
14
import Data.Symbol (SProxy(..))
15 16
import Effect.Aff (Aff, launchAff_)
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 20
import Gargantext.Components.Table (defaultContainer, initialParams, makeRow, table, tableHeaderLayout) as TT
import Gargantext.Components.Table.Types (ColumnName(..), Params) as TT
21
import Gargantext.Config.REST (RESTError, logRESTError)
22
import Gargantext.Ends (url, Frontends)
23
import Gargantext.Hooks.Loader (useLoader)
24
import Gargantext.Routes (SessionRoute(..))
25
import Gargantext.Routes as Routes
26
import Gargantext.Sessions (Session, sessionId, get)
27
import Gargantext.Types (NodeType(..), AffETableResult, TableResult)
28
import Gargantext.Utils.Reactix as R2
29 30 31 32 33
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Simple.JSON as JSON
import Toestand as T
34

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

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

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

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

James Laver's avatar
James Laver committed
57
annuaireLayout :: R2.Leaf LayoutProps
58 59 60
annuaireLayout props = R.createElement annuaireLayoutCpt props []

annuaireLayoutCpt :: R.Component LayoutProps
James Laver's avatar
James Laver committed
61
annuaireLayoutCpt = here.component "annuaireLayout" cpt where
62 63 64 65
  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
66 67

type KeyLayoutProps =
68 69
  ( key       :: String
  | LayoutProps
70 71
  )

James Laver's avatar
James Laver committed
72
annuaireLayoutWithKey :: R2.Leaf KeyLayoutProps
73 74 75
annuaireLayoutWithKey props = R.createElement annuaireLayoutWithKeyCpt props []

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

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

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

-- | Renders a basic table and the page loader
James Laver's avatar
James Laver committed
96
annuaire :: R2.Leaf AnnuaireProps
97 98 99 100
annuaire props = R.createElement annuaireCpt props []

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

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

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

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

130
type PagePath = { nodeId :: Int, params :: TT.Params }
131 132

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

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

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

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

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

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

pageCpt :: R.Component PageProps
James Laver's avatar
James Laver committed
167
pageCpt = here.component "page" cpt
168
  where
169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
    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

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

192 193
type AnnuaireId = Int

194
type ContactCellsProps =
195 196
  ( annuaireId :: AnnuaireId
  , contact    :: CT.NodeContact
197
  , frontends  :: Frontends
James Laver's avatar
James Laver committed
198
  , session    :: Session
199 200 201 202 203
  )

contactCells :: Record ContactCellsProps -> R.Element
contactCells p = R.createElement contactCellsCpt p []
contactCellsCpt :: R.Component ContactCellsProps
James Laver's avatar
James Laver committed
204
contactCellsCpt = here.component "contactCells" cpt where
205 206
  cpt { contact: CT.NodeContact
        { hyperdata: CT.HyperdataContact { who : Nothing } } } _ =
207
    pure $ TT.makeRow
James Laver's avatar
James Laver committed
208 209 210 211 212 213 214 215 216 217 218 219 220
    [ 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"
    , H.div { className: "nooverflow" }
      [ H.text "No ContactWhereRole" ]
    ]
  cpt { annuaireId, frontends, session
      , contact: CT.NodeContact
        { id, hyperdata: CT.HyperdataContact
              { who: Just (CT.ContactWho { firstName, lastName })
              , ou:  ou }}} _ = do
221
    pure $ TT.makeRow [
James Laver's avatar
James Laver committed
222 223 224 225 226 227 228 229 230 231 232 233
      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
234
        contactUrl aId id' = url frontends $ Routes.ContactPage (sessionId session) aId id'
James Laver's avatar
James Laver committed
235 236 237 238 239 240
        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)
241

242
newtype HyperdataAnnuaire = HyperdataAnnuaire
243 244
  { title :: Maybe String
  , desc  :: Maybe String }
245
derive instance Generic HyperdataAnnuaire _
246 247 248
derive instance Newtype HyperdataAnnuaire _
instance Eq HyperdataAnnuaire where eq = genericEq
derive newtype instance JSON.ReadForeign HyperdataAnnuaire
249

250
------------------------------------------------------------------------------
James Laver's avatar
James Laver committed
251 252 253 254 255 256 257 258 259 260
newtype AnnuaireInfo =
  AnnuaireInfo
  { id        :: Int
  , typename  :: Int
  , userId    :: Int
  , parentId  :: Int
  , name      :: String
  , date      :: String
  , hyperdata :: HyperdataAnnuaire
  }
261
derive instance Generic AnnuaireInfo _
262 263 264 265 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
      user_idP = SProxy :: SProxy "user_id"
      userIdP = SProxy :: SProxy "userId"
      parent_idP = SProxy :: SProxy "parent_id"
      parentIdP = SProxy :: SProxy "parentId"
273

274
--newtype AnnuaireTable  = AnnuaireTable  { annuaireTable :: Array (Maybe Contact)}
275

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

281
------------------------------------------------------------------------
282

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

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

296
getAnnuaireInfo :: Session -> Int -> Aff (Either RESTError AnnuaireInfo)
297
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
298