Skip to content

P
purescript-gargantext
Commit ddb99dd0 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FIX] Annuaire User Layout (WIP)

parent 8ed698b7
Show whitespace changes
Inline Side-by-side
Showing with 184 additions and 93 deletions
src/Gargantext/Components/FacetsTable.purs
View file @ ddb99dd0
......@@ -13,6 +13,7 @@ import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.String (Pattern(..), split)
import Data.String as String
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
......@@ -59,6 +60,7 @@ type Deletions = { pending :: Set Int
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
----------------------------------------------------------------------
newtype Pair =
Pair { id :: Int
, label :: String
......@@ -69,6 +71,7 @@ derive instance genericPair :: Generic Pair _
instance showPair :: Show Pair where
show = genericShow
----------------------------------------------------------------------
newtype DocumentsView =
DocumentsView
{ id :: Int
......@@ -85,15 +88,32 @@ newtype DocumentsView =
, publication_day :: Int
}
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
(zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month) <> "-" <> (zeroPad 2 publication_day)
derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where
show = genericShow
----------------------------------------------------------------------
newtype ContactsView =
ContactsView
{ id :: Int
, hyperdata :: HyperdataRowContact
, score :: Int
, annuaireId :: Int
, delete :: Boolean
}
derive instance genericContactsView :: Generic ContactsView _
instance showContactsView :: Show ContactsView where
show = genericShow
----------------------------------------------------------------------
data Rows = Docs { docs :: Seq DocumentsView }
| Contacts { contacts :: Seq ContactsView }
----------------------------------------------------------------------
-- | Main layout of the Documents Tab of a Corpus
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []
......@@ -190,7 +210,7 @@ type PagePath = { nodeId :: Int
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
loadPage :: PagePath -> Aff (Seq DocumentsView)
loadPage :: PagePath -> Aff Rows
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do
let
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
......@@ -206,10 +226,10 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc
--SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
SearchResult {result} <- post session p query
-- $ SearchQuery {query: concat query, expected: SearchDoc}
pure case result of
SearchResultDoc {docs} -> doc2view <$> Seq.fromFoldable docs
SearchResultContact {contacts} -> contact2view <$> Seq.fromFoldable contacts
errMessage -> pure $ err2view errMessage
pure $ case result of
SearchResultDoc {docs} -> Docs {docs: doc2view <$> Seq.fromFoldable docs}
SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts}
errMessage -> Docs {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view
doc2view :: Document -> DocumentsView
doc2view ( Document { id
......@@ -238,27 +258,18 @@ doc2view ( Document { id
, publication_day : fromMaybe 1 publication_day
}
contact2view :: Contact -> DocumentsView
contact2view :: Contact -> ContactsView
contact2view (Contact { c_id
, c_created: date
, c_hyperdata: HyperdataRowContact { firstname
, lastname
, labs
}
, c_hyperdata
, c_annuaireId
, c_score
}
) = DocumentsView { id: c_id
, date: ""
, title : firstname <> " " <> lastname
, source: labs
) = ContactsView { id: c_id
, hyperdata: c_hyperdata
, score: c_score
, authors: labs
, category: decodeCategory 1
, pairs: []
, annuaireId : c_annuaireId
, delete: false
, publication_year: 2020
, publication_month: 10
, publication_day: 1
}
err2view message =
......@@ -276,9 +287,6 @@ err2view message =
, publication_day: 1
}
type PageLayoutProps =
( frontends :: Frontends
, totalRecords :: Int
......@@ -288,7 +296,7 @@ type PageLayoutProps =
, path :: R.State PagePath
)
type PageProps = ( documents :: Seq DocumentsView | PageLayoutProps )
type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
-- | Loads and renders a page
pageLayout :: Record PageLayoutProps -> R.Element
......@@ -298,8 +306,8 @@ pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt
where
cpt {frontends, totalRecords, deletions, container, session, path} _ = do
useLoader (fst path) loadPage $ \documents ->
page {frontends, totalRecords, deletions, container, session, path, documents}
useLoader (fst path) loadPage $ \rowsLoaded ->
page {frontends, totalRecords, deletions, container, session, path, rowsLoaded}
page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []
......@@ -307,7 +315,7 @@ page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps
pageCpt = R.hooksComponentWithModule thisModule "page" cpt
where
cpt {frontends, totalRecords, container, deletions, documents, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
cpt {frontends, totalRecords, container, deletions, rowsLoaded, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
pure $ T.table { syncResetButton : [ H.div {} [] ]
, rows, container, colNames
, totalRecords, params, wrapColElts
......@@ -316,27 +324,49 @@ pageCpt = R.hooksComponentWithModule thisModule "page" cpt
setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
params = (fst path).params /\ setParams
-- colNames = T.ColumnName <$> [ "", "Date", "Title", "Source", "Authors", "Delete" ]
colNames = T.ColumnName <$> [ "", "Search", "Result", "", "", "" ]
colNames = case rowsLoaded of
Docs _ -> T.ColumnName <$> [ "", "Date", "Title", "Journal", "", "" ]
Contacts _ -> T.ColumnName <$> [ "", "Contact", "Organization", "", "", "" ]
wrapColElts = const identity
-- TODO: how to interprete other scores?
gi Favorite = "fa fa-star-empty"
gi Trash = "fa fa-star-empty"
gi _ = "fa fa-star"
isChecked id = Set.member id (fst deletions).pending
isDeleted (DocumentsView {id}) = Set.member id (fst deletions).deleted
pairUrl (Pair {id,label})
| id > 1 = H.a { href, target: "blank" } [ H.text label ]
where href = url session $ NodePath (sessionId session) NodeContact (Just id)
| otherwise = H.text label
documentUrl id =
url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
comma = H.span {} [ H.text ", " ]
rows = row <$> Seq.filter (not <<< isDeleted) documents
row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
rows = case rowsLoaded of
Docs {docs} -> docRow <$> Seq.filter (not <<< isDeleted) docs
Contacts {contacts} -> contactRow <$> contacts
contactRow (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs}
, score, annuaireId, delete
}) =
{ row:
T.makeRow [
H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
-- TODO show date: Year-Month-Day only
-- , maybeStricken delete [ H.text $ publicationDate dv ]
T.makeRow [ H.div {} [ H.a { className: gi Favorite, on: {click: markClick} } [] ]
, maybeStricken delete [ H.a {target: "_blank", href: contactUrl annuaireId id}
[ H.text $ firstname <> " " <> lastname ]
]
, maybeStricken delete [ H.text labs ]
]
, delete: true
}
where
markClick _ = markCategory session nodeId Favorite [id]
contactUrl aId id = url frontends $ Routes.ContactPage (sessionId session) annuaireId id
docRow dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
{ row:
T.makeRow [ H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
, maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
, maybeStricken delete [ H.text source ]
-- , maybeStricken delete [ H.text authors ]
......@@ -351,10 +381,18 @@ pageCpt = R.hooksComponentWithModule thisModule "page" cpt
where
markClick _ = markCategory session nodeId category [id]
toggleClick _ = togglePendingDeletion deletions id
-- comma = H.span {} [ H.text ", " ]
maybeStricken delete
| delete = H.div { style: { textDecoration: "line-through" } }
| otherwise = H.div {}
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
(zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month)
-- <> "-" <> (zeroPad 2 publication_day)
---------------------------------------------------------
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
......
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ ddb99dd0
......@@ -332,6 +332,3 @@ Global/local view:
To explore the neighborhood of a selection click on the 'change level' button.
-}
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
View file @ ddb99dd0
......@@ -150,8 +150,8 @@ contactInfoItemCpt = R.hooksComponentWithModule thisModule "contactInfoItem" cpt
listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" }
type LayoutProps = (
appReload :: GUR.ReloadS
type LayoutProps =
( appReload :: GUR.ReloadS
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, frontends :: Frontends
, nodeId :: Int
......@@ -219,7 +219,7 @@ userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey"
_ <- saveContactHyperdata session nodeId hd
liftEffect $ GUR.bump reload
-- | toUrl to get data
-- | toUrl to get data XXX
getContact :: Session -> Int -> Aff ContactData
getContact session id = do
contactNode <- get session $ Routes.NodeAPI Node (Just id) ""
......@@ -240,9 +240,8 @@ saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h
type AnnuaireLayoutProps = (
annuaireId :: Int
| LayoutProps )
type AnnuaireLayoutProps = ( annuaireId :: Int | LayoutProps )
type AnnuaireKeyLayoutProps = ( key :: String | AnnuaireLayoutProps )
annuaireUserLayout :: Record AnnuaireLayoutProps -> R.Element
......@@ -251,6 +250,21 @@ annuaireUserLayout props = R.createElement annuaireUserLayoutCpt props []
annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps
annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayout" cpt
where
cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
let sid = sessionId session
pure $ annuaireUserLayoutWithKey { annuaireId,
appReload
, asyncTasksRef
, frontends
, key: show sid <> "-" <> show nodeId
, nodeId
, session
, treeReloadRef
}
{-
cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
cacheState <- R.useState' LT.CacheOn
......@@ -260,8 +274,7 @@ annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayou
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [
display { title: fromMaybe "no name" name } (contactInfos hyperdata onUpdateHyperdata)
, Tabs.tabs {
appReload
, Tabs.tabs { appReload
, asyncTasksRef
, cacheState
, contactData
......@@ -276,10 +289,51 @@ annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayou
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata _ = pure unit
-}
annuaireUserLayoutWithKey :: Record AnnuaireKeyLayoutProps -> R.Element
annuaireUserLayoutWithKey props = R.createElement annuaireUserLayoutWithKeyCpt props []
annuaireUserLayoutWithKeyCpt :: R.Component AnnuaireKeyLayoutProps
annuaireUserLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "annuaireUserLayoutWithKey" cpt
where
cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
reload <- GUR.new
cacheState <- R.useState' LT.CacheOn
sidePanelTriggers <- LT.emptySidePanelTriggers
useLoader nodeId (getAnnuaireContact session annuaireId) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [
display { title: fromMaybe "no name" name } (contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs {
appReload
, asyncTasksRef
, cacheState
, contactData
, frontends
, nodeId
, session
, sidePanelTriggers
, treeReloadRef
}
]
where
onUpdateHyperdata :: GUR.ReloadS -> HyperdataUser -> Effect Unit
onUpdateHyperdata reload hd = do
launchAff_ $ do
_ <- saveContactHyperdata session nodeId hd
liftEffect $ GUR.bump reload
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do
contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ show 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
......
src/Gargantext/Components/Search.purs
View file @ ddb99dd0
......@@ -58,8 +58,7 @@ instance encodeJsonSearchResult :: Argonaut.EncodeJson SearchResult where
------------------------------------------------------------------------
data SearchResultTypes =
SearchResultDoc { docs :: Array Document}
data SearchResultTypes = SearchResultDoc { docs :: Array Document}
| SearchNoResult { message :: String }
| SearchResultContact { contacts :: Array Contact }
......@@ -132,6 +131,7 @@ data Contact =
, c_created :: String
, c_hyperdata :: HyperdataRowContact
, c_score :: Int
, c_annuaireId :: Int
}
derive instance eqContact :: Eq Contact
......
src/Gargantext/Ends.purs
View file @ ddb99dd0
......@@ -222,6 +222,7 @@ sessionPath (R.ChartHash { chartType, listId, tabType } i) =
<> defaultListAddMaybe listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
------- misc routing stuff
defaultList :: Int -> String
......
src/Gargantext/Routes.purs
View file @ ddb99dd0
......@@ -5,7 +5,7 @@ import Prelude
import Data.Maybe (Maybe(..))
import Gargantext.Types (ChartOpts, ChartType, CorpusMetricOpts, CTabNgramType, Id, Limit,
ListId, NgramsGetOpts, NgramsGetTableAllOpts, NodeType,
ListId, DocId, ContactId, NgramsGetOpts, NgramsGetTableAllOpts, NodeType,
Offset, OrderBy, SearchOpts, SessionId, TabSubType, TabType, TermList)
import Gargantext.Types as GT
......@@ -35,9 +35,6 @@ data AppRoute
derive instance eqAppRoute :: Eq AppRoute
type AnnuaireId = Int
type ContactId = Int
data SessionRoute
= Tab TabType (Maybe Id)
| Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
......@@ -53,12 +50,13 @@ data SessionRoute
| TreeFirstLevel (Maybe Id) String
| GraphAPI Id String
| ListsRoute ListId
| ListDocument (Maybe ListId) (Maybe Id)
| ListDocument (Maybe ListId) (Maybe DocId)
| Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id)
| CorpusMetricsHash { listId :: ListId, tabType :: TabType } (Maybe Id)
| Chart ChartOpts (Maybe Id)
| ChartHash { chartType :: ChartType, listId :: Maybe ListId, tabType :: TabType } (Maybe Id)
-- | AnnuaireContact AnnuaireId DocId
instance showAppRoute :: Show AppRoute where
show Home = "Home"
......
src/Gargantext/Types.purs
View file @ ddb99dd0
......@@ -333,8 +333,11 @@ nodeTypePath (NodePublic nt) = nodeTypePath nt
nodeTypePath NodeFile = "file"
------------------------------------------------------------
type CorpusId = Int
type DocId = Int
type ListId = Int
type AnnuaireId = Int
type ContactId = Int
data ScoreType = Occurrences
......
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