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

3
import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
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 12
import Reactix as R
import Reactix.DOM.HTML as H
13

14
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
15
import Gargantext.Components.Table as T
16
import Gargantext.Ends (url, Frontends)
17
import Gargantext.Routes (SessionRoute(..))
18
import Gargantext.Routes as Routes
19
import Gargantext.Sessions (Session, sessionId, get)
20
import Gargantext.Types (NodeType(..), AffTableResult, TableResult)
21
import Gargantext.Hooks.Loader (useLoader)
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
type LayoutProps = ( nodeId :: Int, session :: Session, frontends :: Frontends )
36 37 38 39 40 41 42

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

annuaireLayoutCpt :: R.Component LayoutProps
annuaireLayoutCpt = R.hooksComponent "G.P.Annuaire.annuaireLayout" cpt
  where
43
    cpt {nodeId, session, frontends} _ = do
44
      path <- R.useState' nodeId
45
      useLoader (fst path) (getAnnuaireInfo session) $
46
        \info -> annuaire {session, path, info, frontends}
47

48
type AnnuaireProps =
49 50 51 52 53
  ( session   :: Session
  , path      :: R.State Int
  , info      :: AnnuaireInfo
  , frontends :: Frontends
  )
54 55 56 57 58 59 60

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

66
      pure $ R.fragment
67 68 69 70 71 72
        [ 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} ]
73 74 75 76
      where
        headerProps = { title: name, desc: name, query: "", date, user: ""}
        date = "Last update: " <> date'
        style = {width: "250px", display: "inline-block"}
77
        initialPagePath nodeId = {nodeId, params: T.initialParams}
78

79 80 81
type PagePath = { nodeId :: Int
                , params :: T.Params
                }
82 83

type PageLayoutProps =
84 85
  ( session      :: Session
  , frontends    :: Frontends
86 87
  , info         :: AnnuaireInfo
  , pagePath     :: R.State PagePath
88
  )
89 90 91 92 93 94

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

pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponent "G.P.Annuaire.pageLayout" cpt
95
  where
96
    cpt {info, frontends, pagePath, session} _ = do
97
      useLoader (fst pagePath) (loadPage session) $
98
        \table -> page {session, table, frontends, pagePath}
99 100

type PageProps = 
101
  ( session :: Session
102
  , frontends :: Frontends
103 104
  , pagePath :: R.State PagePath
  -- , info :: AnnuaireInfo
105
  , table :: TableResult CT.Contact
106
  )
107 108 109 110 111

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

pageCpt :: R.Component PageProps
112
pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
113
  where
114
    cpt { session, pagePath, frontends
115
        , table: ({count: totalRecords, docs})} _ = do
116
      pure $ T.table { rows, params, container, colNames, totalRecords, wrapColElts }
117
      where
118
        path = fst pagePath
119 120 121 122 123
        rows = (\c -> {
                   row: contactCells { annuaireId: (fst pagePath).nodeId
                                     , frontends
                                     , contact: c
                                     , session }
124
                   , delete: false }) <$> L.fromFoldable docs
125 126
        container = T.defaultContainer { title: "Annuaire" } -- TODO
        colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
127
        wrapColElts = const identity
128 129 130
        setParams f = snd pagePath $ \pp@{params: ps} ->
          pp {params = f ps}
        params = (fst pagePath).params /\ setParams
131

132 133
type AnnuaireId = Int

134 135 136 137 138 139 140 141 142 143 144 145 146
type ContactCellsProps =
  (
    annuaireId :: AnnuaireId
  , contact    :: CT.Contact
  , 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
147
  where
148 149 150 151 152 153
    cpt { annuaireId
        , contact: (CT.Contact { id, hyperdata: (CT.HyperdataUser {shared: Nothing}) })
        , frontends
        , session } _ =
      pure $ T.makeRow [
        H.text ""
154
        , H.span {} [ H.text "name" ]
155
        --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
156 157 158 159 160
        , H.text "No ContactWhere"
        , H.text "No ContactWhereDept"
        , H.div {className: "nooverflow"}
          [ H.text "No ContactWhereRole" ]
        ]
161 162 163 164 165 166 167
    cpt { annuaireId
        , contact: (CT.Contact { id
                               , hyperdata: (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who, ou})}) })
        , frontends
        , session } _ =
        pure $ T.makeRow [
          H.text ""
168 169
          , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
            --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
170 171
          , H.text $ maybe "No ContactWhere" contactWhereOrg  (A.head $ ou)
          , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
172
          , H.div {className: "nooverflow"} [
173
              H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
174 175 176 177 178 179 180 181 182
            ]
          ]
          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 }) =
183
              fromMaybe "No orga (list)" (A.head orga)
184 185
            contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
            contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
186
              fromMaybe "No Dept (list)" (A.head dept)
187 188
            contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
            contactWhereRole (CT.ContactWhere { role: Just role }) = role
189

190 191 192 193

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

195 196 197
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
  decodeJson json = do
    obj   <- decodeJson json
198 199
    title <- obj .:? "title"
    desc  <- obj .:? "desc"
200
    pure $ HyperdataAnnuaire { title, desc }
201

202 203 204 205 206 207 208
------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id        :: Int
                                    , typename  :: Int
                                    , userId    :: Int
                                    , parentId  :: Int
                                    , name      :: String
                                    , date      :: String
209
                                    , hyperdata :: HyperdataAnnuaire
210 211 212
                                    }

instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
213 214
  decodeJson json = do
    obj <- decodeJson json
215 216 217 218 219 220 221
    id        <- obj .: "id"
    typename  <- obj .: "typename"
    userId    <- obj .: "userId"
    parentId  <- obj .: "parentId"
    name      <- obj .: "name"
    date      <- obj .: "date"
    hyperdata <- obj .: "hyperdata"
222 223 224 225 226 227 228 229 230 231
    pure $ AnnuaireInfo { id : id
                        , typename : typename
                        , userId   : userId
                        , parentId : parentId
                        , name     : name
                        , date     : date
                        , hyperdata: hyperdata
                        }


232
--newtype AnnuaireTable  = AnnuaireTable  { annuaireTable :: Array (Maybe Contact)}
233

234 235 236 237
--instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
--  decodeJson json = do
--    rows <- decodeJson json
--    pure $ AnnuaireTable { annuaireTable : rows}
238

239
------------------------------------------------------------------------
240

241
loadPage :: Session -> PagePath -> AffTableResult CT.Contact
242
loadPage session {nodeId, params: { offset, limit, orderBy }} =
243
    get session children
244 245 246 247 248 249
 -- TODO orderBy
 -- where
 --   convOrderBy (T.ASC  (T.ColumnName "Name")) = NameAsc
 --   convOrderBy (T.DESC (T.ColumnName "Name")) = NameDesc
 --   ...
 --   convOrderBy _ = NameAsc -- TODO
250

251 252 253
  where
    children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)

254
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
255
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
256