Commit 4e2eb894 authored by James Laver's avatar James Laver

Refactor G.P.Annuaire to use Reactix

parent f45a7bf8
...@@ -4,170 +4,127 @@ import Gargantext.Prelude ...@@ -4,170 +4,127 @@ import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Array (head) import Data.Array (head)
import Data.Either (Either(..))
import Data.Lens (Prism', prism)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (fst, snd)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Config (toUrl, endConfigStateful, Path(..), NodeType(..), End(..)) import Gargantext.Config (NodeType(..), Ends, BackendRoute(..), NodePath(..), url)
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperdataContact(..), ContactWhere(..)) import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperdataContact(..), ContactWhere(..))
import React (ReactClass, ReactElement, Children) import Reactix as R
import React as React import Reactix.DOM.HTML as H
import React.DOM (a, br', div, input, p, text)
import React.DOM.Props (className, href, style, target)
import Thermite (Render, Spec, createClass, simpleSpec, defaultPerformAction)
------------------------------------------------------------------------------
type Props = Loader.InnerProps Int AnnuaireInfo ()
data Action
= TabsA Tab.Action
_tabsAction :: Prism' Action Tab.Action newtype IndividuView =
_tabsAction = prism TabsA \ action -> CorpusView
case action of
TabsA taction -> Right taction
-- _-> Left action
newtype IndividuView
= CorpusView
{ id :: Int { id :: Int
, name :: String , name :: String
, role :: String , role :: String
, company :: String , company :: String }
}
------------------------------------------------------------------------------
-- unused
defaultAnnuaireTable :: AnnuaireTable
defaultAnnuaireTable = AnnuaireTable { annuaireTable : [] }
-- unused
defaultHyperdataAnnuaire :: HyperdataAnnuaire
defaultHyperdataAnnuaire = HyperdataAnnuaire { title: Nothing, desc: Nothing }
-- unused
defaultAnnuaireInfo :: AnnuaireInfo
defaultAnnuaireInfo = AnnuaireInfo { id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : ""
, date : ""
, hyperdata : defaultHyperdataAnnuaire
}
------------------------------------------------------------------------------
toRows :: AnnuaireTable -> Array (Maybe Contact) toRows :: AnnuaireTable -> Array (Maybe Contact)
toRows (AnnuaireTable a) = a.annuaireTable toRows (AnnuaireTable a) = a.annuaireTable
layout :: Spec {} {annuaireId :: Int} Void -- | Top level layout component. Loads an annuaire by id and renders
layout = simpleSpec defaultPerformAction render -- | the annuaire using the result
type LayoutProps = ( annuaireId :: Int, ends :: Ends )
annuaireLayout :: Record LayoutProps -> R.Element
annuaireLayout props = R.createElement annuaireLayoutCpt props []
annuaireLayoutCpt :: R.Component LayoutProps
annuaireLayoutCpt = R.hooksComponent "G.P.Annuaire.annuaireLayout" cpt
where where
render :: Render {} {annuaireId :: Int} Void cpt {annuaireId, ends} _ = do
render _ {annuaireId} _ _ = path <- R.useState' annuaireId
[ annuaireLoader useLoader (fst path) (getAnnuaireInfo ends) $
{ path: annuaireId \info -> annuaire {ends, path, info}
, component: createClass "LoadedAnnuaire" loadedAnnuaireSpec (const {})
} ] type AnnuaireProps =
( ends :: Ends
loadedAnnuaireSpec :: Spec {} Props Void , path :: R.State Int
loadedAnnuaireSpec = simpleSpec defaultPerformAction render , 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
where where
render :: Render {} Props Void cpt {ends, path, info: info@(AnnuaireInfo {name, date: date'})} _ = R.fragment
render _ {path: nodeId, loaded: annuaireInfo@(AnnuaireInfo {name, date})} _ _ = [ T.tableHeaderLayout headerProps
T.renderTableHeaderLayout , H.p {} []
{ title: name , H.div {className: "col-md-3"}
, desc: name [ H.text " Filter ", H.input { className: "form-control", style } ]
, query: "" , H.br {}
, date: "Last update: " <> date , pageLayout { info, ends, annuairePath: path } ]
, user: "" where
} <> headerProps = { title: name, desc: name, query: "", date, user: ""}
[ p [] [] date = "Last update: " <> date'
, div [className "col-md-3"] [ text " Filter ", input [className "form-control", style {"width" : "250px", "display": "inline-block"}]] style = {width: "250px", display: "inline-block"}
, br' type PagePath = { nodeId :: Int, params :: T.Params }
, pageLoader
{ path: initialPageParams nodeId
, annuaireInfo
}
]
type PageParams = {nodeId :: Int, params :: T.Params}
initialPageParams :: Int -> PageParams type PageLayoutProps =
initialPageParams nodeId = {nodeId, params: T.initialParams} ( ends :: Ends
, annuairePath :: R.State Int
, info :: AnnuaireInfo )
type PageLoaderProps = pageLayout :: Record PageLayoutProps -> R.Element
{ path :: PageParams pageLayout props = R.createElement pageLayoutCpt props []
, annuaireInfo :: AnnuaireInfo
}
renderPage :: forall props path. pageLayoutCpt :: R.Component PageLayoutProps
Render (Loader.State {nodeId :: Int | path} AnnuaireTable) pageLayoutCpt = R.hooksComponent "G.P.Annuaire.pageLayout" cpt
{annuaireInfo :: AnnuaireInfo | props} where
(Loader.Action PageParams) cpt {annuairePath, info, ends} _ = do
renderPage _ _ {loaded: Nothing} _ = [] -- TODO loading spinner pagePath <- R.useState' (initialPagePath (fst annuairePath))
renderPage dispatch {annuaireInfo} { currentPath: {nodeId} useLoader (fst pagePath) (loadPage ends) $
, loaded: Just (AnnuaireTable {annuaireTable: res}) \table -> page {ends, table, pagePath, annuairePath}
} _ = [ T.tableElt { rows initialPagePath nodeId = {nodeId, params: T.initialParams}
, setParams: \params -> liftEffect $ dispatch (Loader.SetPath {nodeId, params})
, container: T.defaultContainer { title: "Annuaire" } -- TODO type PageProps =
, colNames: T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"] ( ends :: Ends
, totalRecords: 4361 -- TODO , 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
where
cpt { ends, annuairePath, pagePath, table: (AnnuaireTable {annuaireTable}) } _ = do
T.table { rows, setParams, container, colNames, totalRecords }
where where
--rows = (\c -> {row: [text $ show c.id], delete: false}) <$> res totalRecords =4361 -- TODO
rows = (\c -> {row: renderContactCells c, delete: false}) <$> res rows = (\c -> {row: contactCells ends c, delete: false}) <$> annuaireTable
setParams params = snd pagePath $ const {params, nodeId: fst annuairePath}
{- container = T.defaultContainer { title: "Annuaire" } -- TODO
showRow :: Maybe Contact -> ReactElement colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
showRow Nothing = tr [][]
showRow (Just (Contact {id: id, hyperdata: (HyperdataContact contact) })) = tr [] [] contactCells :: Ends -> Maybe Contact -> Array R.Element
[ td [] [ a [ href (toUrl endConfigStateful Front NodeUser (Just id)) ] [ contactCells ends = maybe [] render
text $ maybe "name" identity contact.title
]
]
, td [] [text $ maybe "fonction" identity contact.source]
, td [] [text $ maybe "groupe" identity contact.source]
, td [] [text $ "date entry"]
]
--where
--maybe' key = maybe (key <> " not found") identity $ lookup key contact
-}
pageLoaderClass :: ReactClass { path :: PageParams, annuaireInfo :: AnnuaireInfo, children :: Children }
pageLoaderClass = Loader.createLoaderClass' "AnnuairePageLoader" loadPage renderPage
pageLoader :: PageLoaderProps -> ReactElement
pageLoader props = React.createElement pageLoaderClass props []
--{-
renderContactCells :: Maybe Contact -> Array ReactElement
renderContactCells Nothing = []
renderContactCells (Just (Contact { id, hyperdata : (HyperdataContact contact@{who: who, ou:ou} ) })) =
[ text ""
, a [ href (toUrl endConfigStateful Front NodeContact (Just id)), target "blank" ] [ text $ maybe "name" identity contact.title ]
, text $ maybe "No ContactWhere" renderContactWhereOrg (head $ ou)
, text $ maybe "No ContactWhere" renderContactWhereDept (head $ ou)
, div [className "nooverflow"] [text $ maybe "No ContactWhere" renderContactWhereRole (head $ ou)]
]
where where
maybe' = maybe "" identity render (Contact { id, hyperdata : (HyperdataContact contact@{who: who, ou:ou} ) }) =
renderContactWhereOrg (ContactWhere { organization: [] }) = "No Organization" let nodepath = NodePath NodeContact (Just id)
renderContactWhereOrg (ContactWhere { organization: orga }) = href = url ends nodepath in
[ 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 }) =
maybe "No orga (list)" identity (head orga) maybe "No orga (list)" identity (head orga)
contactWhereDept (ContactWhere { labTeamDepts : [] }) = "Empty Dept"
renderContactWhereDept (ContactWhere { labTeamDepts : [] }) = "Empty Dept" contactWhereDept (ContactWhere { labTeamDepts : dept }) =
renderContactWhereDept (ContactWhere { labTeamDepts : dept }) =
maybe "No Dept (list)" identity (head dept) maybe "No Dept (list)" identity (head dept)
contactWhereRole (ContactWhere { role: Nothing }) = "Empty Role"
renderContactWhereRole (ContactWhere { role: Nothing }) = "Empty Role" contactWhereRole (ContactWhere { role: Just role }) = role
renderContactWhereRole (ContactWhere { role: Just role }) = role
data HyperdataAnnuaire = HyperdataAnnuaire data HyperdataAnnuaire = HyperdataAnnuaire
...@@ -177,8 +134,8 @@ data HyperdataAnnuaire = HyperdataAnnuaire ...@@ -177,8 +134,8 @@ data HyperdataAnnuaire = HyperdataAnnuaire
instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where instance decodeHyperdataAnnuaire :: DecodeJson HyperdataAnnuaire where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
title <- obj .:! "title" title <- obj .:? "title"
desc <- obj .:! "desc" desc <- obj .:? "desc"
pure $ HyperdataAnnuaire { title, desc } pure $ HyperdataAnnuaire { title, desc }
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
...@@ -218,10 +175,9 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where ...@@ -218,10 +175,9 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
rows <- decodeJson json rows <- decodeJson json
pure $ AnnuaireTable { annuaireTable : rows} pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------ ------------------------------------------------------------------------
loadPage :: PageParams -> Aff AnnuaireTable loadPage :: Ends -> PagePath -> Aff AnnuaireTable
loadPage {nodeId, params: { offset, limit, orderBy }} = loadPage ends {nodeId, params: { offset, limit, orderBy }} =
get $ toUrl endConfigStateful Back (Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-}) get $ url ends children
(Just nodeId)
-- TODO orderBy -- TODO orderBy
-- where -- where
-- convOrderBy (T.ASC (T.ColumnName "Name")) = NameAsc -- convOrderBy (T.ASC (T.ColumnName "Name")) = NameAsc
...@@ -229,12 +185,11 @@ loadPage {nodeId, params: { offset, limit, orderBy }} = ...@@ -229,12 +185,11 @@ loadPage {nodeId, params: { offset, limit, orderBy }} =
-- ... -- ...
-- convOrderBy _ = NameAsc -- TODO -- convOrderBy _ = NameAsc -- TODO
getAnnuaireInfo :: Int -> Aff AnnuaireInfo where
getAnnuaireInfo id = get $ toUrl endConfigStateful Back Node (Just id) children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)
------------------------------------------------------------------------------
------ Annuaire loading ------
annuaireLoaderClass :: ReactClass (Loader.Props Int AnnuaireInfo) getAnnuaireInfo :: Ends -> Int -> Aff AnnuaireInfo
annuaireLoaderClass = Loader.createLoaderClass "AnnuaireLoader" getAnnuaireInfo getAnnuaireInfo ends id = get $ url ends (NodeAPI Node (Just id))
annuaireLoader :: Loader.Props' Int AnnuaireInfo -> ReactElement
annuaireLoader props = React.createElement annuaireLoaderClass props []
module Gargantext.Pages.Annuaire.User.Contacts module Gargantext.Pages.Annuaire.User.Contacts
(module Gargantext.Pages.Annuaire.User.Contacts.Types, ( module Gargantext.Pages.Annuaire.User.Contacts.Types
module Gargantext.Pages.Annuaire.User.Contacts.Specs) , userLayout )
where where
import Prelude ((<$>))
import Data.List (List, zipWith, catMaybes, toUnfoldable)
import Data.Map (Map, empty, keys, values, lookup)
import Data.Array (head)
import Data.Semigroup ((<>))
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Set (toUnfoldable) as S
import Data.Tuple (Tuple(..), uncurry)
import Data.Tuple.Nested ((/\))
import Data.Unfoldable (class Unfoldable)
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.String (joinWith)
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Config (Ends, BackendRoute(..), NodeType(..), url)
import Gargantext.Config.REST (get)
import Gargantext.Components.Node (NodePoly(..), HyperdataList(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Annuaire.User.Contacts.Types import Gargantext.Pages.Annuaire.User.Contacts.Types
import Gargantext.Pages.Annuaire.User.Contacts.Specs (layoutUser) import Gargantext.Pages.Annuaire.User.Contacts.Tabs.Specs as Tabs
import Gargantext.Utils.Reactix as R2
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] ]
type LayoutProps = ( nodeId :: Int, ends :: Ends )
userLayout :: Record LayoutProps -> R.Element
userLayout props = R.createElement userLayoutCpt props []
userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = R.hooksComponent "G.P.Annuaire.UserLayout" cpt
where
cpt {nodeId, ends} _ =
useLoader nodeId (getContact ends) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
[ display (fromMaybe "no name" name) (contactInfos hyperdata)
, Tabs.tabs {nodeId, contactData, ends} ]
-- | toUrl to get data
getContact :: Ends -> Int -> Aff ContactData
getContact ends id = do
contactNode <- get $ url ends (NodeAPI NodeContact (Just id))
-- 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}
module Gargantext.Pages.Annuaire.User.Contacts.Specs
(layoutUser)
where
import Data.Array (head)
import Data.List (zipWith, catMaybes, toUnfoldable)
import Data.Map (Map, keys, lookup)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (unwrap)
import Data.Set (toUnfoldable) as S
import Data.String (joinWith)
import Data.Tuple (Tuple(..))
import Data.Unfoldable (class Unfoldable)
import Effect.Aff (Aff)
import React (ReactElement)
import React.DOM (div, h3, img, li, span, text, ul)
import React.DOM.Props (_id, className, src)
import Reactix as R
import Thermite (Spec)
import Gargantext.Prelude
import Gargantext.Config (toUrl, End(..), NodeType(..))
import Gargantext.Config (toUrl, endConfigStateful, End(..), NodeType(..), Path(..))
import Gargantext.Config.REST (get)
import Gargantext.Components.Loader2 (useLoader)
import Gargantext.Pages.Annuaire.User.Contacts.Types
import Gargantext.Pages.Annuaire.User.Contacts.Tabs.Specs as Tabs
import Gargantext.Utils.Reactix as R2
display :: String -> Array ReactElement -> Array ReactElement
display title elems =
[ div [className "container-fluid"]
[ div [className "row", _id "contact-page-header"]
[ div [className "col-md-6"] [ h3 [] [text title] ]
, div [className "col-md-8"] []
, div [className "col-md-2"] [ span [] [text ""] ]
]
, div [className "row", _id "contact-page-info"]
[ div [className "col-md-12"]
[ div [className "row"]
[ div [className "col-md-2"]
--[ ]
[ img [src "/images/Gargantextuel-212x300.jpg"] ]
, div [className "col-md-1"] []
, div [className "col-md-8"] elems
]
]
]
]
]
mapMyMap :: forall k v x f. Ord k => Unfoldable f => (k -> v -> x) -> Map k v -> f x
mapMyMap f m = toUnfoldable
$ zipWith f mapKeys
(catMaybes $ flip lookup m <$> mapKeys)
where mapKeys = S.toUnfoldable $ keys m
infixl 4 mapMyMap as <.~$>
getFirstName :: Maybe ContactWho -> String
getFirstName obj = fromMaybe "Empty title" $ getFirstName' <$> obj
where
getFirstName' = fromMaybe "Empty first name" <<< _.firstName <<< unwrap
getLastName :: Maybe ContactWho -> String
getLastName obj = fromMaybe "Empty title" $ getLastName' <$> obj
where
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 ReactElement
contactInfos (HyperdataContact {who:who, ou:ou}) =
[ li [className "list-group-item"] (infoRender (Tuple "Last Name" $ " " <> getLastName who))
, li [className "list-group-item"] (infoRender (Tuple "First name" $ " " <> getFirstName who))
, li [className "list-group-item"] (infoRender (Tuple "Organization" $ " " <> getOrga ou ))
, li [className "list-group-item"] (infoRender (Tuple "Lab/Team/Dept"$ " " <> getOrga ou ))
, li [className "list-group-item"] (infoRender (Tuple "Office" $ " " <> getOffice ou ))
, li [className "list-group-item"] (infoRender (Tuple "City" $ " " <> getCity ou ))
, li [className "list-group-item"] (infoRender (Tuple "Country" $ " " <> getCountry ou ))
, li [className "list-group-item"] (infoRender (Tuple "Role" $ " " <> getRole ou ))
, li [className "list-group-item"] (infoRender (Tuple "Phone" $ " " <> getPhone ou ))
, li [className "list-group-item"] (infoRender (Tuple "Mail" $ " " <> getMail ou ))
]
{- $
listInfo <.~$> hyperdata
where
checkMaybe (Nothing) = empty
checkMaybe (Just (HyperData a)) = a
-}
listInfo :: Tuple String String -> ReactElement
listInfo s = listElement $ infoRender s
listElement :: Array ReactElement -> ReactElement
listElement = li [className "list-group-item justify-content-between"]
infoRender :: Tuple String String -> Array ReactElement
infoRender (Tuple title content) =
[ span [className "badge badge-default badge-pill"] [text title]
, span [] [text content]
]
-- | Below an example of a loader, use all code below and adapt it
-- to your code
-- layoutUser is exported by the module
layoutUser :: Spec {} {nodeId :: Int} Void
layoutUser =
R2.elSpec $ R.hooksComponent "LayoutUser" \{nodeId} _ ->
useLoader nodeId getContact $ \{loaded: contactData} ->
let {contactNode: Contact {name, hyperdata}} = contactData in
R2.toElement
[ ul [className "col-md-12 list-group"] $
display (fromMaybe "no name" name) (contactInfos hyperdata)
, Tabs.elt {nodeId, contactData}
]
-- | toUrl to get data
getContact :: Int -> Aff ContactData
getContact id = do
contactNode <- get $ toUrl endConfigStateful Back Node $ Just id
-- 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}
...@@ -7,9 +7,10 @@ import Data.Generic.Rep (class Generic) ...@@ -7,9 +7,10 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.List (fromFoldable) import Data.List (fromFoldable)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import Gargantext.Config (TabType(..), TabSubType(..), PTabNgramType(..), CTabNgramType(..)) import Gargantext.Config (Ends, TabType(..), TabSubType(..), PTabNgramType(..), CTabNgramType(..))
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
...@@ -17,8 +18,7 @@ import Gargantext.Pages.Annuaire.User.Contacts.Types (ContactData) ...@@ -17,8 +18,7 @@ import Gargantext.Pages.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
import React (Children, ReactElement, ReactClass, createElement) import Reactix.DOM.HTML as H
import Thermite (Spec, hideState, noState, cmapProps, createClass)
data Mode = Patents | Books | Communication data Mode = Patents | Books | Communication
...@@ -40,51 +40,53 @@ modeTabType' Patents = CTabAuthors ...@@ -40,51 +40,53 @@ modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors modeTabType' Communication = CTabAuthors
type Props =
type PropsRow =
( nodeId :: Int ( nodeId :: Int
, contactData :: ContactData , contactData :: ContactData
) , ends :: Ends )
type Props = Record PropsRow
elt :: Props -> ReactElement
elt props = createElement tabsClass props []
tabsClass :: ReactClass { children :: Children | PropsRow }
tabsClass = createClass "ContactsTabs" pureTabs (const {})
pureTabs :: Spec {} Props Void tabs :: Record Props -> R.Element
pureTabs = hideState (const {activeTab: 0}) statefulTabs tabs props = R.createElement tabsCpt props []
statefulTabs :: Spec Tab.State Props Tab.Action tabsCpt :: R.Component Props
statefulTabs = tabsCpt = R.hooksComponent "G.P.Annuaire.User.Contacts.Tabs.tabs" cpt
Tab.tabs identity identity $ fromFoldable where
[ Tuple "Documents" $ docs cpt {nodeId, contactData: {defaultListId}, ends} _ = do
, Tuple "Patents" $ ngramsViewSpec {mode: Patents} active <- R.useState' 0
, Tuple "Books" $ ngramsViewSpec {mode: Books} pure $
, Tuple "Communication" $ ngramsViewSpec {mode: Communication} Tab.tabs { tabs: tabs', selected: fst active }
, Tuple "Trash" $ docs -- TODO pass-in trash mode where
tabs' =
[ "Documents" /\ docs
, "Patents" /\ ngramsView patentsView
, "Books" /\ ngramsView booksView
, "Communication" /\ ngramsView commView
, "Trash" /\ docs -- TODO pass-in trash mode
] ]
where where
patentsView = {ends, defaultListId, nodeId, mode: Patents}
booksView = {ends, defaultListId, nodeId, mode: Books}
commView = {ends, defaultListId, nodeId, mode: Communication}
chart = mempty chart = mempty
-- TODO totalRecords totalRecords = 4736 -- TODO
docs = noState $ R2.elSpec $ R.hooksComponent "DocViewSpecWithCorpus" $ \{nodeId, contactData: {defaultListId}} _ -> do docs = DT.docView
pure $ DT.docViewSpec { ends, nodeId, chart, totalRecords
{ nodeId
, chart
, tabType: TabPairing TabDocs , tabType: TabPairing TabDocs
, totalRecords: 4736
, listId: defaultListId , listId: defaultListId
, corpusId: Nothing , corpusId: Nothing
, showSearch: true , showSearch: true }
}
ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action type NgramsViewProps =
ngramsViewSpec {mode} = ( ends :: Ends
cmapProps (\{contactData: {defaultListId}, nodeId} -> , mode :: Mode
{defaultListId, nodeId, tabType}) , defaultListId :: Int
(noState (NT.mainNgramsTableSpec (modeTabType' mode))) , nodeId :: Int )
ngramsView :: Record NgramsViewProps -> R.Element
ngramsView {ends,mode, defaultListId, nodeId} =
NT.mainNgramsTable
{ nodeId, defaultListId, tabType, ends, tabNgramType }
where where
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode tabType = TabPairing $ TabNgramType $ modeTabType mode
...@@ -2,33 +2,34 @@ module Gargantext.Pages.Annuaire.User.Contacts.Types where ...@@ -2,33 +2,34 @@ module Gargantext.Pages.Annuaire.User.Contacts.Types where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!)) import Data.Argonaut (class DecodeJson, decodeJson, (.?), (.??))
import Data.Maybe (Maybe, fromMaybe) import Data.Either (Either(..))
import Data.Map (Map) import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Map (Map(..))
import Gargantext.Utils.DecodeMaybe ((.?|)) import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
-- TODO: should it be a NodePoly HyperdataContact ? -- TODO: should it be a NodePoly HyperdataContact ?
newtype Contact = Contact { newtype Contact =
id :: Int Contact
{ id :: Int
, typename :: Maybe Int , typename :: Maybe Int
, userId :: Maybe Int , userId :: Maybe Int
, parentId :: Maybe Int , parentId :: Maybe Int
, name :: Maybe String , name :: Maybe String
, date :: Maybe String , date :: Maybe String
, hyperdata :: HyperdataContact , hyperdata :: HyperdataContact }
}
derive instance newtypeContact :: Newtype Contact _ derive instance newtypeContact :: Newtype Contact _
newtype ContactWho = newtype ContactWho =
ContactWho { idWho :: Maybe String ContactWho
{ idWho :: Maybe String
, firstName :: Maybe String , firstName :: Maybe String
, lastName :: Maybe String , lastName :: Maybe String
, keywords :: (Array String) , keywords :: (Array String)
, freetags :: (Array String) , freetags :: (Array String) }
}
derive instance newtypeContactWho :: Newtype ContactWho _ derive instance newtypeContactWho :: Newtype ContactWho _
...@@ -48,7 +49,8 @@ instance decodeContactWho :: DecodeJson ContactWho ...@@ -48,7 +49,8 @@ instance decodeContactWho :: DecodeJson ContactWho
pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f} pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f}
newtype ContactWhere = newtype ContactWhere =
ContactWhere { organization :: (Array String) ContactWhere
{ organization :: (Array String)
, labTeamDepts :: (Array String) , labTeamDepts :: (Array String)
, role :: Maybe String , role :: Maybe String
...@@ -60,8 +62,8 @@ newtype ContactWhere = ...@@ -60,8 +62,8 @@ newtype ContactWhere =
, touch :: Maybe ContactTouch , touch :: Maybe ContactTouch
, entry :: Maybe String , entry :: Maybe String
, exit :: Maybe String , exit :: Maybe String }
}
derive instance newtypeContactWhere :: Newtype ContactWhere _ derive instance newtypeContactWhere :: Newtype ContactWhere _
instance decodeContactWhere :: DecodeJson ContactWhere instance decodeContactWhere :: DecodeJson ContactWhere
...@@ -84,10 +86,11 @@ instance decodeContactWhere :: DecodeJson ContactWhere ...@@ -84,10 +86,11 @@ instance decodeContactWhere :: DecodeJson ContactWhere
pure $ ContactWhere {organization:o, labTeamDepts:l, role, office, country, city, touch, entry, exit} pure $ ContactWhere {organization:o, labTeamDepts:l, role, office, country, city, touch, entry, exit}
newtype ContactTouch = newtype ContactTouch =
ContactTouch { mail :: Maybe String ContactTouch
{ mail :: Maybe String
, phone :: Maybe String , phone :: Maybe String
, url :: Maybe String , url :: Maybe String }
}
derive instance newtypeContactTouch :: Newtype ContactTouch _ derive instance newtypeContactTouch :: Newtype ContactTouch _
instance decodeContactTouch :: DecodeJson ContactTouch instance decodeContactTouch :: DecodeJson ContactTouch
......
...@@ -6,7 +6,7 @@ import Effect.Aff (Aff) ...@@ -6,7 +6,7 @@ import Effect.Aff (Aff)
import Gargantext.Config import Gargantext.Config
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Thermite (Spec) import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Types (TermList(..)) import Gargantext.Types (TermList(..))
...@@ -20,14 +20,11 @@ import Gargantext.Hooks.Loader (useLoader) ...@@ -20,14 +20,11 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Pages.Corpus.Chart.Utils as U import Gargantext.Pages.Corpus.Chart.Utils as U
type Path = type Path = { corpusId :: Int, tabType :: TabType }
{ corpusId :: Int
, tabType :: TabType
}
newtype ChartMetrics = ChartMetrics type Props = ( path :: Path, ends :: Ends )
{ "data" :: HistoMetrics
} newtype ChartMetrics = ChartMetrics { "data" :: HistoMetrics }
instance decodeChartMetrics :: DecodeJson ChartMetrics where instance decodeChartMetrics :: DecodeJson ChartMetrics where
decodeJson json = do decodeJson json = do
...@@ -35,10 +32,7 @@ instance decodeChartMetrics :: DecodeJson ChartMetrics where ...@@ -35,10 +32,7 @@ instance decodeChartMetrics :: DecodeJson ChartMetrics where
d <- obj .: "data" d <- obj .: "data"
pure $ ChartMetrics { "data": d } pure $ ChartMetrics { "data": d }
newtype HistoMetrics = HistoMetrics newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number }
{ dates :: Array String
, count :: Array Number
}
instance decodeHistoMetrics :: DecodeJson HistoMetrics where instance decodeHistoMetrics :: DecodeJson HistoMetrics where
decodeJson json = do decodeJson json = do
...@@ -60,27 +54,29 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -60,27 +54,29 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" } , tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
} }
getMetrics :: Ends -> Path -> Aff HistoMetrics
getMetrics :: Path -> Aff HistoMetrics getMetrics ends {corpusId, tabType} = do
getMetrics {corpusId, tabType} = do ChartMetrics ms <- get $ url ends chart
ChartMetrics ms <- get $ toUrl endConfigStateful Back (Chart {chartType: Histo, tabType: tabType}) $ Just corpusId
pure ms."data" pure ms."data"
where chart = Chart {chartType: Histo, tabType: tabType} (Just corpusId)
histo :: Record Props -> R.Element
histo props = R.createElement histoCpt props []
histoSpec :: Spec {} Path Void histoCpt :: R.Component Props
histoSpec = R2.elSpec $ R.hooksComponent "LoadedMetricsHisto" cpt histoCpt = R.hooksComponent "LoadedMetricsHisto" cpt
where where
cpt p _ = do cpt {ends,path} _ = do
setReload <- R.useState' 0 setReload <- R.useState' 0
pure $ metricsLoadView ends setReload path
pure $ metricsLoadView setReload p metricsLoadView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadView ends setReload path = R.createElement el {ends,path} []
metricsLoadView :: R.State Int -> Path -> R.Element
metricsLoadView setReload p = R.createElement el p []
where where
el = R.hooksComponent "MetricsLoadedHistoView" cpt el = R.hooksComponent "MetricsLoadedHistoView" cpt
cpt p _ = do cpt {path,ends} _ = do
useLoader p getMetrics $ \{loaded} -> useLoader path (getMetrics ends) $ \loaded ->
loadedMetricsView setReload loaded loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> HistoMetrics -> R.Element loadedMetricsView :: R.State Int -> HistoMetrics -> R.Element
loadedMetricsView setReload loaded = U.reloadButtonWrap setReload $ R2.buff $ chart $ chartOptions loaded loadedMetricsView setReload loaded = U.reloadButtonWrap setReload $ chart $ chartOptions loaded
...@@ -6,9 +6,10 @@ import Data.Map (Map) ...@@ -6,9 +6,10 @@ import Data.Map (Map)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config import Gargantext.Config (Ends, BackendRoute(..), TabType, url)
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Types (TermList(..)) import Gargantext.Types (TermList(..))
...@@ -30,6 +31,8 @@ type Path = ...@@ -30,6 +31,8 @@ type Path =
, limit :: Maybe Int , limit :: Maybe Int
} }
type Props = ( path :: Path, ends :: Ends )
newtype Metric = Metric newtype Metric = Metric
{ label :: String { label :: String
, x :: Number , x :: Number
...@@ -92,26 +95,29 @@ scatterOptions metrics = Options ...@@ -92,26 +95,29 @@ scatterOptions metrics = Options
} }
--} --}
getMetrics :: Path -> Aff Loaded getMetrics :: Ends -> Path -> Aff Loaded
getMetrics {corpusId, listId, limit, tabType} = do getMetrics ends {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ toUrl endConfigStateful Back (CorpusMetrics {listId, tabType, limit}) $ Just corpusId Metrics ms <- get $ url ends metrics
pure ms."data" pure ms."data"
where metrics = CorpusMetrics {listId, tabType, limit} (Just corpusId)
metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props []
metricsSpec = R2.elSpec $ R.hooksComponent "LoadedMetrics" cpt metricsCpt :: R.Component Props
metricsCpt = R.hooksComponent "LoadedMetrics" cpt
where where
cpt p _ = do cpt {path, ends} _ = do
setReload <- R.useState' 0 setReload <- R.useState' 0
pure $ metricsLoadView ends setReload path
pure $ metricsLoadView setReload p metricsLoadView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadView ends setReload path = R.createElement el {ends,path} []
metricsLoadView :: R.State Int -> Path -> R.Element
metricsLoadView setReload p = R.createElement el p []
where where
el = R.hooksComponent "MetricsLoadedView" cpt el = R.hooksComponent "MetricsLoadedView" cpt
cpt p' _ = do cpt {ends, path} _ = do
useLoader p' getMetrics $ \{loaded} -> useLoader path (getMetrics ends) $ \loaded ->
loadedMetricsView setReload loaded loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> Loaded -> R.Element loadedMetricsView :: R.State Int -> Loaded -> R.Element
loadedMetricsView setReload loaded = U.reloadButtonWrap setReload $ R2.buff $ chart $ scatterOptions loaded loadedMetricsView setReload loaded = U.reloadButtonWrap setReload $ chart $ scatterOptions loaded
...@@ -7,10 +7,10 @@ import Data.Maybe (Maybe(..)) ...@@ -7,10 +7,10 @@ import Data.Maybe (Maybe(..))
import Data.String (take, joinWith, Pattern(..), split, length) import Data.String (take, joinWith, Pattern(..), split, length)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config import Gargantext.Config (Ends, BackendRoute(..), TabType, ChartType(..), url)
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Thermite (Spec) import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Types (TermList(..)) import Gargantext.Types (TermList(..))
...@@ -28,6 +28,8 @@ type Path = ...@@ -28,6 +28,8 @@ type Path =
, tabType :: TabType , tabType :: TabType
} }
type Props = ( ends :: Ends, path :: Path )
newtype ChartMetrics = ChartMetrics newtype ChartMetrics = ChartMetrics
{ "data" :: HistoMetrics { "data" :: HistoMetrics
} }
...@@ -76,50 +78,52 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -76,50 +78,52 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
} }
getMetrics :: Path -> Aff HistoMetrics getMetrics :: Ends -> Path -> Aff HistoMetrics
getMetrics {corpusId, tabType:tabType} = do getMetrics ends {corpusId, tabType:tabType} = do
ChartMetrics ms <- get $ toUrl endConfigStateful Back (Chart {chartType: ChartPie, tabType: tabType}) $ Just corpusId ChartMetrics ms <- get $ url ends chart
pure ms."data" pure ms."data"
where chart = Chart {chartType: ChartPie, tabType: tabType} (Just corpusId)
pie :: Record Props -> R.Element
pie props = R.createElement pieCpt props []
pieCpt :: R.Component Props
pieSpec :: Spec {} Path Void pieCpt = R.hooksComponent "LoadedMetricsPie" cpt
pieSpec = R2.elSpec $ R.hooksComponent "LoadedMetricsPie" cpt
where where
cpt p _ = do cpt {path,ends} _ = do
setReload <- R.useState' 0 setReload <- R.useState' 0
pure $ metricsLoadPieView ends setReload path
pure $ metricsLoadPieView setReload p metricsLoadPieView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadPieView ends setReload path = R.createElement el {ends,path} []
metricsLoadPieView :: R.State Int -> Path -> R.Element
metricsLoadPieView setReload p = R.createElement el p []
where where
el = R.hooksComponent "MetricsLoadedPieView" cpt el = R.hooksComponent "MetricsLoadedPieView" cpt
cpt p _ = do cpt {ends,path} _ = do
useLoader p getMetrics $ \{loaded} -> useLoader path (getMetrics ends) $ \loaded ->
loadedMetricsPieView setReload loaded loadedMetricsPieView setReload loaded
loadedMetricsPieView :: R.State Int -> HistoMetrics -> R.Element loadedMetricsPieView :: R.State Int -> HistoMetrics -> R.Element
loadedMetricsPieView setReload loaded = U.reloadButtonWrap setReload $ R2.buff $ chart $ chartOptionsPie loaded loadedMetricsPieView setReload loaded = U.reloadButtonWrap setReload $ chart $ chartOptionsPie loaded
bar :: Record Props -> R.Element
bar props = R.createElement barCpt props []
barSpec :: Spec {} Path Void barCpt :: R.Component Props
barSpec = R2.elSpec $ R.hooksComponent "LoadedMetricsBar" cpt barCpt = R.hooksComponent "LoadedMetricsBar" cpt
where where
cpt p _ = do cpt {path, ends} _ = do
setReload <- R.useState' 0 setReload <- R.useState' 0
pure $ metricsLoadBarView ends setReload path
pure $ metricsLoadBarView setReload p
metricsLoadBarView :: R.State Int -> Path -> R.Element metricsLoadBarView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadBarView setReload p = R.createElement el p [] metricsLoadBarView ends setReload path = R.createElement el {ends,path} []
where where
el = R.hooksComponent "MetricsLoadedBarView" cpt el = R.hooksComponent "MetricsLoadedBarView" cpt
cpt p _ = do cpt {path, ends} _ = do
useLoader p getMetrics $ \{loaded} -> useLoader path (getMetrics ends) $ \loaded ->
loadedMetricsBarView setReload loaded loadedMetricsBarView setReload loaded
loadedMetricsBarView :: R.State Int -> Loaded -> R.Element loadedMetricsBarView :: R.State Int -> Loaded -> R.Element
loadedMetricsBarView setReload loaded = U.reloadButtonWrap setReload $ R2.buff $ chart $ chartOptionsBar loaded loadedMetricsBarView setReload loaded = U.reloadButtonWrap setReload $ chart $ chartOptionsBar loaded
...@@ -3,11 +3,10 @@ module Gargantext.Pages.Corpus.Chart.Tree where ...@@ -3,11 +3,10 @@ module Gargantext.Pages.Corpus.Chart.Tree where
import Data.Argonaut (class DecodeJson, decodeJson, (.:)) import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config import Gargantext.Config (Ends, BackendRoute(..), TabType, ChartType(..), url)
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Thermite (Spec)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Types (TermList(..)) import Gargantext.Types (TermList(..))
...@@ -26,7 +25,7 @@ type Path = ...@@ -26,7 +25,7 @@ type Path =
, tabType :: TabType , tabType :: TabType
, limit :: Maybe Int , limit :: Maybe Int
} }
type Props = ( path :: Path, ends :: Ends )
newtype Metrics = Metrics newtype Metrics = Metrics
{ "data" :: Array TreeNode { "data" :: Array TreeNode
...@@ -54,29 +53,33 @@ scatterOptions nodes = Options ...@@ -54,29 +53,33 @@ scatterOptions nodes = Options
} }
getMetrics :: Path -> Aff Loaded getMetrics :: Ends -> Path -> Aff Loaded
getMetrics {corpusId, listId, limit, tabType} = do getMetrics ends {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ toUrl endConfigStateful Back (Chart {chartType : ChartTree, tabType: tabType}) $ Just corpusId Metrics ms <- get $ url ends chart
pure ms."data" pure ms."data"
where
chart = Chart {chartType : ChartTree, tabType: tabType} (Just corpusId)
tree :: Record Props -> R.Element
tree props = R.createElement treeCpt props []
treeSpec :: Spec {} Path Void treeCpt :: R.Component Props
treeSpec = R2.elSpec $ R.hooksComponent "LoadedMetrics" cpt treeCpt = R.hooksComponent "LoadedMetrics" cpt
where where
cpt p _ = do cpt {path, ends} _ = do
setReload <- R.useState' 0 setReload <- R.useState' 0
pure $ metricsLoadView ends setReload path
pure $ metricsLoadView setReload p metricsLoadView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadView ends setReload p = R.createElement el p []
metricsLoadView :: R.State Int -> Path -> R.Element
metricsLoadView setReload p = R.createElement el p []
where where
el = R.hooksComponent "MetricsLoadView" cpt el = R.hooksComponent "MetricsLoadView" cpt
cpt p _ = do cpt p _ = do
useLoader p getMetrics $ \{loaded} -> useLoader p (getMetrics ends) $ \loaded ->
loadedMetricsView setReload loaded loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> Loaded -> R.Element loadedMetricsView :: R.State Int -> Loaded -> R.Element
loadedMetricsView setReload loaded = H.div {} [ loadedMetricsView setReload loaded =
U.reloadButton setReload H.div {}
, R2.buff $ chart (scatterOptions loaded) [ U.reloadButton setReload
] , chart (scatterOptions loaded) ]
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment