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

3 4 5
import Data.Argonaut (class DecodeJson, decodeJson, (.?), (.??))
import Data.Lens (Prism', prism)
import Data.Either (Either(..))
6
import Data.Maybe (Maybe(..), maybe)
7 8 9 10
import React as React
import React (ReactClass, ReactElement)
import React.DOM (a, br', div, input, p, text)
import React.DOM.Props (href)
11
import Effect.Aff (Aff)
12 13 14
import Thermite ( Render, Spec
                , createClass, simpleSpec, defaultPerformAction
                )
15

16 17
------------------------------------------------------------------------------
import Gargantext.Prelude
18 19 20 21
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Loader (createLoaderClass)
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table
22
import Gargantext.Config      (toUrl, NodeType(..), TabType(..), End(..))
23
import Gargantext.Config.REST (get)
24
import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperData(..))
25
------------------------------------------------------------------------------
26

27
type Props = {path :: Int, loaded :: Maybe AnnuaireInfo }
28

29 30
data Action
  = TabsA   Tab.Action
31

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

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

46
------------------------------------------------------------------------------
47

48
-- unused
49
defaultAnnuaireTable :: AnnuaireTable
50
defaultAnnuaireTable = AnnuaireTable { annuaireTable : [] }
51

52 53 54 55 56
-- unused
defaultHyperdataAnnuaire :: HyperdataAnnuaire
defaultHyperdataAnnuaire = HyperdataAnnuaire { title: Nothing, desc: Nothing }

-- unused
57 58 59 60 61 62 63
defaultAnnuaireInfo :: AnnuaireInfo
defaultAnnuaireInfo = AnnuaireInfo { id : 0
                                   , typename : 0
                                   , userId   : 0
                                   , parentId : 0
                                   , name     : ""
                                   , date     : ""
64
                                   , hyperdata : defaultHyperdataAnnuaire
65
                                   }
66
------------------------------------------------------------------------------
67 68 69 70 71 72 73 74 75 76 77 78
layout :: Spec {} {annuaireId :: Int} Void
layout = simpleSpec defaultPerformAction render
  where
    render :: Render {} {annuaireId :: Int} Void
    render _ {annuaireId} _ _ =
      [ annuaireLoader
          { path: annuaireId
          , component: createClass "LoadedAnnuaire" loadedAnnuaireSpec {}
          } ]

loadedAnnuaireSpec :: Spec {} Props Void
loadedAnnuaireSpec = simpleSpec defaultPerformAction render
79
  where
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
    render :: Render {} Props Void
    render _ {loaded: Nothing} _ _ = []
    render _ {path, loaded: Just (AnnuaireInfo {name, date})} _ _ =
      Table.renderTableHeaderLayout
        { title: name
        , desc: name
        , query: ""
        , date: "Last update: " <> date
        , user: ""
        } <>
      [ p [] []
      , div [] [ text "    Filter ", input []]
      , br'
      , Table.tableElt
          { loadRows
          , title: "title" -- TODO
          , colNames:
97
              Table.ColumnName <$>
98 99 100 101 102
              [ ""
              , "Name"
              , "Role"
              , "Service"
              , "Company"
103
              ]
104 105 106 107 108
          , totalRecords: 47361 -- TODO
          }
      ]
      where
        annuaireId = path
109
        loadRows {offset, limit, orderBy} = do -- TODO use offset, limit, orderBy
110 111 112 113 114 115 116 117 118
          (AnnuaireTable {annuaireTable: rows}) <- getTable annuaireId
          pure $ (\c -> {row: renderContactCells c, delete: false}) <$> rows

renderContactCells :: Contact -> Array ReactElement
renderContactCells (Contact { id, hyperdata : HyperData contact }) =
  [ a [ href (toUrl Front NodeUser id) ] [ text $ maybe' contact.nom <> " " <> maybe' contact.prenom ]
  , text $ maybe' contact.fonction
  , text $ maybe' contact.service
  , text $ maybe' contact.groupe
119
  ]
120 121 122 123 124 125
  where
    maybe' = maybe "" identity

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

127 128 129 130 131 132
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
  decodeJson json = do
    obj   <- decodeJson json
    title <- obj .?? "title"
    desc  <- obj .?? "desc"
    pure $ HyperdataAnnuaire { title, desc }
133

134 135 136 137 138 139 140
------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id        :: Int
                                    , typename  :: Int
                                    , userId    :: Int
                                    , parentId  :: Int
                                    , name      :: String
                                    , date      :: String
141
                                    , hyperdata :: HyperdataAnnuaire
142 143 144
                                    }

instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
145 146
  decodeJson json = do
    obj <- decodeJson json
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
    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
                        }


164 165
newtype AnnuaireTable = AnnuaireTable { annuaireTable :: Array Contact }

166 167
instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
  decodeJson json = do
168 169
    rows <- decodeJson json
    pure $ AnnuaireTable { annuaireTable : rows}
170
------------------------------------------------------------------------
171
getTable :: Int -> Aff AnnuaireTable
172
getTable id = get $ toUrl Back (Tab TabDocs 0 10 Nothing) id
173

174 175
getAnnuaireInfo :: Int -> Aff AnnuaireInfo
getAnnuaireInfo id = get $ toUrl Back Node id
176
------------------------------------------------------------------------------
177

178 179 180 181 182
annuaireLoaderClass :: ReactClass (Loader.Props Int AnnuaireInfo)
annuaireLoaderClass = createLoaderClass "AnnuaireLoader" getAnnuaireInfo

annuaireLoader :: Loader.Props Int AnnuaireInfo -> ReactElement
annuaireLoader = React.createLeafElement annuaireLoaderClass