Commit dc04d045 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-graph-sidebar-styling-fixes' of...

Merge branch 'dev-graph-sidebar-styling-fixes' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 15ffa041 9a59820e
...@@ -13,6 +13,7 @@ import Data.Sequence (Seq) ...@@ -13,6 +13,7 @@ import Data.Sequence (Seq)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.String (Pattern(..), split)
import Data.String as String import Data.String as String
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
...@@ -59,6 +60,7 @@ type Deletions = { pending :: Set Int ...@@ -59,6 +60,7 @@ type Deletions = { pending :: Set Int
initialDeletions :: Deletions initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty } initialDeletions = { pending: mempty, deleted: mempty }
----------------------------------------------------------------------
newtype Pair = newtype Pair =
Pair { id :: Int Pair { id :: Int
, label :: String , label :: String
...@@ -69,6 +71,7 @@ derive instance genericPair :: Generic Pair _ ...@@ -69,6 +71,7 @@ derive instance genericPair :: Generic Pair _
instance showPair :: Show Pair where instance showPair :: Show Pair where
show = genericShow show = genericShow
----------------------------------------------------------------------
newtype DocumentsView = newtype DocumentsView =
DocumentsView DocumentsView
{ id :: Int { id :: Int
...@@ -85,15 +88,32 @@ newtype DocumentsView = ...@@ -85,15 +88,32 @@ newtype DocumentsView =
, publication_day :: Int , 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 _ derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where instance showDocumentsView :: Show DocumentsView where
show = genericShow 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 -- | Main layout of the Documents Tab of a Corpus
docView :: Record Props -> R.Element docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props [] docView props = R.createElement docViewCpt props []
...@@ -163,7 +183,7 @@ docViewGraphCpt = R.hooksComponentWithModule thisModule "docViewGraph" cpt ...@@ -163,7 +183,7 @@ docViewGraphCpt = R.hooksComponentWithModule thisModule "docViewGraph" cpt
path <- R.useState' $ initialPagePath { nodeId, listId, query, session } path <- R.useState' $ initialPagePath { nodeId, listId, query, session }
pure $ R.fragment pure $ R.fragment
[ H.br {} [ H.br {}
, H.p {} [ H.text "" ] , H.p {} [ H.text "" ]
, H.br {} , H.br {}
, H.div { className: "container-fluid" } , H.div { className: "container-fluid" }
[ R2.row [ R2.row
...@@ -190,7 +210,7 @@ type PagePath = { nodeId :: Int ...@@ -190,7 +210,7 @@ type PagePath = { nodeId :: Int
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams} 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 loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do
let let
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
...@@ -206,10 +226,10 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc ...@@ -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 $ SearchQuery {query: concat query, expected:searchType}
SearchResult {result} <- post session p query SearchResult {result} <- post session p query
-- $ SearchQuery {query: concat query, expected: SearchDoc} -- $ SearchQuery {query: concat query, expected: SearchDoc}
pure case result of pure $ case result of
SearchResultDoc {docs} -> doc2view <$> Seq.fromFoldable docs SearchResultDoc {docs} -> Docs {docs: doc2view <$> Seq.fromFoldable docs}
SearchResultContact {contacts} -> contact2view <$> Seq.fromFoldable contacts SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts}
errMessage -> pure $ err2view errMessage errMessage -> Docs {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view
doc2view :: Document -> DocumentsView doc2view :: Document -> DocumentsView
doc2view ( Document { id doc2view ( Document { id
...@@ -238,28 +258,19 @@ doc2view ( Document { id ...@@ -238,28 +258,19 @@ doc2view ( Document { id
, publication_day : fromMaybe 1 publication_day , publication_day : fromMaybe 1 publication_day
} }
contact2view :: Contact -> DocumentsView contact2view :: Contact -> ContactsView
contact2view (Contact { c_id contact2view (Contact { c_id
, c_created: date , c_created: date
, c_hyperdata: HyperdataRowContact { firstname , c_hyperdata
, lastname , c_annuaireId
, labs
}
, c_score , c_score
} }
) = DocumentsView { id: c_id ) = ContactsView { id: c_id
, date: "" , hyperdata: c_hyperdata
, title : firstname <> " " <> lastname , score: c_score
, source: labs , annuaireId : c_annuaireId
, score: c_score , delete: false
, authors: labs }
, category: decodeCategory 1
, pairs: []
, delete: false
, publication_year: 2020
, publication_month: 10
, publication_day: 1
}
err2view message = err2view message =
DocumentsView { id: 1 DocumentsView { id: 1
...@@ -276,9 +287,6 @@ err2view message = ...@@ -276,9 +287,6 @@ err2view message =
, publication_day: 1 , publication_day: 1
} }
type PageLayoutProps = type PageLayoutProps =
( frontends :: Frontends ( frontends :: Frontends
, totalRecords :: Int , totalRecords :: Int
...@@ -288,7 +296,7 @@ type PageLayoutProps = ...@@ -288,7 +296,7 @@ type PageLayoutProps =
, path :: R.State PagePath , path :: R.State PagePath
) )
type PageProps = ( documents :: Seq DocumentsView | PageLayoutProps ) type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
-- | Loads and renders a page -- | Loads and renders a page
pageLayout :: Record PageLayoutProps -> R.Element pageLayout :: Record PageLayoutProps -> R.Element
...@@ -298,8 +306,8 @@ pageLayoutCpt :: R.Component PageLayoutProps ...@@ -298,8 +306,8 @@ pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt
where where
cpt {frontends, totalRecords, deletions, container, session, path} _ = do cpt {frontends, totalRecords, deletions, container, session, path} _ = do
useLoader (fst path) loadPage $ \documents -> useLoader (fst path) loadPage $ \rowsLoaded ->
page {frontends, totalRecords, deletions, container, session, path, documents} page {frontends, totalRecords, deletions, container, session, path, rowsLoaded}
page :: Record PageProps -> R.Element page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props [] page props = R.createElement pageCpt props []
...@@ -307,7 +315,7 @@ page props = R.createElement pageCpt props [] ...@@ -307,7 +315,7 @@ page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps pageCpt :: R.Component PageProps
pageCpt = R.hooksComponentWithModule thisModule "page" cpt pageCpt = R.hooksComponentWithModule thisModule "page" cpt
where 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 {} [] ] pure $ T.table { syncResetButton : [ H.div {} [] ]
, rows, container, colNames , rows, container, colNames
, totalRecords, params, wrapColElts , totalRecords, params, wrapColElts
...@@ -315,46 +323,75 @@ pageCpt = R.hooksComponentWithModule thisModule "page" cpt ...@@ -315,46 +323,75 @@ pageCpt = R.hooksComponentWithModule thisModule "page" cpt
where where
setParams f = setPath $ \p@{params: ps} -> p {params = f ps} setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
params = (fst path).params /\ setParams params = (fst path).params /\ setParams
-- colNames = T.ColumnName <$> [ "", "Date", "Title", "Source", "Authors", "Delete" ] colNames = case rowsLoaded of
colNames = T.ColumnName <$> [ "", "Search", "Result", "", "", "" ] Docs _ -> T.ColumnName <$> [ "", "Date", "Title", "Journal", "", "" ]
Contacts _ -> T.ColumnName <$> [ "", "Contact", "Organization", "", "", "" ]
wrapColElts = const identity wrapColElts = const identity
-- TODO: how to interprete other scores? -- TODO: how to interprete other scores?
gi Favorite = "fa fa-star-empty" gi Trash = "fa fa-star-empty"
gi _ = "fa fa-star" gi _ = "fa fa-star"
isChecked id = Set.member id (fst deletions).pending isChecked id = Set.member id (fst deletions).pending
isDeleted (DocumentsView {id}) = Set.member id (fst deletions).deleted isDeleted (DocumentsView {id}) = Set.member id (fst deletions).deleted
pairUrl (Pair {id,label}) pairUrl (Pair {id,label})
| id > 1 = H.a { href, target: "blank" } [ H.text label ] | id > 1 = H.a { href, target: "blank" } [ H.text label ]
where href = url session $ NodePath (sessionId session) NodeContact (Just id) where href = url session $ NodePath (sessionId session) NodeContact (Just id)
| otherwise = H.text label | otherwise = H.text label
documentUrl id = documentUrl id =
url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
comma = H.span {} [ H.text ", " ]
rows = row <$> Seq.filter (not <<< isDeleted) documents rows = case rowsLoaded of
row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) = Docs {docs} -> docRow <$> Seq.filter (not <<< isDeleted) docs
Contacts {contacts} -> contactRow <$> contacts
contactRow (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs}
, score, annuaireId, delete
}) =
{ row: { row:
T.makeRow [ T.makeRow [ H.div {} [ H.a { className: gi Favorite, on: {click: markClick} } [] ]
H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ] , maybeStricken delete [ H.a {target: "_blank", href: contactUrl annuaireId id}
-- TODO show date: Year-Month-Day only [ H.text $ firstname <> " " <> lastname ]
-- , maybeStricken delete [ H.text $ publicationDate dv ] ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ] , maybeStricken delete [ H.text labs ]
, maybeStricken delete [ H.text source ] ]
-- , maybeStricken delete [ H.text authors ] , delete: true
-- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs) }
{-, H.input { defaultChecked: isChecked id where
, on: { click: toggleClick } markClick _ = markCategory session nodeId Favorite [id]
, type: "checkbox" 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 ]
-- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
{-, H.input { defaultChecked: isChecked id
, on: { click: toggleClick }
, type: "checkbox"
}
-}
]
, delete: true } , delete: true }
where where
markClick _ = markCategory session nodeId category [id] markClick _ = markCategory session nodeId category [id]
toggleClick _ = togglePendingDeletion deletions id toggleClick _ = togglePendingDeletion deletions id
-- comma = H.span {} [ H.text ", " ]
maybeStricken delete maybeStricken delete
| delete = H.div { style: { textDecoration: "line-through" } } | delete = H.div { style: { textDecoration: "line-through" } }
| otherwise = H.div {} | 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 } newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
......
...@@ -255,7 +255,7 @@ sigmaSettings = ...@@ -255,7 +255,7 @@ sigmaSettings =
--, labelSize : "proportional" -- alt : proportional, fixed --, labelSize : "proportional" -- alt : proportional, fixed
, labelSize: "fixed" , labelSize: "fixed"
, labelSizeRatio: 2.0 -- label size in ratio of node size , labelSizeRatio: 2.0 -- label size in ratio of node size
, labelThreshold: 7.0 -- min node cam size to start showing label , labelThreshold: 6.0 -- min node cam size to start showing label
, maxEdgeSize: 1.0 , maxEdgeSize: 1.0
, maxNodeSize: 8.0 , maxNodeSize: 8.0
, minEdgeSize: 0.5 -- in fact used in tina as edge size , minEdgeSize: 0.5 -- in fact used in tina as edge size
......
...@@ -133,36 +133,46 @@ sideTab _ _ = H.div {} [] ...@@ -133,36 +133,46 @@ sideTab _ _ = H.div {} []
------------------------------------------- -------------------------------------------
-- TODO -- TODO
-- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element -- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element
selectedNodes props nodesMap = R2.row [ R2.col 12 selectedNodes props nodesMap =
[ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist"} R2.row [ R2.col 12
[ RH.div { className: "tab-content" } [ RH.ul { className: "nav nav-tabs d-flex justify-content-center"
[ RH.div { className: "", role: "tabpanel" } , id: "myTab"
( Seq.toUnfoldable , role: "tablist" }
$ ( Seq.map (badge props.selectedNodeIds) [ RH.div { className: "tab-content" }
(badges props.graph props.selectedNodeIds) [ RH.div { className: "d-flex flex-wrap justify-content-center"
) , role: "tabpanel" }
) ( Seq.toUnfoldable
] $ ( Seq.map (badge props.selectedNodeIds)
, RH.div { className: "tab-content flex-space-between" } (badges props.graph props.selectedNodeIds)
[ removeButton "Move as candidate" CandidateTerm props nodesMap )
, removeButton "Move as stop" StopTerm props nodesMap )
] , H.br {}
] ]
] ]
] , RH.div { className: "tab-content flex-space-between" }
[ removeButton "primary" "Move as candidate" CandidateTerm props nodesMap
, H.br {}
, removeButton "danger" "Move as stop" StopTerm props nodesMap
]
]
]
neighborhood props = RH.div { className: "tab-content", id: "myTabContent" } neighborhood props = RH.div { className: "tab-content", id: "myTabContent" }
[ RH.div { className: "", id: "home", role: "tabpanel" } [ RH.div { -- className: "flex-space-around d-flex justify-content-center"
className: "d-flex flex-wrap flex-space-around"
, id: "home"
, role: "tabpanel"
}
(Seq.toUnfoldable $ Seq.map (badge props.selectedNodeIds) (Seq.toUnfoldable $ Seq.map (badge props.selectedNodeIds)
$ neighbourBadges props.graph props.selectedNodeIds $ neighbourBadges props.graph props.selectedNodeIds
) )
] ]
removeButton text rType props' nodesMap' = removeButton btnType text rType props' nodesMap' =
if Set.isEmpty $ fst props'.selectedNodeIds then if Set.isEmpty $ fst props'.selectedNodeIds then
RH.div {} [] RH.div {} []
else else
RH.button { className: "btn btn-info" RH.button { className: "btn btn-sm btn-" <> btnType
, on: { click: onClickRemove rType props' nodesMap' } , on: { click: onClickRemove rType props' nodesMap' }
} }
[ RH.text text ] [ RH.text text ]
...@@ -200,11 +210,11 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected ...@@ -200,11 +210,11 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected
type DeleteNodes = type DeleteNodes =
( graphId :: Int ( graphId :: Int
, metaData :: GET.MetaData , metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node) , nodes :: Array (Record SigmaxT.Node)
, session :: Session , session :: Session
, termList :: TermList , termList :: TermList
, treeReload :: GUR.ReloadS , treeReload :: GUR.ReloadS
) )
...@@ -332,6 +342,3 @@ Global/local view: ...@@ -332,6 +342,3 @@ Global/local view:
To explore the neighborhood of a selection click on the 'change level' button. To explore the neighborhood of a selection click on the 'change level' button.
-} -}
...@@ -213,7 +213,7 @@ contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt ...@@ -213,7 +213,7 @@ contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt
pure $ T.makeRow [ pure $ T.makeRow [
H.text "" H.text ""
, H.text $ fromMaybe "First Name" firstName , H.a { target: "_blank", href: contactUrl annuaireId id} [H.text $ fromMaybe "First Name" firstName]
, H.text $ fromMaybe "First Name" lastName , H.text $ fromMaybe "First Name" lastName
-- , H.a { href } [ H.text $ fromMaybe "name" contact.title ] -- , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
--, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ] --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
...@@ -226,6 +226,7 @@ contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt ...@@ -226,6 +226,7 @@ contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt
--nodepath = NodePath (sessionId session) NodeContact (Just id) --nodepath = NodePath (sessionId session) NodeContact (Just id)
nodepath = Routes.ContactPage (sessionId session) annuaireId id nodepath = Routes.ContactPage (sessionId session) annuaireId id
href = url frontends nodepath href = url frontends nodepath
contactUrl aId id = url frontends $ Routes.ContactPage (sessionId session) annuaireId id
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization" contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
contactWhereOrg (CT.ContactWhere { organization: orga }) = contactWhereOrg (CT.ContactWhere { organization: orga }) =
......
...@@ -150,8 +150,8 @@ contactInfoItemCpt = R.hooksComponentWithModule thisModule "contactInfoItem" cpt ...@@ -150,8 +150,8 @@ contactInfoItemCpt = R.hooksComponentWithModule thisModule "contactInfoItem" cpt
listElement :: Array R.Element -> R.Element listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" } listElement = H.li { className: "list-group-item justify-content-between" }
type LayoutProps = ( type LayoutProps =
appReload :: GUR.ReloadS ( appReload :: GUR.ReloadS
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor) , asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
...@@ -219,7 +219,7 @@ userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey" ...@@ -219,7 +219,7 @@ userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey"
_ <- saveContactHyperdata session nodeId hd _ <- saveContactHyperdata session nodeId hd
liftEffect $ GUR.bump reload liftEffect $ GUR.bump reload
-- | toUrl to get data -- | toUrl to get data XXX
getContact :: Session -> Int -> Aff ContactData getContact :: Session -> Int -> Aff ContactData
getContact session id = do getContact session id = do
contactNode <- get session $ Routes.NodeAPI Node (Just id) "" contactNode <- get session $ Routes.NodeAPI Node (Just id) ""
...@@ -240,9 +240,8 @@ saveContactHyperdata session id h = do ...@@ -240,9 +240,8 @@ saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h put session (Routes.NodeAPI Node (Just id) "") h
type AnnuaireLayoutProps = ( type AnnuaireLayoutProps = ( annuaireId :: Int | LayoutProps )
annuaireId :: Int type AnnuaireKeyLayoutProps = ( key :: String | AnnuaireLayoutProps )
| LayoutProps )
annuaireUserLayout :: Record AnnuaireLayoutProps -> R.Element annuaireUserLayout :: Record AnnuaireLayoutProps -> R.Element
...@@ -251,6 +250,21 @@ annuaireUserLayout props = R.createElement annuaireUserLayoutCpt props [] ...@@ -251,6 +250,21 @@ annuaireUserLayout props = R.createElement annuaireUserLayoutCpt props []
annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps
annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayout" cpt annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayout" cpt
where 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 cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
cacheState <- R.useState' LT.CacheOn cacheState <- R.useState' LT.CacheOn
...@@ -260,6 +274,40 @@ annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayou ...@@ -260,6 +274,40 @@ annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayou
\contactData@{contactNode: Contact {name, hyperdata}} -> \contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [ H.ul { className: "col-md-12 list-group" } [
display { title: fromMaybe "no name" name } (contactInfos hyperdata onUpdateHyperdata) display { title: fromMaybe "no name" name } (contactInfos hyperdata onUpdateHyperdata)
, Tabs.tabs { appReload
, asyncTasksRef
, cacheState
, contactData
, frontends
, nodeId
, session
, sidePanelTriggers
, treeReloadRef
}
]
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 { , Tabs.tabs {
appReload appReload
, asyncTasksRef , asyncTasksRef
...@@ -272,14 +320,20 @@ annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayou ...@@ -272,14 +320,20 @@ annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayou
, treeReloadRef , treeReloadRef
} }
] ]
where where
onUpdateHyperdata :: HyperdataUser -> Effect Unit onUpdateHyperdata :: GUR.ReloadS -> HyperdataUser -> Effect Unit
onUpdateHyperdata _ = pure unit onUpdateHyperdata reload hd = do
launchAff_ $ do
_ <- saveContactHyperdata session nodeId hd
liftEffect $ GUR.bump reload
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do 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 -- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id --defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of --case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
......
...@@ -122,7 +122,7 @@ listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props [] ...@@ -122,7 +122,7 @@ listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []
, treeReloadRef } _ = do , treeReloadRef } _ = do
let path = { nodeId, session } let path = { nodeId, session }
cacheState <- R.useState' $ getCacheState CacheOff session nodeId cacheState <- R.useState' $ getCacheState CacheOn session nodeId
useLoader path loadCorpusWithChild $ useLoader path loadCorpusWithChild $
\corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } -> \corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } ->
......
...@@ -58,9 +58,8 @@ instance encodeJsonSearchResult :: Argonaut.EncodeJson SearchResult where ...@@ -58,9 +58,8 @@ instance encodeJsonSearchResult :: Argonaut.EncodeJson SearchResult where
------------------------------------------------------------------------ ------------------------------------------------------------------------
data SearchResultTypes = data SearchResultTypes = SearchResultDoc { docs :: Array Document}
SearchResultDoc { docs :: Array Document} | SearchNoResult { message :: String }
| SearchNoResult { message :: String }
| SearchResultContact { contacts :: Array Contact } | SearchResultContact { contacts :: Array Contact }
derive instance eqSearchResultTypes :: Eq SearchResultTypes derive instance eqSearchResultTypes :: Eq SearchResultTypes
...@@ -132,6 +131,7 @@ data Contact = ...@@ -132,6 +131,7 @@ data Contact =
, c_created :: String , c_created :: String
, c_hyperdata :: HyperdataRowContact , c_hyperdata :: HyperdataRowContact
, c_score :: Int , c_score :: Int
, c_annuaireId :: Int
} }
derive instance eqContact :: Eq Contact derive instance eqContact :: Eq Contact
......
...@@ -14,7 +14,7 @@ thisModule = "Gargantext.Components.Tab" ...@@ -14,7 +14,7 @@ thisModule = "Gargantext.Components.Tab"
type TabsProps = ( type TabsProps = (
selected :: Int selected :: Int
, tabs :: Array (Tuple String R.Element) , tabs :: Array (Tuple String R.Element)
) )
tabs :: Record TabsProps -> R.Element tabs :: Record TabsProps -> R.Element
...@@ -29,17 +29,23 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt ...@@ -29,17 +29,23 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
pure $ pure $
H.div {} H.div {}
[ H.nav {} [ H.nav {}
[ H.div { className: "nav nav-tabs" [ H.br {}
, title : "Tab for ngrams" , H.div { className: "nav nav-tabs"
} , title : "Search result"
(mapWithIndex (button setActiveTab activeTab) props.tabs) ] } [H.text "" ]
, H.div { className: "tab-content" } $ mapWithIndex (item activeTab) props.tabs ] -- (mapWithIndex (button setActiveTab activeTab) props.tabs)
]
, H.div { className: "tab-content" }
$ mapWithIndex (item activeTab) props.tabs
]
{-
button setActiveTab selected index (name /\ _) = button setActiveTab selected index (name /\ _) =
H.a { className, on: { click } } [ H.text name ] H.a { className, on: { click } } [ H.text name ]
where where
eq = index == selected eq = index == selected
className = "nav-item nav-link" <> (if eq then " active" else "") className = "nav-item nav-link" <> (if eq then " active" else "")
click e = setActiveTab (const index) click e = setActiveTab (const index)
-}
item selected index (_ /\ cpt') = tab { selected, index } [ cpt' ] item selected index (_ /\ cpt') = tab { selected, index } [ cpt' ]
-- TODO: document what these are (selection, item indices) -- TODO: document what these are (selection, item indices)
......
...@@ -222,6 +222,7 @@ sessionPath (R.ChartHash { chartType, listId, tabType } i) = ...@@ -222,6 +222,7 @@ sessionPath (R.ChartHash { chartType, listId, tabType } i) =
<> defaultListAddMaybe listId <> defaultListAddMaybe listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i -- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
------- misc routing stuff ------- misc routing stuff
defaultList :: Int -> String defaultList :: Int -> String
......
...@@ -5,39 +5,36 @@ import Prelude ...@@ -5,39 +5,36 @@ import Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.Types (ChartOpts, ChartType, CorpusMetricOpts, CTabNgramType, Id, Limit, 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) Offset, OrderBy, SearchOpts, SessionId, TabSubType, TabType, TermList)
import Gargantext.Types as GT import Gargantext.Types as GT
data AppRoute data AppRoute
= Annuaire SessionId Int = Annuaire SessionId Int
| ContactPage SessionId Int Int | ContactPage SessionId Int Int
| Corpus SessionId Int | Corpus SessionId Int
| CorpusDocument SessionId Int Int Int | CorpusDocument SessionId Int Int Int
| Dashboard SessionId Int | Dashboard SessionId Int
| Document SessionId Int Int | Document SessionId Int Int
| Folder SessionId Int | Folder SessionId Int
| FolderPrivate SessionId Int | FolderPrivate SessionId Int
| FolderPublic SessionId Int | FolderPublic SessionId Int
| FolderShared SessionId Int | FolderShared SessionId Int
| Home | Home
| Lists SessionId Int | Lists SessionId Int
| Login | Login
| PGraphExplorer SessionId Int | PGraphExplorer SessionId Int
| RouteFile SessionId Int | RouteFile SessionId Int
| RouteFrameCalc SessionId Int | RouteFrameCalc SessionId Int
| RouteFrameCode SessionId Int | RouteFrameCode SessionId Int
| RouteFrameWrite SessionId Int | RouteFrameWrite SessionId Int
| Team SessionId Int | Team SessionId Int
| Texts SessionId Int | Texts SessionId Int
| UserPage SessionId Int | UserPage SessionId Int
derive instance eqAppRoute :: Eq AppRoute derive instance eqAppRoute :: Eq AppRoute
type AnnuaireId = Int
type ContactId = Int
data SessionRoute data SessionRoute
= Tab TabType (Maybe Id) = Tab TabType (Maybe Id)
| Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id) | Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
...@@ -53,12 +50,13 @@ data SessionRoute ...@@ -53,12 +50,13 @@ data SessionRoute
| TreeFirstLevel (Maybe Id) String | TreeFirstLevel (Maybe Id) String
| GraphAPI Id String | GraphAPI Id String
| ListsRoute ListId | ListsRoute ListId
| ListDocument (Maybe ListId) (Maybe Id) | ListDocument (Maybe ListId) (Maybe DocId)
| Search SearchOpts (Maybe Id) | Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id) | CorpusMetrics CorpusMetricOpts (Maybe Id)
| CorpusMetricsHash { listId :: ListId, tabType :: TabType } (Maybe Id) | CorpusMetricsHash { listId :: ListId, tabType :: TabType } (Maybe Id)
| Chart ChartOpts (Maybe Id) | Chart ChartOpts (Maybe Id)
| ChartHash { chartType :: ChartType, listId :: Maybe ListId, tabType :: TabType } (Maybe Id) | ChartHash { chartType :: ChartType, listId :: Maybe ListId, tabType :: TabType } (Maybe Id)
-- | AnnuaireContact AnnuaireId DocId
instance showAppRoute :: Show AppRoute where instance showAppRoute :: Show AppRoute where
show Home = "Home" show Home = "Home"
......
...@@ -333,8 +333,11 @@ nodeTypePath (NodePublic nt) = nodeTypePath nt ...@@ -333,8 +333,11 @@ nodeTypePath (NodePublic nt) = nodeTypePath nt
nodeTypePath NodeFile = "file" nodeTypePath NodeFile = "file"
------------------------------------------------------------ ------------------------------------------------------------
type CorpusId = Int
type ListId = Int type DocId = Int
type ListId = Int
type AnnuaireId = Int
type ContactId = Int
data ScoreType = Occurrences 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