Commit e7d216fa authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-tree-reload

parents 2a74df72 66c58ed7
......@@ -362,6 +362,7 @@ body > .tree ul > li:first-child::before {
li .leaf {
display: flex;
flex-direction: row;
color: #005a9aff;
}
li .leaf .folder-icon {
padding: 0 2 0 2;
......@@ -474,7 +475,6 @@ li .leaf:hover a.settings {
margin-top: 1px;
}
.tree .node.node-type-valid .text {
color: blue;
text-decoration: underline;
}
......@@ -533,7 +533,9 @@ li .leaf:hover a.settings {
}
.code-editor-heading {
display: flex;
/* .buttons-right */
/* display: flex */
/* justify-content: flex-end */
}
.code-editor-heading .renameable {
flex-grow: 2;
......@@ -541,20 +543,7 @@ li .leaf:hover a.settings {
.code-editor-heading .renameable .text {
padding-right: 10px;
}
.code-editor-heading .buttons-right {
display: flex;
justify-content: flex-end;
}
.code-editor .toolbar {
display: flex;
justify-content: flex-start;
width: 100%;
}
.code-editor .editor {
display: flex;
width: 100%;
}
.code-editor .editor .code-area {
flex-grow: 1;
max-height: 200px;
......@@ -690,6 +679,9 @@ li .leaf:hover a.settings {
top: 50%;
}
.table tr td {
color: #005a9aff;
}
.table tr td .active {
font-weight: bold;
text-decoration: underline;
......@@ -716,6 +708,10 @@ li .leaf:hover a.settings {
margin: 10px;
}
.body ul li {
color: #005a9aff;
}
.range {
width: 400px;
/* some space for the right knob */
......
{"version":3,"sourceRoot":"","sources":["../../src/sass/_menu.sass","../../src/sass/_context_menu.sass","../../src/sass/_graph.sass","../../src/sass/_login.sass","../../src/sass/_tree.sass","../../src/sass/_code_editor.sass","../../src/sass/_styles.sass","../../src/sass/_range_slider.sass"],"names":[],"mappings":"AAAA;AAEA;AACA;AACA;AACA;AACA;AAEA;EACI;EACA;;;AAEJ;EACI;EACA;EACA;EACA;;;AAEJ;EACE;;;AAEF;AACI;EACA;;;AAEJ;AACI;EACA;;;AAGJ;AACA;EACI;;;AAEJ;EACI;EACA;EACA;EACA;;;AAEJ;EACE;EACA;;;AAEF;EACE;;;AC7CF;EACE;EACA;EACA;EACA;EACA;;;AAEF;EACE;;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;;;AAEF;EACE;EACA;EACA;;;AAEF;EACE;;;AClBF;EACE;EACA;EACA;;;AAEF;AAkCE;AACA;AACA;AACA;AACA;AACA;AACA;AACA;;AAxCA;EAZA;EACA;EAEA;EAWE;EACA;EACA;EACA;;AAEA;EACE;EACA;;AAEF;EACE;EACA;;AAGA;EACE;EACA;;AACN;EACE;;AACF;EACE;;AAEF;EApCA;EACA;EAEA;EAmCE;EACA;;AACF;EACE;;AACF;EACE;;AAWF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;;AAEJ;EACE;;AAEA;EACE;;AAEJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;EACA;EACA;;;ACpFJ;EACE;;;AAOF;EACE;;AACA;EACE;EACA;;;AAEJ;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAGF;EACE;;AAEE;EACE;EACA;;AACA;EACE;;;AAIJ;EACE;EACA;EACA;EACA;;;AAKJ;EACE;EACA;EACA;;;AAGJ;EACE;EACA;EACA;EACA;EACA;;AACA;EACE;EACA;;AACF;EACE;EACA;;AACA;EACE;EACA;EACA;EACA;;AACA;EACE;;AACF;EACE;EACA;EACA;EACA;;AACA;EACE;;AACN;EACE;EACA;EACA;EACA;;;AAGN;EACE;EACA;EACA;EACA;EACA;;AAGE;EACE;;;AAEN;EACE;EACA;EACA;EACA;EACA;;AAGE;EACE;;;AAEN;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;EACA;EACA;;;AAEJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;EACA;;AACA;EACE;EACA;;;AAGF;EACE;;;AAEJ;EACI;EACA;;;AAGF;EACE;;;AAEJ;EACE;;;AAEF;EACE;EACA;;;AAEF;EACE;EACA;EACA;;;AAEF;EACE;EACA;;;AAEF;EACE;;;ACvKF;EACE;;;AAGA;EACE;EACA;;AAEA;EACE;EACA;;AAEF;EACE;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;;;AAER;EACE;;AAEE;EACE;;AACA;EACE;EACA;EACA;EACA;;AACF;EACE;EACA;EACA;EACA;EACA;;AACF;EACE;;AACF;EACE;EACA;EACA;EAEA;EACA;EACA;;AAEA;EACE;;AACF;EACE;;AAGN;EACE;;AACF;EACE;;AACA;EACE;EACA;;AAEE;EACE;EACA;;AACF;EACE;EACA;;AAIR;EACE;;AACF;EACE;;AACA;EACE;EACA;;AAEE;EACE;EACA;;AACF;EACE;EACA;;AACF;EACE;EACA;;AAEV;EACE;;AACF;EACE;;AAEE;EACE;;AACF;EACE;;AACN;EACE;;AAEE;EACE;EACA;;;AAGR;EACE;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EAEE;EACA;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;;AAEF;EACE;;;AAIF;EACE;;AAEA;EACE;;;AAGN;EACE;;AACF;EACE;;AACF;EACE;;;AC7IJ;EACE;;AAEA;EACE;;AACA;EACE;;AACJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;;AACF;EACE;EACA;;AACA;EACE;EACA;EACA;EACA;;AACA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EArDR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AA2DM;EACE;EACA;EACA;EACA;EACA;EA7DR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAmEE;EACE;EACA;EACA;EACA;EACA;EACA;;AACF;EACE;EACA;EACA;;AACA;EACE;EACA;;AACF;EACE;EACA;;AACF;EACE;EACA;;AAGE;EACE;;AAEF;EACE;;;ACtGV;EACE;;AACF;EACE;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;;AAGE;EACE;EACA;;AAEF;EACE;EACA;;;AAEV;EACE;;AACA;EACE;EACA;EACA;;;AAKE;EACE;EACA;;AACF;EACE;;AACA;EACE;;AACJ;EACE;;;AAER;EACE;;;AAEF;EACE;;;AAEF;EACE;;;ACjDF;EACE;AACA;EACA;;AAEA;EACE;EACA;;AAEA;EACE;EACA;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EAEA;EAEA;EAEA;;AAEA;EACE;EAEA;EACA;EACA;;;AAGN;EACE","file":"sass.css"}
\ No newline at end of file
{"version":3,"sourceRoot":"","sources":["../../src/sass/_menu.sass","../../src/sass/_context_menu.sass","../../src/sass/_graph.sass","../../src/sass/_login.sass","../../src/sass/_tree.sass","../../src/sass/_code_editor.sass","../../src/sass/_styles.sass","../../src/sass/_range_slider.sass"],"names":[],"mappings":"AAAA;AAEA;AACA;AACA;AACA;AACA;AAEA;EACI;EACA;;;AAEJ;EACI;EACA;EACA;EACA;;;AAEJ;EACE;;;AAEF;AACI;EACA;;;AAEJ;AACI;EACA;;;AAGJ;AACA;EACI;;;AAEJ;EACI;EACA;EACA;EACA;;;AAEJ;EACE;EACA;;;AAEF;EACE;;;AC7CF;EACE;EACA;EACA;EACA;EACA;;;AAEF;EACE;;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;;;AAEF;EACE;EACA;EACA;;;AAEF;EACE;;;AClBF;EACE;EACA;EACA;;;AAEF;AAkCE;AACA;AACA;AACA;AACA;AACA;AACA;AACA;;AAxCA;EAZA;EACA;EAEA;EAWE;EACA;EACA;EACA;;AAEA;EACE;EACA;;AAEF;EACE;EACA;;AAGA;EACE;EACA;;AACN;EACE;;AACF;EACE;;AAEF;EApCA;EACA;EAEA;EAmCE;EACA;;AACF;EACE;;AACF;EACE;;AAWF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;;AAEJ;EACE;;AAEA;EACE;;AAEJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;EACA;EACA;;;ACpFJ;EACE;;;AAOF;EACE;;AACA;EACE;EACA;;;AAEJ;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAGF;EACE;;AAEE;EACE;EACA;;AACA;EACE;;;AAIJ;EACE;EACA;EACA;EACA;;;AAKJ;EACE;EACA;EACA;;;AAGJ;EACE;EACA;EACA;EACA;EACA;;AACA;EACE;EACA;;AACF;EACE;EACA;;AACA;EACE;EACA;EACA;EACA;;AACA;EACE;;AACF;EACE;EACA;EACA;EACA;;AACA;EACE;;AACN;EACE;EACA;EACA;EACA;;;AAGN;EACE;EACA;EACA;EACA;EACA;;AAGE;EACE;;;AAEN;EACE;EACA;EACA;EACA;EACA;;AAGE;EACE;;;AAEN;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;EACA;EACA;;;AAEJ;EACE;EACA;;;AAGF;EACE;EACA;EACA;EACA;;AACA;EACE;EACA;;;AAGF;EACE;;;AAEJ;EACI;EACA;;;AAGF;EACE;;;AAEJ;EACE;;;AAEF;EACE;EACA;;;AAEF;EACE;EACA;EACA;;;AAEF;EACE;EACA;;;AAEF;EACE;;;ACvKF;EACE;;;AAGA;EACE;EACA;EACA;;AAEA;EACE;EACA;;AAEF;EACE;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;;;AAER;EACE;;AAEE;EACE;;AACA;EACE;EACA;EACA;EACA;;AACF;EACE;EACA;EACA;EACA;EACA;;AACF;EACE;;AACF;EACE;EACA;EACA;EAEA;EACA;EACA;;AAEA;EACE;;AACF;EACE;;AAGN;EACE;;AACF;EACE;;AACA;EACE;EACA;;AAEE;EACE;EACA;;AACF;EACE;EACA;;AAIR;EACE;;AACF;EACE;;AACA;EACE;EACA;;AAEE;EACE;EACA;;AACF;EACE;EACA;;AACF;EACE;EACA;;AAEV;EACE;;AACF;EACE;;AAEE;EACE;;AACF;EACE;;AACN;EACE;;AAEE;EACE;;;AAGR;EACE;EACA;EACA;EACA;EACA;EACA;;AAEA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAEA;EAEE;EACA;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;;AAEF;EACE;;;AAIF;EACE;;AAEA;EACE;;;AAGN;EACE;;AACF;EACE;;AACF;EACE;;;AC7IJ;AAKE;AACA;AACA;;AANA;EACE;;AACA;EACE;;;AAOF;EACE;EACA;EACA;EACA;;AACA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EA7CR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AAmDM;EACE;EACA;EACA;EACA;EACA;EArDR;EACA;EACA;EACA;EACA;EACA;EACA;EAlBA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;EACA;;AA2DE;EACE;EACA;EACA;EACA;EACA;EACA;;AACF;EACE;EACA;EACA;;AACA;EACE;EACA;;AACF;EACE;EACA;;AACF;EACE;EACA;;AAGE;EACE;;AAEF;EACE;;;AC9FV;EACE;;AACF;EACE;EACA;EACA;EACA;EACA;EACA;;AACA;EACE;;AAGE;EACE;EACA;;AAEF;EACE;EACA;;;AAEV;EACE;;AACA;EACE;EACA;EACA;;;AAIA;EACE;;AACA;EACE;EACA;;AACF;EACE;;AACA;EACE;;AACJ;EACE;;;AAER;EACE;;;AAEF;EACE;;;AAEF;EACE;;;AAIE;EACE;;;ACvDN;EACE;AACA;EACA;;AAEA;EACE;EACA;;AAEA;EACE;EACA;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;EACA;;AAEF;EACE;EACA;EACA;EACA;EACA;EACA;EACA;EAEA;EAEA;EAEA;;AAEA;EACE;EAEA;EACA;EACA;;;AAGN;EACE","file":"sass.css"}
\ No newline at end of file
{
"name": "Gargantext",
"version": "0.0.2.5",
"version": "0.0.2.6",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......
......@@ -123,7 +123,7 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
documentMainLayout { listId, mCorpusId: Just corpusId, nodeId, session } []
]
Dashboard sid nodeId -> withSession sid $ \session -> forested [
dashboardLayout { nodeId, session }
dashboardLayout { nodeId, session } []
]
Document sid listId nodeId ->
withSession sid $
......
......@@ -117,15 +117,14 @@ codeEditorCpt = R.hooksComponentWithModule thisModule "codeEditor" cpt
setCodeOverlay controls code'
renderHtml code' controls
pure $ H.div { className: "code-editor" } [
toolbar {controls, onChange}
, H.div { className: "row error" } [
errorComponent {error: controls.error}
]
, H.div { className: "row editor" } [
H.div { className: "code-area " <> (codeHidden $ fst controls.viewType) } [
H.div { className: "code-container" } [
H.textarea { defaultValue: code
pure $ H.div { className: "code-editor" }
[ toolbar {controls, onChange}
, H.div { className: "row error" }
[ errorComponent {error: controls.error} ]
, H.div { className: "row editor" }
[ H.div { className: "code-area " <> (codeHidden $ fst controls.viewType) }
[ H.div { className: "code-container" }
[ H.textarea { defaultValue: code
, on: { change: onEditChange controls onChange }
, placeholder: "Type some code..."
, ref: controls.codeElRef } [ ]
......@@ -208,12 +207,15 @@ toolbarCpt = R.hooksComponentWithModule thisModule "toolbar" cpt
where
cpt props@{controls: {codeType, error, viewType}} _ = do
pure $
H.div { className: "row toolbar" } [
codeTypeSelector {
H.div { className: "row toolbar" }
[ H.div { className: "col-2" }
[ codeTypeSelector {
codeType
, onChange: onChangeCodeType props
}
, viewTypeSelector {state: viewType}
]
, H.div { className: "col-1" }
[ viewTypeSelector {state: viewType} ]
]
-- Handle rerendering of preview when viewType changed
......
......@@ -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 []
......@@ -117,11 +137,14 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
[ chart
, H.div { className: "col-md-12" }
[ pageLayout { deletions, frontends, totalRecords, container, session, path } ]
, H.div { className: "col-md-12" }
{- , H.div { className: "col-md-12" }
[ H.button { style: buttonStyle, on: { click: trashClick deletions } }
[ H.i { className: "glyphitem fa fa-trash"
, style: { marginRight : "9px" }} []
, H.text "Delete document!" ] ] ] ]
, H.text "Delete document!" ]
]
-} ]
]
where
buttonStyle =
{ backgroundColor: "peru", padding: "9px", color: "white"
......@@ -187,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
......@@ -203,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
......@@ -235,36 +258,27 @@ 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 =
DocumentsView { id: 1
, date: "2020-01-01"
, date: ""
, title : "SearchNoResult"
, source: "Source"
, source: ""
, score: 1
, authors: "Authors"
, authors: ""
, category: decodeCategory 1
, pairs: []
, delete: false
......@@ -273,9 +287,6 @@ err2view message =
, publication_day: 1
}
type PageLayoutProps =
( frontends :: Frontends
, totalRecords :: Int
......@@ -285,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
......@@ -295,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 []
......@@ -304,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
......@@ -312,44 +323,75 @@ pageCpt = R.hooksComponentWithModule thisModule "page" cpt
where
setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
params = (fst path).params /\ setParams
colNames = T.ColumnName <$> [ "", "Date", "Title", "Source", "Authors", "Delete" ]
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
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 ]
-- , maybeStricken delete [ H.text authors ]
-- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
, H.input { defaultChecked: isChecked id
{-, H.input { defaultChecked: isChecked id
, on: { click: toggleClick }
, type: "checkbox"
}
-}
]
, delete: true }
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 }
......
......@@ -132,6 +132,7 @@ settingsBox Team =
, NodeFrameCalc
, NodeFrameNotebook
, Team
, FolderShared
]
, Share
, Delete
......
......@@ -252,10 +252,10 @@ sigmaSettings =
, font: "arial" -- font params
, fontStyle: "bold"
, hideEdgesOnMove: true
--, labelSize : "proportional" -- alt : proportional, fixed
, labelSize: "fixed"
, labelSizeRatio: 2.0 -- label size in ratio of node size
, labelThreshold: 7.0 -- min node cam size to start showing label
, labelSize : "proportional" -- alt : proportional, fixed
-- , labelSize: "fixed"
, labelSizeRatio: 3.0 -- label size in ratio of node size
, labelThreshold: 6.0 -- min node cam size to start showing label
, maxEdgeSize: 1.0
, maxNodeSize: 8.0
, minEdgeSize: 0.5 -- in fact used in tina as edge size
......
......@@ -70,7 +70,7 @@ sidebar props = R.createElement sidebarCpt props []
sideTabNav :: R.State SidePanelState -> Array SideTab -> R.Element
sideTabNav (sidePanel /\ setSidePanel) sideTabs =
R.fragment [ H.div { className: "text-primary center"} [H.text "SideTab"]
R.fragment [ H.div { className: "text-primary center"} [H.text ""]
, H.div {className: "nav nav-tabs"} (liItem <$> sideTabs)
-- , H.div {className: "center"} [ H.text "Doc sideTabs"]
]
......@@ -133,36 +133,46 @@ sideTab _ _ = H.div {} []
-------------------------------------------
-- TODO
-- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element
selectedNodes props nodesMap = R2.row [ R2.col 12
[ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist"}
selectedNodes props nodesMap =
R2.row [ R2.col 12
[ RH.ul { className: "nav nav-tabs d-flex justify-content-center"
, id: "myTab"
, role: "tablist" }
[ RH.div { className: "tab-content" }
[ RH.div { className: "", role: "tabpanel" }
[ RH.div { className: "d-flex flex-wrap justify-content-center"
, role: "tabpanel" }
( Seq.toUnfoldable
$ ( Seq.map (badge props.selectedNodeIds)
(badges props.graph props.selectedNodeIds)
)
)
, H.br {}
]
, RH.div { className: "tab-content flex-space-between" }
[ removeButton "Move as candidate" CandidateTerm props nodesMap
, removeButton "Move as stop" StopTerm props nodesMap
]
, 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" }
[ 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)
$ neighbourBadges props.graph props.selectedNodeIds
)
]
removeButton text rType props' nodesMap' =
removeButton btnType text rType props' nodesMap' =
if Set.isEmpty $ fst props'.selectedNodeIds then
RH.div {} []
else
RH.button { className: "btn btn-info"
RH.button { className: "btn btn-sm btn-" <> btnType
, on: { click: onClickRemove rType props' nodesMap' }
}
[ RH.text text ]
......@@ -332,6 +342,3 @@ Global/local view:
To explore the neighborhood of a selection click on the 'change level' button.
-}
......@@ -28,6 +28,7 @@ type Props = (
state :: R.State Boolean
, onMessage :: String
, offMessage :: String
, style :: String
, onClick :: forall e. e -> Effect Unit
)
......@@ -37,10 +38,10 @@ toggleButton props = R.createElement toggleButtonCpt props []
toggleButtonCpt :: R.Component Props
toggleButtonCpt = R.hooksComponentWithModule thisModule "toggleButton" cpt
where
cpt {state, onMessage, offMessage, onClick} _ = do
cpt {state, onMessage, offMessage, onClick, style} _ = do
let (toggled /\ _) = state
pure $ H.button { className: "btn btn-outline-light " <> cls toggled
pure $ H.button { className: "btn btn-outline-" <> style <> " " <> cls toggled
, on: {click: onClick}
} [ R2.small {} [ H.text (text onMessage offMessage toggled) ] ]
......@@ -56,6 +57,7 @@ controlsToggleButton state =
, onMessage: "Hide Controls"
, offMessage: "Show Controls"
, onClick: \_ -> snd state not
, style: "light"
}
type EdgesButtonProps = (
......@@ -69,14 +71,14 @@ edgesToggleButtonCpt :: R.Component EdgesButtonProps
edgesToggleButtonCpt = R.hooksComponentWithModule thisModule "edgesToggleButton" cpt
where
cpt {state: (state /\ setState)} _ = do
pure $ H.button { className: "btn btn-outline-light " <> cls state
pure $ H.button { className: "btn btn-outline-primary " <> cls state
, on: { click: onClick setState }
} [ R2.small {} [ H.text (text state) ] ]
text s = if SigmaxTypes.edgeStateHidden s then "Show edges" else "Hide edges"
cls SigmaxTypes.EShow = "active"
cls _ = ""
cls SigmaxTypes.EShow = ""
cls _ = "active"
-- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges
onClick setState _ = setState SigmaxTypes.toggleShowEdgesState
......@@ -88,6 +90,7 @@ louvainToggleButton state =
, onMessage: "Louvain off"
, offMessage: "Louvain on"
, onClick: \_ -> snd state not
, style: "primary"
}
multiSelectEnabledButton :: R.State Boolean -> R.Element
......@@ -97,6 +100,7 @@ multiSelectEnabledButton state =
, onMessage: "Single-node"
, offMessage: "Multi-node"
, onClick: \_ -> snd state not
, style : "primary"
}
type ForceAtlasProps = (
......@@ -110,7 +114,7 @@ pauseForceAtlasButtonCpt :: R.Component ForceAtlasProps
pauseForceAtlasButtonCpt = R.hooksComponentWithModule thisModule "forceAtlasToggleButton" cpt
where
cpt {state: (state /\ setState)} _ = do
pure $ H.button { className: "btn btn-outline-light " <> cls state
pure $ H.button { className: "btn btn-outline-primary " <> cls state
, on: { click: onClick setState }
} [ R2.small {} [ H.text (text state) ] ]
......@@ -132,6 +136,7 @@ treeToggleButton state =
, onMessage: "Hide Tree"
, offMessage: "Show Tree"
, onClick: \_ -> snd state not
, style: "light"
}
sidebarToggleButton :: R.State GET.SidePanelState -> R.Element
......
......@@ -42,7 +42,10 @@ inputWithEnter props = R.createElement inputWithEnterCpt props []
where
onInput e = do
if autoSave then
onValueChanged $ R.unsafeEventValue e
else
pure unit
onKeyPress e = do
char <- R2.keyCode e
......
......@@ -14,22 +14,19 @@ import Data.Lens.Index (ix)
import Data.Lens.Record (prop)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), isNothing, maybe)
import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
import Data.Monoid.Additive (Additive(..))
import Data.Ord.Down (Down(..))
import Data.Sequence (Seq, length) as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Effect.Aff (Aff)
import Reactix (Component, Element, Ref, State, createElement, fragment, hooksComponentWithModule, unsafeEventValue, useState') as R
import Reactix.DOM.HTML as H
import Record as Record
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
......@@ -37,12 +34,12 @@ import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T
import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Version, Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncResetButtons, toVersioned)
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
......@@ -50,40 +47,17 @@ import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Seq (mapMaybe) as Seq
import Gargantext.Utils.Seq as Seq
thisModule :: String
thisModule = "Gargantext.Components.NgramsTable"
type State' =
CoreState
( ngramsParent :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
, ngramsChildren :: Map NgramsTerm Boolean
-- ^ Used only when grouping.
-- This updates the children of `ngramsParent`,
-- ngrams set to `true` are to be added, and `false` to
-- be removed.
, ngramsSelection :: Set NgramsTerm
-- ^ The set of selected checkboxes of the first column.
)
_ngramsChildren :: forall row. Lens' { ngramsChildren :: Map NgramsTerm Boolean | row } (Map NgramsTerm Boolean)
_ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")
_ngramsSelection :: forall row. Lens' { ngramsSelection :: Set NgramsTerm | row } (Set NgramsTerm)
_ngramsSelection = prop (SProxy :: SProxy "ngramsSelection")
initialState' :: VersionedNgramsTable -> State'
initialState' (Versioned {version}) =
{ ngramsChildren: mempty
, ngramsLocalPatch: mempty
, ngramsParent: Nothing
, ngramsSelection: mempty
, ngramsStagePatch: mempty
, ngramsValidPatch: mempty
, ngramsVersion: version
}
type State =
CoreState (
ngramsChildren :: Map NgramsTerm Boolean
......@@ -290,21 +264,25 @@ type CommonProps = (
)
type Props = (
path :: R.State PageParams
cacheState :: NT.CacheState
, mTotalRows :: Maybe Int
, path :: R.State PageParams
, state :: R.State State
, versioned :: VersionedNgramsTable
| CommonProps
)
loadedNgramsTable :: Record Props -> R.Element
loadedNgramsTable p = R.createElement loadedNgramsTableCpt p []
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" cpt
loadedNgramsTable :: R2.Component Props
loadedNgramsTable = R.createElement loadedNgramsTableCpt
where
cpt { afterSync
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" cpt
cpt props@{ afterSync
, appReload
, asyncTasksRef
, cacheState
, mTotalRows
, path: path@(path'@{ listIds, nodeId, params, searchQuery, scoreType, termListFilter, termSizeFilter } /\ setPath)
, sidePanelTriggers
, state: (state@{ ngramsChildren
......@@ -325,19 +303,19 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
]
, search ]
<>
[ T.table { syncResetButton: [ syncResetButton ]
, colNames
[ T.table { colNames
, container: tableContainer { dispatch: performAction
, ngramsChildren
, ngramsParent
, ngramsSelection
, ngramsTable
, path
, tabNgramType
, syncResetButton: [ syncResetButton ]
, tabNgramType
}
, params: params /\ setParams -- TODO-LENS
, params: paramsS -- TODO-LENS
, rows: filteredConvertedRows
, syncResetButton: [ syncResetButton ]
, totalRecords
, wrapColElts: wrapColElts { allNgramsSelected
, dispatch: performAction
......@@ -347,13 +325,16 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
, syncResetButton ]
where
afterSync = chartsAfterSync path' asyncTasksRef nodeId treeReloadRef
afterSync' _ = do
chartsAfterSync path' asyncTasksRef nodeId treeReloadRef unit
afterSync unit
performAction = mkDispatch { filteredRows, path: path', state: state /\ setState }
syncResetButton = syncResetButtons { afterSync
syncResetButton = syncResetButtons { afterSync: afterSync'
, ngramsLocalPatch
, performAction: performAction <<< CoreAction }
autoUpdate :: Array R.Element
autoUpdate = if withAutoUpdate then
[ R2.buff
......@@ -361,49 +342,17 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
{ duration: 5000
, effect: performAction
$ CoreAction
$ Synchronize { afterSync }
$ Synchronize { afterSync: afterSync' }
}
]
else []
setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }
performAction :: Action -> Effect Unit
performAction (SetParentResetChildren p) =
setState $ setParentResetChildren p
performAction (ToggleChild b c) =
setState $ \s@{ ngramsChildren: nc } -> s { ngramsChildren = newNC nc }
where
newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
performAction (ToggleSelect c) =
setState $ \s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }
performAction ToggleSelectAll =
setState toggler
where
toggler s =
if allNgramsSelected then
s { ngramsSelection = Set.empty :: Set NgramsTerm }
else
s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
performAction AddTermChildren =
case ngramsParent of
Nothing ->
-- impossible but harmless
pure unit
Just parent -> do
let pc = patchSetFromMap ngramsChildren
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch parent pe
setState $ setParentResetChildren Nothing
commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
performAction (CoreAction a) = coreDispatch path' (state /\ setState) a
totalRecords = Seq.length rows
totalRecords = fromMaybe (Seq.length rows) mTotalRows
filteredConvertedRows :: T.Rows
filteredConvertedRows = convertRow <$> filteredRows
filteredRows :: PreConversionRows
filteredRows = T.filterRows { params } rows
-- no need to filter offset if cache is off
filteredRows = if cacheState == NT.CacheOn then T.filterRows { params } rows else rows
ng_scores :: Map NgramsTerm (Additive Int)
ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
rows :: PreConversionRows
......@@ -461,13 +410,66 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
wrapColElts _ (T.ColumnName "Score") = (_ <> [H.text ("(" <> show scoreType <> ")")])
wrapColElts _ _ = identity
setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
paramsS = params /\ setParams
search :: R.Element
search = NTC.searchInput { key: "search-input"
, onSearch: setSearchQuery
, searchQuery: searchQuery }
setSearchQuery :: String -> Effect Unit
setSearchQuery x = setPath $ _ { searchQuery = x }
setSearchQuery x = do
setPath $ _ { searchQuery = x }
T.changePage 1 paramsS
type MkDispatchProps = (
filteredRows :: PreConversionRows
, path :: PageParams
, state :: R.State State
)
mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
mkDispatch { filteredRows
, path
, state: (state@{ ngramsChildren
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsVersion } /\ setState) } = performAction
where
allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }
performAction :: Action -> Effect Unit
performAction (SetParentResetChildren p) =
setState $ setParentResetChildren p
performAction (ToggleChild b c) =
setState $ \s@{ ngramsChildren: nc } -> s { ngramsChildren = newNC nc }
where
newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
performAction (ToggleSelect c) =
setState $ \s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }
performAction ToggleSelectAll =
setState toggler
where
toggler s =
if allNgramsSelected then
s { ngramsSelection = Set.empty :: Set NgramsTerm }
else
s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
performAction AddTermChildren =
case ngramsParent of
Nothing ->
-- impossible but harmless
pure unit
Just parent -> do
let pc = patchSetFromMap ngramsChildren
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch parent pe
setState $ setParentResetChildren Nothing
commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
performAction (CoreAction a) = coreDispatch path (state /\ setState) a
displayRow :: State -> SearchQuery -> NgramsTable -> Maybe NgramsTerm -> Maybe TermList -> Maybe TermSize -> NgramsElement -> Boolean
......@@ -520,12 +522,12 @@ type MainNgramsTableProps = (
| CommonProps
)
mainNgramsTable :: Record MainNgramsTableProps -> R.Element
mainNgramsTable props = R.createElement mainNgramsTableCpt props []
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt
where
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
cpt props@{ afterSync
, appReload
, asyncTasksRef
......@@ -547,12 +549,13 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
let render versioned = mainNgramsTablePaint { afterSync
, appReload
, asyncTasksRef
, cacheState: fst cacheState
, path: fst pathS
, sidePanelTriggers
, tabNgramType
, treeReloadRef
, versioned
, withAutoUpdate }
, withAutoUpdate } []
useLoaderWithCacheAPI {
cacheEndpoint: versionEndpoint props
, handleResponse
......@@ -562,22 +565,24 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
}
(NT.CacheOff /\ _) -> do
-- pathS <- R.useState' path
let render versioned = mainNgramsTablePaintNoCache { afterSync
let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
, appReload
, asyncTasksRef
, cacheState: fst cacheState
, pathS
, sidePanelTriggers
, tabNgramType
, treeReloadRef
, versioned
, withAutoUpdate }
, versionedWithCount
, withAutoUpdate } []
useLoader (fst pathS) loader render
-- NOTE With cache on
versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version
versionEndpoint { defaultListId, nodeId, session, tabType } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
-- NOTE With cache off
loader :: PageParams -> Aff VersionedNgramsTable
loader :: PageParams -> Aff VersionedWithCountNgramsTable
loader path@{ listIds
, nodeId
, params: { limit, offset, orderBy }
......@@ -618,20 +623,22 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
handleResponse v = v
type MainNgramsTablePaintProps = (
path :: PageParams
cacheState :: NT.CacheState
, path :: PageParams
, versioned :: VersionedNgramsTable
| CommonProps
)
mainNgramsTablePaint :: Record MainNgramsTablePaintProps -> R.Element
mainNgramsTablePaint p = R.createElement mainNgramsTablePaintCpt p []
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaint" cpt
mainNgramsTablePaint :: R2.Component MainNgramsTablePaintProps
mainNgramsTablePaint = R.createElement mainNgramsTablePaintCpt
where
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaint" cpt
cpt props@{ afterSync
, appReload
, asyncTasksRef
, cacheState
, path
, sidePanelTriggers
, tabNgramType
......@@ -643,6 +650,8 @@ mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTable
pure $ loadedNgramsTable { afterSync
, appReload
, asyncTasksRef
, cacheState
, mTotalRows: Nothing
, path: pathS
, sidePanelTriggers
, state
......@@ -650,35 +659,41 @@ mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTable
, treeReloadRef
, versioned
, withAutoUpdate
}
} []
type MainNgramsTablePaintNoCacheProps =
( pathS :: R.State PageParams
, versioned :: VersionedNgramsTable
type MainNgramsTablePaintNoCacheProps = (
cacheState :: NT.CacheState
, pathS :: R.State PageParams
, versionedWithCount :: VersionedWithCountNgramsTable
| CommonProps
)
mainNgramsTablePaintNoCache :: Record MainNgramsTablePaintNoCacheProps -> R.Element
mainNgramsTablePaintNoCache p = R.createElement mainNgramsTablePaintNoCacheCpt p []
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCacheCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaintNoCache" cpt
mainNgramsTablePaintNoCache :: R2.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCache = R.createElement mainNgramsTablePaintNoCacheCpt
where
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCacheCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaintNoCache" cpt
cpt props@{ afterSync
, appReload
, asyncTasksRef
, cacheState
, pathS
, sidePanelTriggers
, tabNgramType
, treeReloadRef
, versioned
, versionedWithCount
, withAutoUpdate } _ = do
let count /\ versioned = toVersioned versionedWithCount
state <- R.useState' $ initialState versioned
pure $ loadedNgramsTable {
afterSync
, appReload
, asyncTasksRef
, cacheState
, mTotalRows: Just count
, path: pathS
, sidePanelTriggers
, state
......@@ -686,35 +701,7 @@ mainNgramsTablePaintNoCacheCpt = R.hooksComponentWithModule thisModule "mainNgra
, treeReloadRef
, versioned
, withAutoUpdate
}
-- type MainNgramsTablePaintWithStateProps = (
-- afterSync :: Unit -> Aff Unit
-- , asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
-- , path :: R.State PageParams
-- , tabNgramType :: CTabNgramType
-- , versioned :: VersionedNgramsTable
-- , withAutoUpdate :: Boolean
-- )
-- mainNgramsTablePaintWithState :: Record MainNgramsTablePaintWithStateProps -> R.Element
-- mainNgramsTablePaintWithState p = R.createElement mainNgramsTablePaintWithStateCpt p []
-- mainNgramsTablePaintWithStateCpt :: R.Component MainNgramsTablePaintWithStateProps
-- mainNgramsTablePaintWithStateCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaintWithState" cpt
-- where
-- cpt { afterSync, asyncTasksRef, path, tabNgramType, versioned, withAutoUpdate } _ = do
-- state <- R.useState' $ initialState versioned
-- pure $ loadedNgramsTable {
-- afterSync
-- , asyncTasksRef
-- , path
-- , state
-- , tabNgramType
-- , versioned
-- , withAutoUpdate
-- }
} []
type NgramsOcc = { occurrences :: Additive Int, children :: Set NgramsTerm }
......
......@@ -18,9 +18,13 @@ module Gargantext.Components.NgramsTable.Core
, findNgramTermList
, Version
, Versioned(..)
, Count
, VersionedWithCount(..)
, toVersioned
, VersionedNgramsPatches
, AsyncNgramsChartsUpdate
, VersionedNgramsTable
, VersionedWithCountNgramsTable
, NgramsTablePatch
, NgramsPatch(..)
, CoreState
......@@ -164,6 +168,32 @@ instance decodeJsonVersioned :: DecodeJson a => DecodeJson (Versioned a) where
version <- obj .: "version"
data_ <- obj .: "data"
pure $ Versioned {version, data: data_}
------------------------------------------------------------------------
type Count = Int
newtype VersionedWithCount a = VersionedWithCount
{ version :: Version
, count :: Count
, data :: a
}
instance encodeJsonVersionedWithCount :: EncodeJson a => EncodeJson (VersionedWithCount a) where
encodeJson (VersionedWithCount {count, version, data: data_})
= "version" := version
~> "count" := count
~> "data" := data_
~> jsonEmptyObject
instance decodeJsonVersionedWithCount :: DecodeJson a => DecodeJson (VersionedWithCount a) where
decodeJson json = do
obj <- decodeJson json
count <- obj .: "count"
data_ <- obj .: "data"
version <- obj .: "version"
pure $ VersionedWithCount {count, version, data: data_}
toVersioned :: forall a. VersionedWithCount a -> Tuple Count (Versioned a)
toVersioned (VersionedWithCount { count, data: d, version }) = Tuple count $ Versioned { data: d, version }
------------------------------------------------------------------------
-- TODO replace by NgramsPatches directly
......@@ -535,6 +565,7 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
-----------------------------------------------------------------------------------
type VersionedNgramsTable = Versioned NgramsTable
type VersionedWithCountNgramsTable = VersionedWithCount NgramsTable
-----------------------------------------------------------------------------------
data Replace a
......
......@@ -104,8 +104,7 @@ annuaireCpt = R.hooksComponentWithModule thisModule "annuaire" cpt
, title: name
, user: "" }
, H.p {} []
, H.div {className: "col-md-3"}
[ H.text " Filter ", H.input { className: "form-control", style } ]
-- , H.div {className: "col-md-3"} [ H.text " Filter ", H.input { className: "form-control", style } ]
, H.br {}
, pageLayout { info, session, pagePath, frontends} ]
where
......@@ -164,7 +163,7 @@ pageCpt = R.hooksComponentWithModule thisModule "page" cpt
, session }
, delete: false }) <$> Seq.fromFoldable docs
container = T.defaultContainer { title: "Annuaire" } -- TODO
colNames = T.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Lab", "Role"]
colNames = T.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Role"]
wrapColElts = const identity
setParams f = snd pagePath $ \pp@{params: ps} ->
pp {params = f ps}
......@@ -199,10 +198,12 @@ contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt
]
cpt { annuaireId
, contact: (CT.NodeContact { id
, hyperdata: ( CT.HyperdataContact { who : Just (CT.ContactWho { firstName
, hyperdata: ( CT.HyperdataContact
{ who : Just (CT.ContactWho { firstName
, lastName
}
)
, ou : ou
}
)
}
......@@ -212,13 +213,12 @@ contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt
pure $ T.makeRow [
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 "CNRS"
-- , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
--, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
--, H.text $ maybe "No ContactWhere" contactWhereOrg (A.head $ ou)
-- , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
, H.text $ maybe "No ContactWhere" contactWhereOrg (A.head $ ou)
, H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
-- , H.div {className: "nooverflow"} [
-- H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
]
......@@ -226,6 +226,7 @@ contactCellsCpt = R.hooksComponentWithModule thisModule "contactCells" cpt
--nodepath = NodePath (sessionId session) NodeContact (Just id)
nodepath = Routes.ContactPage (sessionId session) annuaireId id
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: orga }) =
......
......@@ -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
......
......@@ -21,6 +21,7 @@ import Gargantext.Components.Nodes.Texts.Types as TTypes
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), NodeID, PTabNgramType(..), TabType(..), TabSubType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
thisModule :: String
......@@ -80,9 +81,9 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
where
tabs' trg =
[ "Documents" /\ docs trg
, "Patents" /\ ngramsView patentsView
, "Books" /\ ngramsView booksView
, "Communication" /\ ngramsView commView
, "Patents" /\ ngramsView patentsView []
, "Books" /\ ngramsView booksView []
, "Communication" /\ ngramsView commView []
, "Trash" /\ docs trg -- TODO pass-in trash mode
]
where
......@@ -141,12 +142,12 @@ type NgramsViewTabsProps = (
, treeReloadRef :: GUR.ReloadWithInitializeRef
)
ngramsView :: Record NgramsViewTabsProps -> R.Element
ngramsView props = R.createElement ngramsViewCpt props []
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
ngramsView :: R2.Component NgramsViewTabsProps
ngramsView = R.createElement ngramsViewCpt
where
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
cpt { appReload
, asyncTasksRef
, cacheState
......@@ -172,7 +173,7 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
, tabNgramType
, treeReloadRef
, withAutoUpdate: false
}
} []
where
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode
......@@ -21,7 +21,8 @@ import Gargantext.Prelude
import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, FTField, Field(..), FieldType(..), Hash, Hyperdata(..), defaultField, defaultHaskell', defaultPython', defaultJSON', defaultMarkdown')
import Gargantext.Components.Nodes.Types
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
......@@ -46,10 +47,10 @@ type KeyProps =
corpusLayout :: Record Props -> R.Element
corpusLayout props = R.createElement corpusLayoutCpt props []
corpusLayoutCpt :: R.Component Props
corpusLayoutCpt = R.hooksComponentWithModule thisModule "corpusLayout" cpt
where
corpusLayoutCpt :: R.Component Props
corpusLayoutCpt = R.hooksComponentWithModule thisModule "corpusLayout" cpt
cpt { nodeId, session } _ = do
let sid = sessionId session
......@@ -58,10 +59,10 @@ corpusLayoutCpt = R.hooksComponentWithModule thisModule "corpusLayout" cpt
corpusLayoutWithKey :: Record KeyProps -> R.Element
corpusLayoutWithKey props = R.createElement corpusLayoutWithKeyCpt props []
corpusLayoutWithKeyCpt :: R.Component KeyProps
corpusLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "corpusLayoutWithKey" cpt
where
corpusLayoutWithKeyCpt :: R.Component KeyProps
corpusLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "corpusLayoutWithKey" cpt
cpt { nodeId, session } _ = do
reload <- GUR.new
......@@ -74,18 +75,12 @@ type ViewProps =
| Props
)
-- We need FTFields with indices because it's the only way to identify the
-- FTField element inside a component (there are no UUIDs and such)
type Index = Int
type FTFieldWithIndex = Tuple Index FTField
type FTFieldsWithIndex = List.List FTFieldWithIndex
corpusLayoutView :: Record ViewProps -> R.Element
corpusLayoutView props = R.createElement corpusLayoutViewCpt props []
corpusLayoutViewCpt :: R.Component ViewProps
corpusLayoutViewCpt = R.hooksComponentWithModule thisModule "corpusLayoutView" cpt
where
corpusLayoutViewCpt :: R.Component ViewProps
corpusLayoutViewCpt = R.hooksComponentWithModule thisModule "corpusLayoutView" cpt
cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields}}), nodeId, reload, session} _ = do
let fieldsWithIndex = List.mapWithIndex (\idx -> \t -> Tuple idx t) fields
fieldsS <- R.useState' fieldsWithIndex
......@@ -99,22 +94,23 @@ corpusLayoutViewCpt = R.hooksComponentWithModule thisModule "corpusLayoutView" c
R.setRef fieldsRef fields
snd fieldsS $ const fieldsWithIndex
pure $ H.div {} [
H.div { className: "row" } [
H.div { className: "btn btn-secondary " <> (saveEnabled fieldsWithIndex fieldsS)
pure $ H.div {}
[ H.div { className: "row" }
[ H.div { className: "btn btn-secondary " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave {fields: fieldsS, nodeId, reload, session} }
} [
H.span { className: "fa fa-floppy-o" } [ ]
}
[ H.span { className: "fa fa-floppy-o" } [ ]
]
]
, H.div {} [ fieldsCodeEditor { fields: fieldsS
, H.div {}
[ fieldsCodeEditor { fields: fieldsS
, nodeId
, session } ]
, H.div { className: "row" } [
H.div { className: "btn btn-secondary"
, H.div { className: "row" }
[ H.div { className: "btn btn-secondary"
, on: { click: onClickAdd fieldsS }
} [
H.span { className: "fa fa-plus" } [ ]
}
[ H.span { className: "fa fa-plus" } [ ]
]
]
]
......@@ -127,7 +123,6 @@ corpusLayoutViewCpt = R.hooksComponentWithModule thisModule "corpusLayoutView" c
, reload :: GUR.ReloadS
, session :: Session } -> e -> Effect Unit
onClickSave {fields: (fieldsS /\ _), nodeId, reload, session} _ = do
log2 "[corpusLayoutViewCpt] onClickSave fieldsS" fieldsS
launchAff_ do
saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fieldsS}
, nodeId
......@@ -146,10 +141,10 @@ type FieldsCodeEditorProps =
fieldsCodeEditor :: Record FieldsCodeEditorProps -> R.Element
fieldsCodeEditor props = R.createElement fieldsCodeEditorCpt props []
fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
fieldsCodeEditorCpt = R.hooksComponentWithModule thisModule "fieldsCodeEditorCpt" cpt
where
fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
fieldsCodeEditorCpt = R.hooksComponentWithModule thisModule "fieldsCodeEditorCpt" cpt
cpt {nodeId, fields: fS@(fields /\ _), session} _ = do
masterKey <- R.useState' 0
......@@ -215,27 +210,25 @@ type FieldCodeEditorProps =
fieldCodeEditorWrapper :: Record FieldCodeEditorProps -> R.Element
fieldCodeEditorWrapper props = R.createElement fieldCodeEditorWrapperCpt props []
fieldCodeEditorWrapperCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorWrapperCpt = R.hooksComponentWithModule thisModule "fieldCodeEditorWrapperCpt" cpt
where
fieldCodeEditorWrapperCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorWrapperCpt = R.hooksComponentWithModule thisModule "fieldCodeEditorWrapperCpt" cpt
cpt props@{canMoveDown, canMoveUp, field: Field {name, typ}, onMoveDown, onMoveUp, onRemove, onRename} _ = do
pure $ H.div { className: "row card" } [
H.div { className: "card-header" } [
H.div { className: "code-editor-heading row" } [
H.div { className: "col-sm-4" } [
H.div { className: "col-4" } [
renameable {onRename, text: name}
]
, H.div { className: "col-sm-7" } []
, H.div { className: "buttons-right col-sm-1" } [
, H.div { className: "col-7" } []
, H.div { className: "buttons-right col-1" } ([
H.div { className: "btn btn-danger"
, on: { click: \_ -> onRemove unit }
} [
H.span { className: "fa fa-trash" } [ ]
]
, moveDownButton canMoveDown
, moveUpButton canMoveUp
]
] <> moveButtons)
]
]
, H.div { className: "card-body" } [
......@@ -243,15 +236,15 @@ fieldCodeEditorWrapperCpt = R.hooksComponentWithModule thisModule "fieldCodeEdit
]
]
where
moveDownButton false = H.div {} []
moveDownButton true =
moveButtons = [] <> (if canMoveDown then [moveDownButton] else [])
<> (if canMoveUp then [moveUpButton] else [])
moveDownButton =
H.div { className: "btn btn-secondary"
, on: { click: \_ -> onMoveDown unit }
} [
H.span { className: "fa fa-arrow-down" } [ ]
]
moveUpButton false = H.div {} []
moveUpButton true =
moveUpButton =
H.div { className: "btn btn-secondary"
, on: { click: \_ -> onMoveUp unit }
} [
......@@ -266,10 +259,10 @@ type RenameableProps =
renameable :: Record RenameableProps -> R.Element
renameable props = R.createElement renameableCpt props []
renameableCpt :: R.Component RenameableProps
renameableCpt = R.hooksComponentWithModule thisModule "renameableCpt" cpt
where
renameableCpt :: R.Component RenameableProps
renameableCpt = R.hooksComponentWithModule thisModule "renameableCpt" cpt
cpt {onRename, text} _ = do
isEditing <- R.useState' false
state <- R.useState' text
......@@ -296,24 +289,24 @@ type RenameableTextProps =
renameableText :: Record RenameableTextProps -> R.Element
renameableText props = R.createElement renameableTextCpt props []
renameableTextCpt :: R.Component RenameableTextProps
renameableTextCpt = R.hooksComponentWithModule thisModule "renameableTextCpt" cpt
where
renameableTextCpt :: R.Component RenameableTextProps
renameableTextCpt = R.hooksComponentWithModule thisModule "renameableTextCpt" cpt
cpt {isEditing: (false /\ setIsEditing), state: (text /\ _)} _ = do
pure $ H.div { className: "input-group" } [
H.input { className: "form-control"
pure $ H.div { className: "input-group" }
[ H.input { className: "form-control"
, defaultValue: text
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
, on: { click: \_ -> setIsEditing $ const true } } [
H.span { className: "fa fa-pencil" } []
, on: { click: \_ -> setIsEditing $ const true } }
[ H.span { className: "fa fa-pencil" } []
]
]
cpt {isEditing: (true /\ setIsEditing), onRename, state: (text /\ setText)} _ = do
pure $ H.div { className: "input-group" } [
inputWithEnter {
pure $ H.div { className: "input-group" }
[ inputWithEnter {
autoFocus: false
, autoSave: false
, className: "form-control text"
......@@ -324,8 +317,8 @@ renameableTextCpt = R.hooksComponentWithModule thisModule "renameableTextCpt" cp
, type: "text"
}
, H.div { className: "btn input-group-append"
, on: { click: submit } } [
H.span { className: "fa fa-floppy-o" } []
, on: { click: submit } }
[ H.span { className: "fa fa-floppy-o" } []
]
]
where
......@@ -335,10 +328,10 @@ renameableTextCpt = R.hooksComponentWithModule thisModule "renameableTextCpt" cp
fieldCodeEditor :: Record FieldCodeEditorProps -> R.Element
fieldCodeEditor props = R.createElement fieldCodeEditorCpt props []
fieldCodeEditorCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorCpt = R.hooksComponentWithModule thisModule "fieldCodeEditorCpt" cpt
where
fieldCodeEditorCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorCpt = R.hooksComponentWithModule thisModule "fieldCodeEditorCpt" cpt
cpt {field: Field {typ: typ@(Haskell {haskell})}, onChange} _ = do
pure $ CE.codeEditor {code: haskell, defaultCodeType: CE.Haskell, onChange: changeCode onChange typ}
......
......@@ -2,8 +2,9 @@ module Gargantext.Components.Nodes.Corpus.Dashboard where
import DOM.Simple.Console (log2)
import Data.Array as A
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
......@@ -11,8 +12,10 @@ import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Nodes.Corpus (fieldsCodeEditor)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Components.Nodes.Types
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Sessions (Session, sessionId)
......@@ -20,6 +23,7 @@ import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Corpus.Dashboard"
type Props =
......@@ -27,42 +31,42 @@ type Props =
, session :: Session
)
dashboardLayout :: Record Props -> R.Element
dashboardLayout props = R.createElement dashboardLayoutCpt props []
dashboardLayoutCpt :: R.Component Props
dashboardLayoutCpt = R.hooksComponentWithModule thisModule "dashboardLayout" cpt
dashboardLayout :: R2.Component Props
dashboardLayout = R.createElement dashboardLayoutCpt
where
dashboardLayoutCpt :: R.Component Props
dashboardLayoutCpt = R.hooksComponentWithModule thisModule "dashboardLayout" cpt
cpt { nodeId, session } _ = do
let sid = sessionId session
pure $ dashboardLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session }
pure $ dashboardLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session } []
type KeyProps = (
key :: String
| Props
)
dashboardLayoutWithKey :: Record KeyProps -> R.Element
dashboardLayoutWithKey props = R.createElement dashboardLayoutWithKeyCpt props []
dashboardLayoutWithKeyCpt :: R.Component KeyProps
dashboardLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "dashboardLayoutWithKey" cpt
dashboardLayoutWithKey :: R2.Component KeyProps
dashboardLayoutWithKey = R.createElement dashboardLayoutWithKeyCpt
where
dashboardLayoutWithKeyCpt :: R.Component KeyProps
dashboardLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "dashboardLayoutWithKey" cpt
cpt { nodeId, session } _ = do
reload <- GUR.new
useLoader {nodeId, reload: GUR.value reload, session} DT.loadDashboardWithReload $
\dashboardData@{hyperdata: DT.Hyperdata h, parentId} -> do
let { charts } = h
let { charts, fields } = h
dashboardLayoutLoaded { charts
, corpusId: parentId
, defaultListId: 0
, fields
, key: show $ GUR.value reload
, nodeId
, onChange: onChange nodeId reload (DT.Hyperdata h)
, session }
, session } []
where
onChange :: NodeID -> GUR.ReloadS -> DT.Hyperdata -> Array P.PredefinedChart -> Effect Unit
onChange nodeId' reload (DT.Hyperdata h) charts = do
......@@ -76,38 +80,69 @@ type LoadedProps =
( charts :: Array P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, fields :: List.List FTField
, key :: String
, onChange :: Array P.PredefinedChart -> Effect Unit
| Props
)
dashboardLayoutLoaded :: Record LoadedProps -> R.Element
dashboardLayoutLoaded props = R.createElement dashboardLayoutLoadedCpt props []
dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = R.hooksComponentWithModule thisModule "dashboardLayoutLoaded" cpt
dashboardLayoutLoaded :: R2.Component LoadedProps
dashboardLayoutLoaded = R.createElement dashboardLayoutLoadedCpt
where
cpt props@{ charts, corpusId, defaultListId, onChange, session } _ = do
pure $
H.div {} ([ H.h1 {} [ H.text "Board" ]
dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = R.hooksComponentWithModule thisModule "dashboardLayoutLoaded" cpt
cpt props@{ charts, corpusId, defaultListId, fields, nodeId, onChange, session } _ = do
let fieldsWithIndex = List.mapWithIndex (\idx -> \t -> Tuple idx t) fields
fieldsS <- R.useState' fieldsWithIndex
fieldsRef <- R.useRef fields
-- handle props change of fields
R.useEffect1' fields $ do
if R.readRef fieldsRef == fields then
pure unit
else do
R.setRef fieldsRef fields
snd fieldsS $ const fieldsWithIndex
pure $ H.div {}
[ H.div { className: "row" }
[ H.div { className: "col-12" }
([ H.h1 {} [ H.text "Board" ]
, H.p {} [ H.text "Summary of all your charts here" ]
] <> chartsEls <> [addNew])
]
, H.div { className: "row" }
[ H.div { className: "col-12" }
[ fieldsCodeEditor { fields: fieldsS
, nodeId
, session } ]
]
, H.div { className: "row" }
[ H.div { className: "btn btn-secondary"
, on: { click: onClickAddField fieldsS }
}
[ H.span { className: "fa fa-plus" } [ ]
]
]
]
where
addNew = H.div { className: "row" } [
H.span { className: "btn btn-secondary"
, on: { click: onClickAdd }} [ H.span { className: "fa fa-plus" } [] ]
, on: { click: onClickAddChart }} [ H.span { className: "fa fa-plus" } [] ]
]
where
onClickAdd _ = onChange $ A.cons P.CDocsHistogram charts
onClickAddChart _ = onChange $ A.cons P.CDocsHistogram charts
chartsEls = A.mapWithIndex chartIdx charts
chartIdx idx chart =
renderChart { chart, corpusId, defaultListId, onChange: onChangeChart, onRemove, session }
renderChart { chart, corpusId, defaultListId, onChange: onChangeChart, onRemove, session } []
where
onChangeChart c = do
log2 "[dashboardLayout] idx" idx
log2 "[dashboardLayout] new chart" c
onChange $ fromMaybe charts (A.modifyAt idx (\_ -> c) charts)
onRemove _ = onChange $ fromMaybe charts $ A.deleteAt idx charts
onClickAddField :: forall e. R.State FTFieldsWithIndex -> e -> Effect Unit
onClickAddField (_ /\ setFieldsS) _ = do
setFieldsS $ \fieldsS -> List.snoc fieldsS $ Tuple (List.length fieldsS) defaultField
type PredefinedChartProps =
( chart :: P.PredefinedChart
......@@ -118,14 +153,15 @@ type PredefinedChartProps =
, session :: Session
)
renderChart :: Record PredefinedChartProps -> R.Element
renderChart props = R.createElement renderChartCpt props []
renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt = R.hooksComponentWithModule thisModule "renderChart" cpt
renderChart :: R2.Component PredefinedChartProps
renderChart = R.createElement renderChartCpt
where
renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt = R.hooksComponentWithModule thisModule "renderChart" cpt
cpt { chart, corpusId, defaultListId, onChange, onRemove, session } _ = do
pure $ H.div { className: "chart" }
pure $ H.div { className: "row chart card" }
[ H.div { className: "card-header" }
[ H.div { className: "row" }
[ H.div { className: "col-2" }
[ R2.select { defaultValue: show chart
......@@ -137,11 +173,14 @@ renderChartCpt = R.hooksComponentWithModule thisModule "renderChart" cpt
, on: { click: onRemoveClick }} [ H.span { className: "fa fa-trash" } [] ]
]
]
, H.div { className: "row" }
]
, H.div { className: "card-body" }
[ H.div { className: "row" }
[ H.div { className: "col-12 chart" }
[ P.render chart params ]
]
]
]
where
option pc =
H.option { value: show pc } [ H.text $ show pc ]
......
module Gargantext.Components.Nodes.Corpus.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.List as List
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Gargantext.Components.Node (NodePoly)
import Gargantext.Prelude
type Author = String
type Description = String
type Query = String
type Tag = String
type Title = String
type HaskellCode = String
type MarkdownText = String
type Hash = String
import Gargantext.Components.Nodes.Types (FTField, Field(..), FieldType(..), isJSON)
import Gargantext.Prelude (bind, pure, ($))
newtype Hyperdata =
Hyperdata { fields :: List.List FTField }
......@@ -35,182 +22,6 @@ instance encodeHyperdata :: EncodeJson Hyperdata where
"fields" := fields
~> jsonEmptyObject
newtype Field a =
Field { name :: String
, typ :: a
}
type FTField = Field FieldType
derive instance genericFTField :: Generic (Field FieldType) _
instance eqFTField :: Eq (Field FieldType) where
eq = genericEq
instance showFTField :: Show (Field FieldType) where
show = genericShow
data FieldType =
Haskell { haskell :: HaskellCode
, tag :: Tag
}
| Python { python :: HaskellCode
, tag :: Tag
}
| JSON { authors :: Author
, desc :: Description
, query :: Query
, tag :: Tag
, title :: Title
}
| Markdown { tag :: Tag
, text :: MarkdownText
}
isJSON :: FTField -> Boolean
isJSON (Field {typ}) = isJSON' typ
where
isJSON' (JSON _) = true
isJSON' _ = false
getCorpusInfo :: List.List FTField -> CorpusInfo
getCorpusInfo as = case List.head (List.filter isJSON as) of
Just (Field {typ: JSON {authors, desc, query, title}}) -> CorpusInfo { title
, desc
, query
, authors
, totalRecords: 0
}
_ -> CorpusInfo { title:"Empty"
, desc:""
, query:""
, authors:""
, totalRecords: 0
}
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
eq = genericEq
instance showFieldType :: Show FieldType where
show = genericShow
instance decodeFTField :: DecodeJson (Field FieldType) where
decodeJson json = do
obj <- decodeJson json
name <- obj .: "name"
type_ <- obj .: "type"
data_ <- obj .: "data"
typ <- case type_ of
"Haskell" -> do
haskell <- data_ .: "haskell"
tag <- data_ .: "tag"
pure $ Haskell {haskell, tag}
"Python" -> do
python <- data_ .: "python"
tag <- data_ .: "tag"
pure $ Python {python, tag}
"JSON" -> do
authors <- data_ .: "authors"
desc <- data_ .: "desc"
query <- data_ .: "query"
tag <- data_ .: "tag"
title <- data_ .: "title"
pure $ JSON {authors, desc, query, tag, title}
"Markdown" -> do
tag <- data_ .: "tag"
text <- data_ .: "text"
pure $ Markdown {tag, text}
_ -> Left $ TypeMismatch $ "Unsupported 'type' " <> type_
pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where
encodeJson (Field {name, typ}) =
"data" := typ
~> "name" := name
~> "type" := typ' typ
~> jsonEmptyObject
where
typ' (Haskell _) = "Haskell"
typ' (Python _) = "Python"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {haskell}) =
"haskell" := haskell
~> "tag" := "HaskellField"
~> jsonEmptyObject
encodeJson (Python {python}) =
"python" := python
~> "tag" := "PythonField"
~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) =
"authors" := authors
~> "desc" := desc
~> "query" := query
~> "tag" := "JsonField"
~> "title" := title
~> jsonEmptyObject
encodeJson (Markdown {text}) =
"tag" := "MarkdownField"
~> "text" := text
~> jsonEmptyObject
defaultPython :: FieldType
defaultPython = Python defaultPython'
defaultPython' :: { python :: String, tag :: String }
defaultPython' = { python: "import Foo"
, tag : "PythonField"
}
defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' :: { haskell :: String, tag :: String }
defaultHaskell' = { haskell: ""
, tag : "HaskellField"
}
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' :: { authors :: String
, desc :: String
, query :: String
, tag :: String
, title :: String
}
defaultJSON' = { authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' :: { tag :: String
, text :: String
}
defaultMarkdown' = { tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField
defaultField = Field { name: "New file"
, typ: defaultMarkdown
}
newtype CorpusInfo =
CorpusInfo { title :: String
, authors :: String
......@@ -232,3 +43,18 @@ instance decodeCorpusInfo :: DecodeJson CorpusInfo where
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly Hyperdata -- CorpusInfo
, defaultListId :: Int }
getCorpusInfo :: List.List FTField -> CorpusInfo
getCorpusInfo as = case List.head (List.filter isJSON as) of
Just (Field {typ: JSON {authors, desc, query, title}}) -> CorpusInfo { title
, desc
, query
, authors
, totalRecords: 0
}
_ -> CorpusInfo { title:"Empty"
, desc:""
, query:""
, authors:""
, totalRecords: 0
}
module Gargantext.Components.Nodes.Dashboard.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject)
import Data.List as List
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Types (FTField, Field(..), FieldType(..), isJSON)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put)
......@@ -14,17 +17,20 @@ type Preferences = Maybe String
newtype Hyperdata =
Hyperdata
{ charts :: Array P.PredefinedChart
, fields :: List.List FTField
, preferences :: Preferences
}
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
charts <- obj .: "charts"
fields <- obj .: "fields"
preferences <- obj .:? "preferences"
pure $ Hyperdata {charts, preferences}
pure $ Hyperdata {charts, fields, preferences}
instance encodeHyperdata :: EncodeJson Hyperdata where
encodeJson (Hyperdata {charts, preferences}) = do
encodeJson (Hyperdata {charts, fields, preferences}) = do
"charts" := charts
~> "fields" := fields
~> "preferences" := preferences
~> jsonEmptyObject
......
......@@ -84,7 +84,7 @@ homeLayoutCpt = R.hooksComponentWithModule thisModule "homeLayout" cpt
}
]
, H.div {className:"center"}
, H.div {className:"col-12 d-flex justify-content-center"}
[ H.h1 {} [ -- H.span {className: "fa fa-star-o"} []
H.text ""
]
......@@ -281,7 +281,7 @@ homeLayoutCpt = R.hooksComponentWithModule thisModule "homeLayout" cpt
--}
video fileDuration = H.div {className:"center"}
video fileDuration = H.div {className:"col-12 d-flex justify-content-center"}
[ H.video { src: "http://dl.gargantext.org/" <> fileDuration
, title: "tutorial video here"
, id: "source_" <> fileDuration
......@@ -292,7 +292,7 @@ homeLayoutCpt = R.hooksComponentWithModule thisModule "homeLayout" cpt
} [H.text "Sorry your browser is not compatible: use Firefox or Chromium instead."]
]
joinButton = H.div { className:"flex-space-around center"
joinButton = H.div { className:"flex-space-around d-flex justify-content-center"
, paddingTop: "100px"
, paddingBottom: "100px"
}
......
......@@ -35,10 +35,10 @@ type ListsWithForest = (
listsWithForest :: R2.Component ListsWithForest
listsWithForest = R.createElement listsWithForestCpt
listsWithForestCpt :: R.Component ListsWithForest
listsWithForestCpt = R.hooksComponentWithModule thisModule "listsWithForest" cpt
where
listsWithForestCpt :: R.Component ListsWithForest
listsWithForestCpt = R.hooksComponentWithModule thisModule "listsWithForest" cpt
cpt { forestProps
, listsProps: listsProps@{ session } } _ = do
controls <- initialControls
......@@ -58,10 +58,10 @@ type TopBarProps = (
topBar :: R2.Component TopBarProps
topBar = R.createElement topBarCpt
topBarCpt :: R.Component TopBarProps
topBarCpt = R.hooksComponentWithModule thisModule "topBar" cpt
where
topBarCpt :: R.Component TopBarProps
topBarCpt = R.hooksComponentWithModule thisModule "topBar" cpt
cpt { controls } _ = do
-- empty for now because the button is moved to the side panel
pure $ H.div {} []
......@@ -93,10 +93,10 @@ type WithTreeProps = (
listsLayout :: R2.Component Props
listsLayout = R.createElement listsLayoutCpt
listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponentWithModule thisModule "listsLayout" cpt
where
listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponentWithModule thisModule "listsLayout" cpt
cpt path@{ nodeId, session } _ = do
let sid = sessionId session
......@@ -109,10 +109,10 @@ type KeyProps = (
listsLayoutWithKey :: Record KeyProps -> R.Element
listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt
where
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt
cpt { appReload
, asyncTasksRef
, controls
......@@ -164,10 +164,10 @@ type SidePanelProps = (
sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt
sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = R.hooksComponentWithModule thisModule "sidePanel" cpt
where
sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = R.hooksComponentWithModule thisModule "sidePanel" cpt
cpt { controls: { triggers: { toggleSidePanel
, triggerSidePanel
} }
......@@ -208,10 +208,10 @@ type SidePanelDocView = (
sidePanelDocView :: R2.Component SidePanelDocView
sidePanelDocView = R.createElement sidePanelDocViewCpt
sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = R.hooksComponentWithModule thisModule "sidePanelDocView" cpt
where
sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = R.hooksComponentWithModule thisModule "sidePanelDocView" cpt
cpt { session } _ = do
-- pure $ H.h4 {} [ H.text txt ]
pure $ H.div {} [ H.text "Hello ngrams" ]
......@@ -130,7 +130,7 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
, tabType
, treeReloadRef
, withAutoUpdate: false
}
} []
]
)
where
......@@ -156,7 +156,7 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
charts params CTabTerms (chartType /\ setChartType) _ = [
H.div {className: "row"}
[ H.div {className: "col-6 ml-auto mr-auto"}
[ H.div {className: "col-12 d-flex justify-content-center"}
[ H.img { src: "images/Gargantextuel-212x300.jpg"
, id: "funnyimg"
}
......
module Gargantext.Components.Nodes.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.List as List
import Data.Tuple (Tuple)
import Gargantext.Prelude
type Author = String
type Description = String
type HaskellCode = String
type Hash = String
type MarkdownText = String
type Query = String
type Tag = String
type Title = String
-- We need FTFields with indices because it's the only way to identify the
-- FTField element inside a component (there are no UUIDs and such)
type Index = Int
type FTFieldWithIndex = Tuple Index FTField
type FTFieldsWithIndex = List.List FTFieldWithIndex
newtype Field a =
Field { name :: String
, typ :: a
}
type FTField = Field FieldType
derive instance genericFTField :: Generic (Field FieldType) _
instance eqFTField :: Eq (Field FieldType) where
eq = genericEq
instance showFTField :: Show (Field FieldType) where
show = genericShow
data FieldType =
Haskell { haskell :: HaskellCode
, tag :: Tag
}
| Python { python :: HaskellCode
, tag :: Tag
}
| JSON { authors :: Author
, desc :: Description
, query :: Query
, tag :: Tag
, title :: Title
}
| Markdown { tag :: Tag
, text :: MarkdownText
}
isJSON :: FTField -> Boolean
isJSON (Field {typ}) = isJSON' typ
where
isJSON' (JSON _) = true
isJSON' _ = false
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
eq = genericEq
instance showFieldType :: Show FieldType where
show = genericShow
instance decodeFTField :: DecodeJson (Field FieldType) where
decodeJson json = do
obj <- decodeJson json
name <- obj .: "name"
type_ <- obj .: "type"
data_ <- obj .: "data"
typ <- case type_ of
"Haskell" -> do
haskell <- data_ .: "haskell"
tag <- data_ .: "tag"
pure $ Haskell {haskell, tag}
"Python" -> do
python <- data_ .: "python"
tag <- data_ .: "tag"
pure $ Python {python, tag}
"JSON" -> do
authors <- data_ .: "authors"
desc <- data_ .: "desc"
query <- data_ .: "query"
tag <- data_ .: "tag"
title <- data_ .: "title"
pure $ JSON {authors, desc, query, tag, title}
"Markdown" -> do
tag <- data_ .: "tag"
text <- data_ .: "text"
pure $ Markdown {tag, text}
_ -> Left $ TypeMismatch $ "Unsupported 'type' " <> type_
pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where
encodeJson (Field {name, typ}) =
"data" := typ
~> "name" := name
~> "type" := typ' typ
~> jsonEmptyObject
where
typ' (Haskell _) = "Haskell"
typ' (Python _) = "Python"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {haskell}) =
"haskell" := haskell
~> "tag" := "HaskellField"
~> jsonEmptyObject
encodeJson (Python {python}) =
"python" := python
~> "tag" := "PythonField"
~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) =
"authors" := authors
~> "desc" := desc
~> "query" := query
~> "tag" := "JsonField"
~> "title" := title
~> jsonEmptyObject
encodeJson (Markdown {text}) =
"tag" := "MarkdownField"
~> "text" := text
~> jsonEmptyObject
defaultPython :: FieldType
defaultPython = Python defaultPython'
defaultPython' :: { python :: String, tag :: String }
defaultPython' = { python: "import Foo"
, tag : "PythonField"
}
defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' :: { haskell :: String, tag :: String }
defaultHaskell' = { haskell: ""
, tag : "HaskellField"
}
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' :: { authors :: String
, desc :: String
, query :: String
, tag :: String
, title :: String
}
defaultJSON' = { authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' :: { tag :: String
, text :: String
}
defaultMarkdown' = { tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField
defaultField = Field { name: "New file"
, typ: defaultMarkdown
}
......@@ -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
......
......@@ -29,17 +29,23 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
pure $
H.div {}
[ H.nav {}
[ H.div { className: "nav nav-tabs"
, title : "Tab for ngrams"
}
(mapWithIndex (button setActiveTab activeTab) props.tabs) ]
, H.div { className: "tab-content" } $ mapWithIndex (item activeTab) props.tabs ]
[ H.br {}
, H.div { className: "nav nav-tabs"
, title : "Search result"
} -- [H.text "" ]
(mapWithIndex (button setActiveTab activeTab) props.tabs)
]
, H.div { className: "tab-content" }
$ mapWithIndex (item activeTab) props.tabs
]
--{-
button setActiveTab selected index (name /\ _) =
H.a { className, on: { click } } [ H.text name ]
where
eq = index == selected
className = "nav-item nav-link" <> (if eq then " active" else "")
click e = setActiveTab (const index)
--}
item selected index (_ /\ cpt') = tab { selected, index } [ cpt' ]
-- TODO: document what these are (selection, item indices)
......
module Gargantext.Components.Table where
import Prelude
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Tuple (fst, snd)
import Effect.Aff (Aff, launchAff_)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Gargantext.Sessions (Session, get)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Table.Types
import Gargantext.Prelude
import Gargantext.Components.Table.Types (ColumnName, OrderBy, OrderByDirection(..), Params, Props, TableContainerProps, columnName)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Search
import Gargantext.Components.Search (SearchType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix (effectLink)
thisModule :: String
thisModule = "Gargantext.Components.Table"
type Page = Int
type State =
{ page :: Int
{ page :: Page
, pageSize :: PageSizes
, orderBy :: OrderBy
, searchType :: SearchType
......@@ -60,10 +58,10 @@ initialParams = stateParams {page: 1, pageSize: PS10, orderBy: Nothing, searchTy
tableHeaderLayout :: Record TableHeaderLayoutProps -> R.Element
tableHeaderLayout props = R.createElement tableHeaderLayoutCpt props []
tableHeaderLayoutCpt :: R.Component TableHeaderLayoutProps
tableHeaderLayoutCpt = R.hooksComponentWithModule thisModule "tableHeaderLayout" cpt
where
tableHeaderLayoutCpt :: R.Component TableHeaderLayoutProps
tableHeaderLayoutCpt = R.hooksComponentWithModule thisModule "tableHeaderLayout" cpt
cpt { afterCacheStateChange, cacheState, date, desc, query, title, user } _ =
pure $ R.fragment
[ R2.row
......@@ -117,10 +115,10 @@ tableHeaderLayoutCpt = R.hooksComponentWithModule thisModule "tableHeaderLayout"
table :: Record Props -> R.Element
table props = R.createElement tableCpt props []
tableCpt :: R.Component Props
tableCpt = R.hooksComponentWithModule thisModule "table" cpt
where
tableCpt :: R.Component Props
tableCpt = R.hooksComponentWithModule thisModule "table" cpt
cpt {container, syncResetButton, colNames, wrapColElts, totalRecords, rows, params} _ = do
let
state = paramsState $ fst params
......@@ -196,10 +194,10 @@ type SizeDDProps =
sizeDD :: Record SizeDDProps -> R.Element
sizeDD p = R.createElement sizeDDCpt p []
sizeDDCpt :: R.Component SizeDDProps
sizeDDCpt = R.hooksComponentWithModule thisModule "sizeDD" cpt
where
sizeDDCpt :: R.Component SizeDDProps
sizeDDCpt = R.hooksComponentWithModule thisModule "sizeDD" cpt
cpt {params: params /\ setParams} _ = do
pure $ H.span {} [
R2.select { className, defaultValue: show pageSize, on: {change} } sizes
......@@ -223,8 +221,12 @@ textDescription currPage pageSize totalRecords =
end = if end' > totalRecords then totalRecords else end'
msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords
changePage :: Page -> R.State Params -> Effect Unit
changePage page (_ /\ setParams) =
setParams $ \p -> stateParams $ (paramsState p) { page = page }
pagination :: R.State Params -> Int -> R.Element
pagination (params /\ setParams) tp =
pagination p@(params /\ setParams) tp =
H.span {} $
[ H.text " ", prev, first, ldots]
<>
......@@ -237,7 +239,6 @@ pagination (params /\ setParams) tp =
[ rdots, last, next ]
where
{page} = paramsState params
changePage page = setParams $ \p -> stateParams $ (paramsState p) { page = page }
prev = if page == 1 then
H.text " Prev. "
else
......@@ -269,7 +270,7 @@ pagination (params /\ setParams) tp =
changePageLink i s =
H.span {}
[ H.text " "
, effectLink (changePage i) s
, effectLink (changePage i p) s
, H.text " "
]
......
......@@ -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
......
......@@ -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"
......
......@@ -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
......
// $annotation-candidate-color: #aaa
// $annotation-graph-color: #0f0
// $annotation-stop-color: #f00
// Copied from bootstrap's bg-warning, bg-success, bg-danger:
$annotation-candidate-color: #FF9800
$annotation-graph-color: #43A047
$annotation-stop-color: #E53935
@mixin lg2($color1, $color2)
background-image: linear-gradient(rgba($color1, 0.5), rgba($color1, 0.5)), linear-gradient(rgba($color2, 0.5), rgba($color2, 0.5))
@mixin lg3($color1, $color2, $color3)
background-image: linear-gradient(rgba($color1, 0.34), rgba($color1, 0.34)), linear-gradient(rgba($color2, 0.33), rgba($color2, 0.33)), linear-gradient(rgba($color3, 0.33), rgba($color3, 0.33))
.annotation-run
cursor: pointer
&.candidate-term.graph-term.stop-term
color: #000
@include lg3($annotation-candidate-color, $annotation-graph-color, $annotation-stop-color)
&.candidate-term.graph-term
color: #000
@include lg2($annotation-candidate-color, $annotation-graph-color)
&.candidate-term.stop-term
color: #000
@include lg2($annotation-candidate-color, $annotation-stop-color)
&.graph-term.stop-term
color: #000
@include lg2($annotation-graph-color, $annotation-stop-color)
&.candidate-term
color: #000
background-color: $annotation-candidate-color
&.graph-term
color: #000
background-color: $annotation-graph-color
&.stop-term
color: #000
background-color: $annotation-stop-color
.context-menu
.candidate-term
color: #000
background-color: $annotation-candidate-color
.graph-term
color: #000
background-color: $annotation-graph-color
.stop-term
color: #000
background-color: $annotation-stop-color
......@@ -20,24 +20,16 @@
word-break: keep-all
.code-editor-heading
display: flex
//justify-content: space-between
.renameable
flex-grow: 2
.text
padding-right: 10px
.buttons-right
display: flex
justify-content: flex-end
/* .buttons-right
/* display: flex
/* justify-content: flex-end
.code-editor
.toolbar
display: flex
justify-content: flex-start
width: 100%
.editor
display: flex
width: 100%
.code-area
flex-grow: 1
max-height: 200px
......
......@@ -30,6 +30,7 @@
.table
tr
td
color: #005a9aff
.active
font-weight: bold
text-decoration: underline
......@@ -48,3 +49,8 @@
.search-bar
margin: 10px
.body
ul
li
color: #005a9aff
......@@ -5,6 +5,7 @@ li
.leaf
display: flex
flex-direction: row
color: #005a9aff
.folder-icon
padding: 0 2 0 2
......@@ -105,7 +106,6 @@ li
margin-top: 1px
&.node-type-valid
.text
color: blue
text-decoration: underline
// based on https://codeburst.io/how-to-pure-css-pie-charts-w-css-variables-38287aea161e
......
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