Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
142
Issues
142
List
Board
Labels
Milestones
Merge Requests
4
Merge Requests
4
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
4e2eb894
Commit
4e2eb894
authored
Sep 20, 2019
by
James Laver
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Refactor G.P.Annuaire to use Reactix
parent
f45a7bf8
Changes
9
Expand all
Show whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
491 additions
and
459 deletions
+491
-459
Annuaire.purs
src/Gargantext/Pages/Annuaire.purs
+117
-162
Contacts.purs
src/Gargantext/Pages/Annuaire/User/Contacts.purs
+156
-4
Specs.purs
src/Gargantext/Pages/Annuaire/User/Contacts/Specs.purs
+0
-179
Tabs.purs
src/Gargantext/Pages/Annuaire/User/Contacts/Tabs.purs
+92
-0
Types.purs
src/Gargantext/Pages/Annuaire/User/Contacts/Types.purs
+34
-31
Histo.purs
src/Gargantext/Pages/Corpus/Chart/Histo.purs
+22
-26
Metrics.purs
src/Gargantext/Pages/Corpus/Chart/Metrics.purs
+19
-13
Pie.purs
src/Gargantext/Pages/Corpus/Chart/Pie.purs
+30
-26
Tree.purs
src/Gargantext/Pages/Corpus/Chart/Tree.purs
+21
-18
No files found.
src/Gargantext/Pages/Annuaire.purs
View file @
4e2eb894
This diff is collapsed.
Click to expand it.
src/Gargantext/Pages/Annuaire/User/Contacts.purs
View file @
4e2eb894
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}
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)
...
@@ -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
src/Gargantext/Pages/Annuaire/User/Contacts/Types.purs
View file @
4e2eb894
...
@@ -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
...
...
src/Gargantext/Pages/Corpus/Chart/Histo.purs
View file @
4e2eb894
...
@@ -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 []
histo
Spec :: Spec {} Path Void
histo
Cpt :: R.Component Props
histo
Spec = R2.elSpec $
R.hooksComponent "LoadedMetricsHisto" cpt
histo
Cpt =
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 p
ath (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
src/Gargantext/Pages/Corpus/Chart/Metrics.purs
View file @
4e2eb894
...
@@ -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 p
ath (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
src/Gargantext/Pages/Corpus/Chart/Pie.purs
View file @
4e2eb894
...
@@ -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 p
ath (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 []
bar
Spec :: Spec {} Path Void
bar
Cpt :: R.Component Props
bar
Spec = R2.elSpec $
R.hooksComponent "LoadedMetricsBar" cpt
bar
Cpt =
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 p
ath (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
src/Gargantext/Pages/Corpus/Chart/Tree.purs
View file @
4e2eb894
...
@@ -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 []
tree
Spec :: Spec {} Path Void
tree
Cpt :: R.Component Props
tree
Spec = R2.elSpec $
R.hooksComponent "LoadedMetrics" cpt
tree
Cpt =
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)
]
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment