Annuaire.purs 8.02 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
import Data.Array (head)
6
import Data.Maybe (Maybe(..), maybe)
7
import Data.Tuple (fst, snd)
8
import Data.Tuple.Nested ((/\))
9
import Effect.Aff (Aff)
10 11 12
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), HyperdataContact(..), ContactWhere(..))
13
import Gargantext.Components.Table as T
14
import Gargantext.Ends (url, Frontends)
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
import Gargantext.Hooks.Loader (useLoader)
20

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

28 29
--toRows :: AnnuaireTable -> Array (Maybe Contact)
--toRows (AnnuaireTable a) = a.annuaireTable
30

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

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

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

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

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

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

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

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

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

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

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

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

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

125 126
type AnnuaireId = Int

127 128
contactCells :: Session -> Frontends -> AnnuaireId -> Contact -> Array R.Element
contactCells session frontends aId = render
129 130
  where
    render (Contact { id, hyperdata : (HyperdataContact contact@{who: who, ou:ou} ) }) =
131 132
      --let nodepath = NodePath (sessionId session) NodeContact (Just id)
      let nodepath = Routes.ContactPage (sessionId session) aId id
133
          href = url frontends nodepath in
134
      [ H.text ""
135 136
      , H.a { href} [ H.text $ maybe "name" identity contact.title ]
      --, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
137 138 139 140 141 142
      , H.text $ maybe "No ContactWhere" contactWhereOrg  (head $ ou)
      , H.text $ maybe "No ContactWhere" contactWhereDept (head $ ou)
      , H.div {className: "nooverflow"}
        [ H.text $ maybe "No ContactWhere" contactWhereRole (head $ ou) ] ]
    contactWhereOrg (ContactWhere { organization: [] }) = "No Organization"
    contactWhereOrg (ContactWhere { organization: orga }) =
143
      maybe "No orga (list)" identity (head orga)
144 145
    contactWhereDept (ContactWhere { labTeamDepts : [] }) = "Empty Dept"
    contactWhereDept (ContactWhere { labTeamDepts : dept }) =
146
      maybe "No Dept (list)" identity (head dept)
147 148
    contactWhereRole (ContactWhere { role: Nothing }) = "Empty Role"
    contactWhereRole (ContactWhere { role: Just role }) = role
149

150 151 152 153

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

155 156 157
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
  decodeJson json = do
    obj   <- decodeJson json
158 159
    title <- obj .:? "title"
    desc  <- obj .:? "desc"
160
    pure $ HyperdataAnnuaire { title, desc }
161

162 163 164 165 166 167 168
------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id        :: Int
                                    , typename  :: Int
                                    , userId    :: Int
                                    , parentId  :: Int
                                    , name      :: String
                                    , date      :: String
169
                                    , hyperdata :: HyperdataAnnuaire
170 171 172
                                    }

instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
173 174
  decodeJson json = do
    obj <- decodeJson json
175 176 177 178 179 180 181
    id        <- obj .: "id"
    typename  <- obj .: "typename"
    userId    <- obj .: "userId"
    parentId  <- obj .: "parentId"
    name      <- obj .: "name"
    date      <- obj .: "date"
    hyperdata <- obj .: "hyperdata"
182 183 184 185 186 187 188 189 190 191
    pure $ AnnuaireInfo { id : id
                        , typename : typename
                        , userId   : userId
                        , parentId : parentId
                        , name     : name
                        , date     : date
                        , hyperdata: hyperdata
                        }


192
--newtype AnnuaireTable  = AnnuaireTable  { annuaireTable :: Array (Maybe Contact)}
193

194 195 196 197
--instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
--  decodeJson json = do
--    rows <- decodeJson json
--    pure $ AnnuaireTable { annuaireTable : rows}
198

199
------------------------------------------------------------------------
200

201
loadPage :: Session -> PagePath -> AffTableResult Contact
202
loadPage session {nodeId, params: { offset, limit, orderBy }} =
203
    get session children
204 205 206 207 208 209
 -- TODO orderBy
 -- where
 --   convOrderBy (T.ASC  (T.ColumnName "Name")) = NameAsc
 --   convOrderBy (T.DESC (T.ColumnName "Name")) = NameDesc
 --   ...
 --   convOrderBy _ = NameAsc -- TODO
210

211 212 213
  where
    children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)

214
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
215
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
216