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

3
import Prelude (bind, 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 15
import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(..))
16
import Gargantext.Sessions (Session, sessionId, get)
17
import Gargantext.Types (NodePath(..), NodeType(..))
18
import Gargantext.Hooks.Loader (useLoader)
19

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

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

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

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

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

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

-- | 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
annuaireCpt = R.staticComponent "G.P.Annuaire.annuaire" cpt
57
  where
58
    cpt {session, path, info: info@(AnnuaireInfo {name, date: date'})} _ = R.fragment
59 60 61 62 63
      [ T.tableHeaderLayout headerProps
      , H.p {} []
      , H.div {className: "col-md-3"}
        [ H.text "    Filter ", H.input { className: "form-control", style } ]
      , H.br {}
64
      , pageLayout { info, session, annuairePath: path } ]
65 66 67 68
      where
        headerProps = { title: name, desc: name, query: "", date, user: ""}
        date = "Last update: " <> date'
        style = {width: "250px", display: "inline-block"}
69

70 71 72
type PagePath = { nodeId :: Int, params :: T.Params }

type PageLayoutProps =
73
  ( session :: Session
74 75 76 77 78 79 80 81
  , annuairePath :: R.State Int
  , info :: AnnuaireInfo )

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

pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponent "G.P.Annuaire.pageLayout" cpt
82
  where
83
    cpt {annuairePath, info, session} _ = do
84
      pagePath <- R.useState' (initialPagePath (fst annuairePath))
85 86
      useLoader (fst pagePath) (loadPage session) $
        \table -> page {session, table, pagePath, annuairePath}
87 88 89
    initialPagePath nodeId = {nodeId, params: T.initialParams}

type PageProps = 
90
  ( session :: Session
91 92 93 94 95 96 97 98 99 100
  , annuairePath :: R.State Int
  , pagePath :: R.State PagePath
  -- , info :: AnnuaireInfo
  , table :: AnnuaireTable )

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

pageCpt :: R.Component PageProps
pageCpt = R.staticComponent "LoadedAnnuairePage" cpt
101
  where
102 103
    cpt { session, annuairePath, pagePath
        , table: (AnnuaireTable {annuaireTable}) } _ = do
104
      T.table { rows, params, container, colNames, totalRecords }
105
      where
106
        totalRecords = 4361 -- TODO
107
        rows = (\c -> {row: contactCells session c, delete: false}) <$> annuaireTable
108 109
        container = T.defaultContainer { title: "Annuaire" } -- TODO
        colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
110 111
        setParams f = snd pagePath $ \{nodeId, params: ps} ->
          {params: f ps, nodeId: fst annuairePath}
112
        params = T.initialParams /\ setParams
113

114 115
contactCells :: Session -> Maybe Contact -> Array R.Element
contactCells session = maybe [] render
116 117
  where
    render (Contact { id, hyperdata : (HyperdataContact contact@{who: who, ou:ou} ) }) =
James Laver's avatar
James Laver committed
118
      let nodepath = NodePath (sessionId session) NodeContact (Just id)
119
          href = url session nodepath in
120 121 122 123 124 125 126 127
      [ H.text ""
      , H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
      , 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 }) =
128
      maybe "No orga (list)" identity (head orga)
129 130
    contactWhereDept (ContactWhere { labTeamDepts : [] }) = "Empty Dept"
    contactWhereDept (ContactWhere { labTeamDepts : dept }) =
131
      maybe "No Dept (list)" identity (head dept)
132 133
    contactWhereRole (ContactWhere { role: Nothing }) = "Empty Role"
    contactWhereRole (ContactWhere { role: Just role }) = role
134

135 136 137 138

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

140 141 142
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
  decodeJson json = do
    obj   <- decodeJson json
143 144
    title <- obj .:? "title"
    desc  <- obj .:? "desc"
145
    pure $ HyperdataAnnuaire { title, desc }
146

147 148 149 150 151 152 153
------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id        :: Int
                                    , typename  :: Int
                                    , userId    :: Int
                                    , parentId  :: Int
                                    , name      :: String
                                    , date      :: String
154
                                    , hyperdata :: HyperdataAnnuaire
155 156 157
                                    }

instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
158 159
  decodeJson json = do
    obj <- decodeJson json
160 161 162 163 164 165 166
    id        <- obj .: "id"
    typename  <- obj .: "typename"
    userId    <- obj .: "userId"
    parentId  <- obj .: "parentId"
    name      <- obj .: "name"
    date      <- obj .: "date"
    hyperdata <- obj .: "hyperdata"
167 168 169 170 171 172 173 174 175 176
    pure $ AnnuaireInfo { id : id
                        , typename : typename
                        , userId   : userId
                        , parentId : parentId
                        , name     : name
                        , date     : date
                        , hyperdata: hyperdata
                        }


177
newtype AnnuaireTable  = AnnuaireTable  { annuaireTable :: Array (Maybe Contact)}
178

179 180
instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
  decodeJson json = do
181 182
    rows <- decodeJson json
    pure $ AnnuaireTable { annuaireTable : rows}
183

184
------------------------------------------------------------------------
185

186 187
loadPage :: Session -> PagePath -> Aff AnnuaireTable
loadPage session {nodeId, params: { offset, limit, orderBy }} =
188
    get session children
189 190 191 192 193 194
 -- TODO orderBy
 -- where
 --   convOrderBy (T.ASC  (T.ColumnName "Name")) = NameAsc
 --   convOrderBy (T.DESC (T.ColumnName "Name")) = NameDesc
 --   ...
 --   convOrderBy _ = NameAsc -- TODO
195

196 197 198
  where
    children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)

199
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
200
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
201