Annuaire.purs 9.25 KB
Newer Older
1
module Gargantext.Pages.Annuaire where
2

3 4
import Gargantext.Prelude

5
import Data.Argonaut (class DecodeJson, decodeJson, (.?), (.??))
6
import Data.Array (head)
7
import Data.Either (Either(..))
8
import Data.Lens (Prism', prism)
9
import Data.Maybe (Maybe(..), maybe)
10
import Effect.Aff (Aff)
11
import Effect.Class (liftEffect)
12 13
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Tab as Tab
14
import Gargantext.Components.Table as T
15
import Gargantext.Config (toUrl, Path(..), NodeType(..), End(..))
16
import Gargantext.Config.REST (get)
17
import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperdataContact(..), ContactWhere(..))
18 19 20
import React (ReactClass, ReactElement, Children)
import React as React
import React.DOM (a, br', div, input, p, text)
21
import React.DOM.Props (className, href, style, target)
22
import Thermite (Render, Spec, createClass, simpleSpec, defaultPerformAction)
23
------------------------------------------------------------------------------
24

25
type Props = Loader.InnerProps Int AnnuaireInfo ()
26

27 28
data Action
  = TabsA   Tab.Action
29

30 31 32 33 34
_tabsAction :: Prism' Action Tab.Action
_tabsAction = prism TabsA \ action ->
  case action of
    TabsA taction -> Right taction
    -- _-> Left action
35 36 37 38 39 40 41 42 43

newtype IndividuView
  = CorpusView
    { id      :: Int
    , name    :: String
    , role    :: String
    , company :: String
    }

44
------------------------------------------------------------------------------
45

46
-- unused
47
defaultAnnuaireTable :: AnnuaireTable
48
defaultAnnuaireTable = AnnuaireTable { annuaireTable : [] }
49

50 51 52
-- unused
defaultHyperdataAnnuaire :: HyperdataAnnuaire
defaultHyperdataAnnuaire = HyperdataAnnuaire { title: Nothing, desc: Nothing }
53

54
-- unused
55 56 57 58 59 60 61
defaultAnnuaireInfo :: AnnuaireInfo
defaultAnnuaireInfo = AnnuaireInfo { id : 0
                                   , typename : 0
                                   , userId   : 0
                                   , parentId : 0
                                   , name     : ""
                                   , date     : ""
62
                                   , hyperdata : defaultHyperdataAnnuaire
63
                                   }
64
------------------------------------------------------------------------------
65
toRows :: AnnuaireTable -> Array (Maybe Contact)
66
toRows (AnnuaireTable a) = a.annuaireTable
67

68 69 70 71 72 73 74
layout :: Spec {} {annuaireId :: Int} Void
layout = simpleSpec defaultPerformAction render
  where
    render :: Render {} {annuaireId :: Int} Void
    render _ {annuaireId} _ _ =
      [ annuaireLoader
          { path: annuaireId
75
          , component: createClass "LoadedAnnuaire" loadedAnnuaireSpec (const {})
76 77 78 79
          } ]

loadedAnnuaireSpec :: Spec {} Props Void
loadedAnnuaireSpec = simpleSpec defaultPerformAction render
80
  where
81
    render :: Render {} Props Void
82
    render _ {path: nodeId, loaded: annuaireInfo@AnnuaireInfo {name, date}} _ _ =
83
      T.renderTableHeaderLayout
84 85 86 87 88 89 90
        { title: name
        , desc: name
        , query: ""
        , date: "Last update: " <> date
        , user: ""
        } <>
      [ p [] []
91
      , div [className "col-md-3"] [ text "    Filter ", input [className "form-control", style {"width" : "250px", "display": "inline-block"}]]
92
      , br'
93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
      , pageLoader
          { path: initialPageParams nodeId
          , annuaireInfo
          }
      ]

type PageParams = {nodeId :: Int, params :: T.Params}

initialPageParams :: Int -> PageParams
initialPageParams nodeId = {nodeId, params: T.initialParams}

type PageLoaderProps =
  { path :: PageParams
  , annuaireInfo :: AnnuaireInfo
  }

renderPage :: forall props path.
              Render (Loader.State {nodeId :: Int | path} AnnuaireTable)
                     {annuaireInfo :: AnnuaireInfo | props}
                     (Loader.Action PageParams)
renderPage _ _ {loaded: Nothing} _ = [] -- TODO loading spinner
114 115 116 117 118 119 120 121 122
renderPage dispatch {annuaireInfo} { currentPath: {nodeId}
                                   , loaded: Just (AnnuaireTable {annuaireTable: res})
                                   } _ = [ T.tableElt { rows
                                       , setParams: \params -> liftEffect $ dispatch (Loader.SetPath {nodeId, params})
                                       , container: T.defaultContainer { title: "Annuaire" } -- TODO
                                       , colNames: T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
                                       , totalRecords: 4361 -- TODO
                                       }
                                     ]
123
                        where
124 125
                          --rows = (\c -> {row: [text $ show c.id], delete: false}) <$> res
                          rows = (\c -> {row: renderContactCells c, delete: false}) <$> res
126

127 128
{-
showRow :: Maybe Contact -> ReactElement
129
showRow Nothing = tr [][]
130 131 132
showRow (Just (Contact {id: id, hyperdata: (HyperdataContact contact) })) = tr [] []
  [ td [] [ a [ href (toUrl Front NodeUser (Just id)) ] [
               text $ maybe "name" identity contact.title
133 134
               ]
          ]
135 136 137
  , td [] [text $ maybe "fonction" identity contact.source]
  , td [] [text $ maybe "groupe"   identity contact.source]
  , td [] [text $ "date entry"]
138
  ]
139 140 141
    --where
      --maybe' key = maybe (key <> " not found") identity $ lookup key contact
      -}
142

143
pageLoaderClass :: ReactClass { path :: PageParams, annuaireInfo :: AnnuaireInfo, children :: Children }
144 145 146 147
pageLoaderClass = Loader.createLoaderClass' "AnnuairePageLoader" loadPage renderPage

pageLoader :: PageLoaderProps -> ReactElement
pageLoader props = React.createElement pageLoaderClass props []
148

149 150 151
--{-
renderContactCells :: Maybe Contact -> Array ReactElement
renderContactCells Nothing = []
152
renderContactCells (Just (Contact { id, hyperdata : (HyperdataContact contact@{who: who, ou:ou} ) })) =
153
  [ text ""
154
  , a [ href (toUrl Front NodeContact (Just id)), target "blank" ] [ text $ maybe "name" identity contact.title ]
155 156
  , text $ maybe "No ContactWhere" renderContactWhereOrg  (head $ ou)
  , text $ maybe "No ContactWhere" renderContactWhereDept (head $ ou)
157
  , div [className "nooverflow"] [text $ maybe "No ContactWhere" renderContactWhereRole (head $ ou)]
158
  ]
159 160
  where
    maybe' = maybe "" identity
161 162
    renderContactWhereOrg (ContactWhere { organization: [] }) = "No Organization"
    renderContactWhereOrg (ContactWhere { organization: orga }) =
163 164
      maybe "No orga (list)" identity (head orga)

165 166
    renderContactWhereDept (ContactWhere { labTeamDepts : [] }) = "Empty Dept"
    renderContactWhereDept (ContactWhere { labTeamDepts : dept }) =
167 168 169 170 171
      maybe "No Dept (list)" identity (head dept)

    renderContactWhereRole (ContactWhere { role: Nothing }) = "Empty Role"
    renderContactWhereRole (ContactWhere { role: Just role }) = role

172 173 174 175

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

177 178 179 180 181 182
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
  decodeJson json = do
    obj   <- decodeJson json
    title <- obj .?? "title"
    desc  <- obj .?? "desc"
    pure $ HyperdataAnnuaire { title, desc }
183

184 185 186 187 188 189 190
------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id        :: Int
                                    , typename  :: Int
                                    , userId    :: Int
                                    , parentId  :: Int
                                    , name      :: String
                                    , date      :: String
191
                                    , hyperdata :: HyperdataAnnuaire
192 193 194
                                    }

instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
195 196
  decodeJson json = do
    obj <- decodeJson json
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
    id        <- obj .? "id"
    typename  <- obj .? "typename"
    userId    <- obj .? "userId"
    parentId  <- obj .? "parentId"
    name      <- obj .? "name"
    date      <- obj .? "date"
    hyperdata <- obj .? "hyperdata"
    pure $ AnnuaireInfo { id : id
                        , typename : typename
                        , userId   : userId
                        , parentId : parentId
                        , name     : name
                        , date     : date
                        , hyperdata: hyperdata
                        }


214
newtype AnnuaireTable  = AnnuaireTable  { annuaireTable :: Array (Maybe Contact)}
215

216 217
instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
  decodeJson json = do
218 219
    rows <- decodeJson json
    pure $ AnnuaireTable { annuaireTable : rows}
220
------------------------------------------------------------------------
221
loadPage :: PageParams -> Aff AnnuaireTable
222
loadPage {nodeId, params: { offset, limit, orderBy }} =
Nicolas Pouillard's avatar
Nicolas Pouillard committed
223
    get $ toUrl Back (Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-})
224 225 226 227 228 229 230
                     (Just nodeId)
 -- TODO orderBy
 -- where
 --   convOrderBy (T.ASC  (T.ColumnName "Name")) = NameAsc
 --   convOrderBy (T.DESC (T.ColumnName "Name")) = NameDesc
 --   ...
 --   convOrderBy _ = NameAsc -- TODO
231

232
getAnnuaireInfo :: Int -> Aff AnnuaireInfo
233
getAnnuaireInfo id = get $ toUrl Back Node (Just id)
234
------------------------------------------------------------------------------
235

236
annuaireLoaderClass :: ReactClass (Loader.Props Int AnnuaireInfo)
237
annuaireLoaderClass = Loader.createLoaderClass "AnnuaireLoader" getAnnuaireInfo
238

239
annuaireLoader :: Loader.Props' Int AnnuaireInfo -> ReactElement
240
annuaireLoader props = React.createElement annuaireLoaderClass props []