Skip to content

P
purescript-gargantext
Commit 4e2eb894 authored by James Laver's avatar James Laver
Browse files
Options

Refactor G.P.Annuaire to use Reactix

parent f45a7bf8
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 491 additions and 459 deletions
src/Gargantext/Pages/Annuaire.purs
View file @ 4e2eb894
This diff is collapsed.
src/Gargantext/Pages/Annuaire/User/Contacts.purs
View file @ 4e2eb894
module Gargantext.Pages.Annuaire.User.Contacts
(module Gargantext.Pages.Annuaire.User.Contacts.Types,
module Gargantext.Pages.Annuaire.User.Contacts.Specs)
where
( module Gargantext.Pages.Annuaire.User.Contacts.Types
, userLayout )
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.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}
src/Gargantext/Pages/Annuaire/User/Contacts/Specs.purs deleted 100644 → 0
View file @ f45a7bf8
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}
src/Gargantext/Pages/Annuaire/User/Contacts/Tabs/Specs.purs → src/Gargantext/Pages/Annuaire/User/Contacts/Tabs.purs
View file @ 4e2eb894
......@@ -7,9 +7,10 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.List (fromFoldable)
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.NgramsTable as NT
import Gargantext.Components.Tab as Tab
......@@ -17,8 +18,7 @@ import Gargantext.Pages.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import React (Children, ReactElement, ReactClass, createElement)
import Thermite (Spec, hideState, noState, cmapProps, createClass)
import Reactix.DOM.HTML as H
data Mode = Patents | Books | Communication
......@@ -40,51 +40,53 @@ modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors
type PropsRow =
type Props =
( nodeId :: Int
, contactData :: ContactData
)
type Props = Record PropsRow
, ends :: Ends )
elt :: Props -> ReactElement
elt props = createElement tabsClass props []
tabs :: Record Props -> R.Element
tabs props = R.createElement tabsCpt props []
tabsClass :: ReactClass { children :: Children | PropsRow }
tabsClass = createClass "ContactsTabs" pureTabs (const {})
pureTabs :: Spec {} Props Void
pureTabs = hideState (const {activeTab: 0}) statefulTabs
statefulTabs :: Spec Tab.State Props Tab.Action
statefulTabs =
Tab.tabs identity identity $ fromFoldable
[ Tuple "Documents" $ docs
, Tuple "Patents" $ ngramsViewSpec {mode: Patents}
, Tuple "Books" $ ngramsViewSpec {mode: Books}
, Tuple "Communication" $ ngramsViewSpec {mode: Communication}
, Tuple "Trash" $ docs -- TODO pass-in trash mode
]
tabsCpt :: R.Component Props
tabsCpt = R.hooksComponent "G.P.Annuaire.User.Contacts.Tabs.tabs" cpt
where
cpt {nodeId, contactData: {defaultListId}, ends} _ = do
active <- R.useState' 0
pure $
Tab.tabs { tabs: tabs', selected: fst active }
where
tabs' =
[ "Documents" /\ docs
, "Patents" /\ ngramsView patentsView
, "Books" /\ ngramsView booksView
, "Communication" /\ ngramsView commView
, "Trash" /\ docs -- TODO pass-in trash mode
]
where
patentsView = {ends, defaultListId, nodeId, mode: Patents}
booksView = {ends, defaultListId, nodeId, mode: Books}
commView = {ends, defaultListId, nodeId, mode: Communication}
chart = mempty
totalRecords = 4736 -- TODO
docs = DT.docView
{ ends, nodeId, chart, totalRecords
, tabType: TabPairing TabDocs
, listId: defaultListId
, corpusId: Nothing
, showSearch: true }
type NgramsViewProps =
( ends :: Ends
, mode :: Mode
, defaultListId :: Int
, nodeId :: Int )
ngramsView :: Record NgramsViewProps -> R.Element
ngramsView {ends,mode, defaultListId, nodeId} =
NT.mainNgramsTable
{ nodeId, defaultListId, tabType, ends, tabNgramType }
where
chart = mempty
-- TODO totalRecords
docs = noState $ R2.elSpec $ R.hooksComponent "DocViewSpecWithCorpus" $ \{nodeId, contactData: {defaultListId}} _ -> do
pure $ DT.docViewSpec
{ nodeId
, chart
, tabType: TabPairing TabDocs
, totalRecords: 4736
, listId: defaultListId
, corpusId: Nothing
, showSearch: true
}
ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action
ngramsViewSpec {mode} =
cmapProps (\{contactData: {defaultListId}, nodeId} ->
{defaultListId, nodeId, tabType})
(noState (NT.mainNgramsTableSpec (modeTabType' mode)))
where
tabType = TabPairing $ TabNgramType $ modeTabType mode
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode
src/Gargantext/Pages/Annuaire/User/Contacts/Types.purs
View file @ 4e2eb894
......@@ -2,33 +2,34 @@ module Gargantext.Pages.Annuaire.User.Contacts.Types where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Maybe (Maybe, fromMaybe)
import Data.Map (Map)
import Data.Argonaut (class DecodeJson, decodeJson, (.?), (.??))
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Map (Map(..))
import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Newtype (class Newtype)
-- TODO: should it be a NodePoly HyperdataContact ?
newtype Contact = Contact {
id :: Int
newtype Contact =
Contact
{ id :: Int
, typename :: Maybe Int
, userId :: Maybe Int
, parentId :: Maybe Int
, name :: Maybe String
, date :: Maybe String
, hyperdata :: HyperdataContact
}
, hyperdata :: HyperdataContact }
derive instance newtypeContact :: Newtype Contact _
newtype ContactWho =
ContactWho { idWho :: Maybe String
, firstName :: Maybe String
, lastName :: Maybe String
, keywords :: (Array String)
, freetags :: (Array String)
}
ContactWho
{ idWho :: Maybe String
, firstName :: Maybe String
, lastName :: Maybe String
, keywords :: (Array String)
, freetags :: (Array String) }
derive instance newtypeContactWho :: Newtype ContactWho _
......@@ -48,20 +49,21 @@ instance decodeContactWho :: DecodeJson ContactWho
pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f}
newtype ContactWhere =
ContactWhere { organization :: (Array String)
, labTeamDepts :: (Array String)
, role :: Maybe String
, office :: Maybe String
, country :: Maybe String
, city :: Maybe String
, touch :: Maybe ContactTouch
ContactWhere
{ organization :: (Array String)
, labTeamDepts :: (Array String)
, entry :: Maybe String
, exit :: Maybe String
}
, role :: Maybe String
, office :: Maybe String
, country :: Maybe String
, city :: Maybe String
, touch :: Maybe ContactTouch
, entry :: Maybe String
, exit :: Maybe String }
derive instance newtypeContactWhere :: Newtype ContactWhere _
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}
newtype ContactTouch =
ContactTouch { mail :: Maybe String
, phone :: Maybe String
, url :: Maybe String
}
ContactTouch
{ mail :: Maybe String
, phone :: Maybe String
, url :: Maybe String }
derive instance newtypeContactTouch :: Newtype ContactTouch _
instance decodeContactTouch :: DecodeJson ContactTouch
......
src/Gargantext/Pages/Corpus/Chart/Histo.purs
View file @ 4e2eb894
......@@ -6,7 +6,7 @@ import Effect.Aff (Aff)
import Gargantext.Config
import Gargantext.Config.REST (get)
import Reactix as R
import Thermite (Spec)
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Types (TermList(..))
......@@ -20,14 +20,11 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Pages.Corpus.Chart.Utils as U
type Path =
{ corpusId :: Int
, tabType :: TabType
}
type Path = { corpusId :: Int, tabType :: TabType }
newtype ChartMetrics = ChartMetrics
{ "data" :: HistoMetrics
}
type Props = ( path :: Path, ends :: Ends )
newtype ChartMetrics = ChartMetrics { "data" :: HistoMetrics }
instance decodeChartMetrics :: DecodeJson ChartMetrics where
decodeJson json = do
......@@ -35,10 +32,7 @@ instance decodeChartMetrics :: DecodeJson ChartMetrics where
d <- obj .: "data"
pure $ ChartMetrics { "data": d }
newtype HistoMetrics = HistoMetrics
{ dates :: Array String
, count :: Array Number
}
newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number }
instance decodeHistoMetrics :: DecodeJson HistoMetrics where
decodeJson json = do
......@@ -60,27 +54,29 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
}
getMetrics :: Path -> Aff HistoMetrics
getMetrics {corpusId, tabType} = do
ChartMetrics ms <- get $ toUrl endConfigStateful Back (Chart {chartType: Histo, tabType: tabType}) $ Just corpusId
getMetrics :: Ends -> Path -> Aff HistoMetrics
getMetrics ends {corpusId, tabType} = do
ChartMetrics ms <- get $ url ends chart
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
histoSpec = R2.elSpec $ R.hooksComponent "LoadedMetricsHisto" cpt
histoCpt :: R.Component Props
histoCpt = R.hooksComponent "LoadedMetricsHisto" cpt
where
cpt p _ = do
cpt {ends,path} _ = do
setReload <- R.useState' 0
pure $ metricsLoadView ends setReload path
pure $ metricsLoadView setReload p
metricsLoadView :: R.State Int -> Path -> R.Element
metricsLoadView setReload p = R.createElement el p []
metricsLoadView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadView ends setReload path = R.createElement el {ends,path} []
where
el = R.hooksComponent "MetricsLoadedHistoView" cpt
cpt p _ = do
useLoader p getMetrics $ \{loaded} ->
cpt {path,ends} _ = do
useLoader path (getMetrics ends) $ \loaded ->
loadedMetricsView setReload loaded
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
src/Gargantext/Pages/Corpus/Chart/Metrics.purs
View file @ 4e2eb894
......@@ -6,9 +6,10 @@ import Data.Map (Map)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Effect.Aff (Aff)
import Gargantext.Config
import Gargantext.Config (Ends, BackendRoute(..), TabType, url)
import Gargantext.Config.REST (get)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Types (TermList(..))
......@@ -30,6 +31,8 @@ type Path =
, limit :: Maybe Int
}
type Props = ( path :: Path, ends :: Ends )
newtype Metric = Metric
{ label :: String
, x :: Number
......@@ -92,26 +95,29 @@ scatterOptions metrics = Options
}
--}
getMetrics :: Path -> Aff Loaded
getMetrics {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ toUrl endConfigStateful Back (CorpusMetrics {listId, tabType, limit}) $ Just corpusId
getMetrics :: Ends -> Path -> Aff Loaded
getMetrics ends {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url ends metrics
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
cpt p _ = do
cpt {path, ends} _ = do
setReload <- R.useState' 0
pure $ metricsLoadView ends setReload path
pure $ metricsLoadView setReload p
metricsLoadView :: R.State Int -> Path -> R.Element
metricsLoadView setReload p = R.createElement el p []
metricsLoadView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadView ends setReload path = R.createElement el {ends,path} []
where
el = R.hooksComponent "MetricsLoadedView" cpt
cpt p' _ = do
useLoader p' getMetrics $ \{loaded} ->
cpt {ends, path} _ = do
useLoader path (getMetrics ends) $ \loaded ->
loadedMetricsView setReload loaded
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
src/Gargantext/Pages/Corpus/Chart/Pie.purs
View file @ 4e2eb894
......@@ -7,10 +7,10 @@ import Data.Maybe (Maybe(..))
import Data.String (take, joinWith, Pattern(..), split, length)
import Data.Tuple (Tuple(..))
import Effect.Aff (Aff)
import Gargantext.Config
import Gargantext.Config (Ends, BackendRoute(..), TabType, ChartType(..), url)
import Gargantext.Config.REST (get)
import Reactix as R
import Thermite (Spec)
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Types (TermList(..))
......@@ -28,6 +28,8 @@ type Path =
, tabType :: TabType
}
type Props = ( ends :: Ends, path :: Path )
newtype ChartMetrics = ChartMetrics
{ "data" :: HistoMetrics
}
......@@ -76,50 +78,52 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
}
getMetrics :: Path -> Aff HistoMetrics
getMetrics {corpusId, tabType:tabType} = do
ChartMetrics ms <- get $ toUrl endConfigStateful Back (Chart {chartType: ChartPie, tabType: tabType}) $ Just corpusId
getMetrics :: Ends -> Path -> Aff HistoMetrics
getMetrics ends {corpusId, tabType:tabType} = do
ChartMetrics ms <- get $ url ends chart
pure ms."data"
where chart = Chart {chartType: ChartPie, tabType: tabType} (Just corpusId)
pie :: Record Props -> R.Element
pie props = R.createElement pieCpt props []
pieSpec :: Spec {} Path Void
pieSpec = R2.elSpec $ R.hooksComponent "LoadedMetricsPie" cpt
pieCpt :: R.Component Props
pieCpt = R.hooksComponent "LoadedMetricsPie" cpt
where
cpt p _ = do
cpt {path,ends} _ = do
setReload <- R.useState' 0
pure $ metricsLoadPieView ends setReload path
pure $ metricsLoadPieView setReload p
metricsLoadPieView :: R.State Int -> Path -> R.Element
metricsLoadPieView setReload p = R.createElement el p []
metricsLoadPieView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadPieView ends setReload path = R.createElement el {ends,path} []
where
el = R.hooksComponent "MetricsLoadedPieView" cpt
cpt p _ = do
useLoader p getMetrics $ \{loaded} ->
cpt {ends,path} _ = do
useLoader path (getMetrics ends) $ \loaded ->
loadedMetricsPieView setReload loaded
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
barSpec = R2.elSpec $ R.hooksComponent "LoadedMetricsBar" cpt
barCpt :: R.Component Props
barCpt = R.hooksComponent "LoadedMetricsBar" cpt
where
cpt p _ = do
cpt {path, ends} _ = do
setReload <- R.useState' 0
pure $ metricsLoadBarView setReload p
pure $ metricsLoadBarView ends setReload path
metricsLoadBarView :: R.State Int -> Path -> R.Element
metricsLoadBarView setReload p = R.createElement el p []
metricsLoadBarView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadBarView ends setReload path = R.createElement el {ends,path} []
where
el = R.hooksComponent "MetricsLoadedBarView" cpt
cpt p _ = do
useLoader p getMetrics $ \{loaded} ->
cpt {path, ends} _ = do
useLoader path (getMetrics ends) $ \loaded ->
loadedMetricsBarView setReload loaded
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
src/Gargantext/Pages/Corpus/Chart/Tree.purs
View file @ 4e2eb894
......@@ -3,11 +3,10 @@ module Gargantext.Pages.Corpus.Chart.Tree where
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Config
import Gargantext.Config (Ends, BackendRoute(..), TabType, ChartType(..), url)
import Gargantext.Config.REST (get)
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (Spec)
import Gargantext.Prelude
import Gargantext.Types (TermList(..))
......@@ -26,7 +25,7 @@ type Path =
, tabType :: TabType
, limit :: Maybe Int
}
type Props = ( path :: Path, ends :: Ends )
newtype Metrics = Metrics
{ "data" :: Array TreeNode
......@@ -54,29 +53,33 @@ scatterOptions nodes = Options
}
getMetrics :: Path -> Aff Loaded
getMetrics {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ toUrl endConfigStateful Back (Chart {chartType : ChartTree, tabType: tabType}) $ Just corpusId
getMetrics :: Ends -> Path -> Aff Loaded
getMetrics ends {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url ends chart
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
treeSpec = R2.elSpec $ R.hooksComponent "LoadedMetrics" cpt
treeCpt :: R.Component Props
treeCpt = R.hooksComponent "LoadedMetrics" cpt
where
cpt p _ = do
cpt {path, ends} _ = do
setReload <- R.useState' 0
pure $ metricsLoadView ends setReload path
pure $ metricsLoadView setReload p
metricsLoadView :: R.State Int -> Path -> R.Element
metricsLoadView setReload p = R.createElement el p []
metricsLoadView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadView ends setReload p = R.createElement el p []
where
el = R.hooksComponent "MetricsLoadView" cpt
cpt p _ = do
useLoader p getMetrics $ \{loaded} ->
useLoader p (getMetrics ends) $ \loaded ->
loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> Loaded -> R.Element
loadedMetricsView setReload loaded = H.div {} [
U.reloadButton setReload
, R2.buff $ chart (scatterOptions loaded)
]
loadedMetricsView setReload loaded =
H.div {}
[ 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