Contacts.purs 5.75 KB
Newer Older
1 2
module Gargantext.Components.Nodes.Annuaire.User.Contacts
  ( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
3 4
  , userLayout )
  where
5

6
import Prelude (bind, pure, ($), (<<<), (<>), (<$>))
7 8
import Data.Array (head)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
9
import Data.Tuple (Tuple(..))
10 11 12
import Data.Tuple.Nested ((/\))
import Data.Newtype (unwrap)
import Data.String (joinWith)
13
import Effect.Aff (Aff)
14 15 16
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Hooks.Loader (useLoader)
17
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
18 19
  ( Contact(..), ContactData, ContactTouch(..), ContactWhere(..)
  , ContactWho(..), HyperData(..), HyperdataContact(..) )
20
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
21
import Gargantext.Routes (AppRoute, SessionRoute(..))
22
import Gargantext.Sessions (Session, get)
23
import Gargantext.Types (NodeType(..))
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124

display :: String -> Array R.Element -> R.Element
display title elems =
  H.div { className: "container-fluid" }
  [ H.div { className: "row", id: "contact-page-header" }
    [ H.div { className: "col-md-6"} [ H.h3 {} [ H.text title ] ]
    , H.div { className: "col-md-8"} []
    , H.div { className: "col-md-2"} [ H.span {} [ H.text "" ] ]
    ]
  , H.div { className: "row", id: "contact-page-info" }
    [ H.div { className: "col-md-12" }
      [ H.div { className: "row" }
        [ H.div { className: "col-md-2" } [ H.img { src: "/images/Gargantextuel-212x300.jpg"} ]
        , H.div { className: "col-md-1"} []
        , H.div { className: "col-md-8"} elems
        ]]]]

getFirstName obj = fromMaybe "Empty title" $ getFirstName' <$> obj
getFirstName' = fromMaybe "Empty first name" <<< _.firstName <<< unwrap

getLastName obj = fromMaybe "Empty title" $ getLastName' <$> obj
getLastName' = fromMaybe "Empty last name"  <<< _.lastName <<< unwrap

-- | ContactWhere infos
-- TODO factor below
getRole :: Array ContactWhere -> String
getRole = maybe "Empty Contact-Where" getRole' <<< head
  where
    getRole' = fromMaybe "Empty Role" <<< _.role <<< unwrap

getOrga :: Array ContactWhere -> String
getOrga = maybe "Emtpy Contact-Where" getOrga' <<< head
  where
    getOrga' :: ContactWhere -> String
    getOrga' obj = joinWith ", " $ (\(ContactWhere {organization: o}) ->o) obj

getDept :: Array ContactWhere -> String
getDept = maybe "Empty Department" getDept' <<< head
  where
    getDept' :: ContactWhere -> String
    getDept' obj = joinWith ", " $ (\(ContactWhere {labTeamDepts: l}) ->l) obj

getOffice :: Array ContactWhere -> String
getOffice = fromMaybe "Empty Office"
          <<< maybe Nothing (\(ContactWhere {office:x}) -> x)
          <<< head

getCity :: Array ContactWhere -> String
getCity = fromMaybe "Empty City"
          <<< maybe Nothing (\(ContactWhere {city:x}) -> x)
          <<< head

getCountry :: Array ContactWhere -> String
getCountry = fromMaybe "Empty Country"
          <<< maybe Nothing (\(ContactWhere {country:x}) -> x)
          <<< head

-- | ContactWhere / Touch infos
getTouch :: Array ContactWhere -> Maybe ContactTouch
getTouch = maybe Nothing (\(ContactWhere {touch:x}) -> x) <<< head

getPhone :: Array ContactWhere -> String
getPhone obj = fromMaybe "Empty touch info" $ getPhone' <$> (getTouch obj)
getPhone' :: ContactTouch -> String
getPhone' = fromMaybe "Empty phone" <<< _.phone <<< unwrap

getMail :: Array ContactWhere -> String
getMail obj = fromMaybe "Empty info" $ getMail' <$> (getTouch obj)
getMail' :: ContactTouch -> String
getMail' = fromMaybe "Empty mail" <<< _.mail <<< unwrap

-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataContact -> Array R.Element
contactInfos (HyperdataContact {who:who, ou:ou}) = item <$> items
  where
    items =
      [ "Last Name"     /\ getLastName who
      , "First Name"    /\ getFirstName who
      , "Organisation"  /\ getOrga ou
      , "Lab/Team/Dept" /\ getOrga ou
      , "Office"        /\ getOffice ou
      , "City"          /\ getCity ou
      , "Country"       /\ getCountry ou
      , "Role"          /\ getRole ou
      , "Phone"         /\ getPhone ou
      , "Mail"          /\ getMail ou ]
    item (name /\ value) =
      H.li { className: "list-group-item" }
        (infoRender (name /\ (" " <> value)))

listInfo :: Tuple String String -> R.Element
listInfo s = listElement $ infoRender s

listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" }

infoRender :: Tuple String String -> Array R.Element
infoRender (Tuple title content) =
  [ H.span { className: "badge badge-default badge-pill"} [ H.text title ]
  , H.span {} [H.text content] ]

125
type LayoutProps = ( route :: R.State AppRoute, nodeId :: Int, session :: Session )
126 127 128 129 130 131 132

userLayout :: Record LayoutProps -> R.Element
userLayout props = R.createElement userLayoutCpt props []

userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = R.hooksComponent "G.P.Annuaire.UserLayout" cpt
  where
133
    cpt {route, nodeId, session} _ =
134
      useLoader nodeId (getContact session) $
135 136 137
        \contactData@{contactNode: Contact {name, hyperdata}} ->
          H.ul { className: "col-md-12 list-group" }
          [ display (fromMaybe "no name" name) (contactInfos hyperdata)
138
          , Tabs.tabs {route, nodeId, contactData, session} ]
139 140

-- | toUrl to get data
141 142
getContact :: Session -> Int -> Aff ContactData
getContact session id = do
143
  contactNode <- get session $ NodeAPI NodeContact (Just id) ""
144 145 146 147 148 149 150 151 152
  -- TODO: we need a default list for the pairings
  --defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
  --case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
  --  Just (NodePoly { id: defaultListId }) ->
  --    pure {contactNode, defaultListId}
  --  Nothing ->
  --    throwError $ error "Missing default list"
  pure {contactNode, defaultListId: 424242}