Commit bbd5a4e5 authored by Mudada's avatar Mudada

Merge conflict fixed

parents 7c002be7 ebfcb1c7
...@@ -14,4 +14,41 @@ ...@@ -14,4 +14,41 @@
cursor: wait; cursor: wait;
} }
.progress-pie {
background: rgba(51, 122, 183, 0.1);
border-radius: 100%;
height: calc(var(--size, 14) * 1px);
overflow: hidden;
position: relative;
width: calc(var(--size, 14) * 1px);
}
.progress-pie .progress-pie-segment {
--a: calc(var(--over50, 0) * -100%);
--b: calc((1 + var(--over50, 0)) * 100%);
--degrees: calc((var(--offset, 0) / 100) * 360);
-webkit-clip-path: polygon(var(--a) var(--a), var(--b) var(--a), var(--b) var(--b), var(--a) var(--b));
clip-path: polygon(var(--a) var(--a), var(--b) var(--a), var(--b) var(--b), var(--a) var(--b));
height: 100%;
position: absolute;
transform: translate(0, -50%) rotate(90deg) rotate(calc(var(--degrees) * 1deg));
transform-origin: 50% 100%;
width: 100%;
z-index: calc(1 + var(--over50));
}
.progress-pie .progress-pie-segment:after, .progress-pie .progress-pie-segment:before {
background: var(--bg, #337ab7);
content: "";
height: 100%;
position: absolute;
width: 100%;
}
.progress-pie .progress-pie-segment:before {
--degrees: calc((var(--value, 45) / 100) * 360);
transform: translate(0, 100%) rotate(calc(var(--degrees) * 1deg));
transform-origin: 50% 0%;
}
.progress-pie .progress-pie-segment:after {
opacity: var(--over50, 0);
}
/*# sourceMappingURL=Tree.css.map */ /*# sourceMappingURL=Tree.css.map */
...@@ -9,3 +9,41 @@ ...@@ -9,3 +9,41 @@
cursor: pointer cursor: pointer
&.disabled &.disabled
cursor: wait cursor: wait
// based on https://codeburst.io/how-to-pure-css-pie-charts-w-css-variables-38287aea161e
.progress-pie
background: rgba(51, 122, 183, 0.1)
border-radius: 100%
height: calc(var(--size, 14) * 1px)
overflow: hidden
position: relative
width: calc(var(--size, 14) * 1px)
.progress-pie-segment
--a: calc(var(--over50, 0) * -100%)
--b: calc((1 + var(--over50, 0)) * 100%)
--degrees: calc((var(--offset, 0) / 100) * 360)
-webkit-clip-path: polygon(var(--a) var(--a), var(--b) var(--a), var(--b) var(--b), var(--a) var(--b))
clip-path: polygon(var(--a) var(--a), var(--b) var(--a), var(--b) var(--b), var(--a) var(--b))
height: 100%
position: absolute
transform: translate(0, -50%) rotate(90deg) rotate(calc(var(--degrees) * 1deg))
transform-origin: 50% 100%
width: 100%
z-index: calc(1 + var(--over50))
&:after,
&:before
background: var(--bg, rgb(51, 122, 183))
content: ''
height: 100%
position: absolute
width: 100%
&:before
--degrees: calc((var(--value, 45) / 100) * 360)
transform: translate(0, 100%) rotate(calc(var(--degrees) * 1deg))
transform-origin: 50% 0%
&:after
opacity: var(--over50, 0)
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.1.3.2", "version": "0.0.1.4",
"scripts": { "scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall", "rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall", "rebuild-set": "spago psc-package-insdhall",
......
#Generated by soba https://github.com/justinwoo/soba #Generated by soba https://github.com/justinwoo/soba
{ pkgs ? import ./pinned.nix {} }: { pkgs ? import <nixpkgs> {} }:
{ {
"aff" = pkgs.stdenv.mkDerivation { "aff" = pkgs.stdenv.mkDerivation {
...@@ -834,11 +834,11 @@ ...@@ -834,11 +834,11 @@
"reactix" = pkgs.stdenv.mkDerivation { "reactix" = pkgs.stdenv.mkDerivation {
name = "reactix"; name = "reactix";
version = "v0.4.2"; version = "v0.4.3";
fetched = pkgs.fetchgit { fetched = pkgs.fetchgit {
url = "https://github.com/irresponsible/purescript-reactix"; url = "https://github.com/irresponsible/purescript-reactix";
rev = "62c808db0884edd0651eeff5724d5a81f2dd334e"; rev = "9305a56faeab499b86195ba33067666a625e8dad";
sha256 = "0s9ic8ya6dl3ymbh5axxh7224nd3766m78pz2bgw94fxxgxy7mbc"; sha256 = "0sg80qs7siswqvwfcsggjqvn9viqhxpkr452alyyslx5c3p2xamw";
}; };
}; };
...@@ -862,6 +862,16 @@ ...@@ -862,6 +862,16 @@
}; };
}; };
"record-extra" = pkgs.stdenv.mkDerivation {
name = "record-extra";
version = "v3.0.0";
fetched = pkgs.fetchgit {
url = "https://github.com/justinwoo/purescript-record-extra.git";
rev = "41a837de4168b60790c53d9cb18bc7fb6961bb17";
sha256 = "1zhsgafd02h7161xldnf4z3sfjacp2if8py157igiszkjxaipvdd";
};
};
"refs" = pkgs.stdenv.mkDerivation { "refs" = pkgs.stdenv.mkDerivation {
name = "refs"; name = "refs";
version = "v4.1.0"; version = "v4.1.0";
...@@ -1132,6 +1142,16 @@ ...@@ -1132,6 +1142,16 @@
}; };
}; };
"versions" = pkgs.stdenv.mkDerivation {
name = "versions";
version = "v5.0.1";
fetched = pkgs.fetchgit {
url = "https://github.com/hdgarrood/purescript-versions.git";
rev = "5da24cc63a1fa9a3d09156afa49ad49b3c0fff84";
sha256 = "07h2s3411w9d0iany7arw01qvfj57wgj8pgfqvrm0vvvhhc0v9f6";
};
};
"web-dom" = pkgs.stdenv.mkDerivation { "web-dom" = pkgs.stdenv.mkDerivation {
name = "web-dom"; name = "web-dom";
version = "v3.0.0"; version = "v3.0.0";
......
...@@ -51,6 +51,16 @@ let ...@@ -51,6 +51,16 @@ let
purs compile "src/**/*.purs" \ purs compile "src/**/*.purs" \
${builtins.toString (builtins.map storePath (builtins.attrValues purs-packages))} ${builtins.toString (builtins.map storePath (builtins.attrValues purs-packages))}
''; '';
build = pkgs.writeShellScriptBin "build" ''
#!/usr/bin/env bash
set -e
echo "Compiling"
build-purs-from-store
echo "Bundling"
yarn pulp browserify --skip-compile -t dist/bundle.js --src-path output
'';
in in
pkgs.mkShell { pkgs.mkShell {
buildInputs = [ buildInputs = [
...@@ -60,6 +70,7 @@ pkgs.mkShell { ...@@ -60,6 +70,7 @@ pkgs.mkShell {
install-purs-packages install-purs-packages
build-purs build-purs
build-purs-from-store build-purs-from-store
build
pkgs.yarn pkgs.yarn
]; ];
} }
......
...@@ -7,7 +7,6 @@ import Data.Foldable (intercalate) ...@@ -7,7 +7,6 @@ import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe') import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
......
...@@ -10,6 +10,7 @@ import Data.Generic.Rep.Show (genericShow) ...@@ -10,6 +10,7 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Lens ((^.)) import Data.Lens ((^.))
import Data.Lens.At (at) import Data.Lens.At (at)
import Data.Lens.Record (prop) import Data.Lens.Record (prop)
import Data.List as L
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
...@@ -390,9 +391,13 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where ...@@ -390,9 +391,13 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
cpt { layout: {frontends, session, nodeId, corpusId, listId, totalRecords}, documents, params } _ = do cpt { layout: {frontends, session, nodeId, corpusId, listId, totalRecords}, documents, params } _ = do
localCategories <- R.useState' (mempty :: LocalCategories) localCategories <- R.useState' (mempty :: LocalCategories)
pure $ T.table pure $ T.table
{ rows: rows localCategories { colNames
, container: T.defaultContainer { title: "Documents" } , container: T.defaultContainer { title: "Documents" }
, params, colNames, totalRecords, wrapColElts } , params
, rows: L.fromFoldable $ rows localCategories
, totalRecords
, wrapColElts
}
where where
sid = sessionId session sid = sessionId session
gi Favorite = "glyphicon glyphicon-star" gi Favorite = "glyphicon glyphicon-star"
...@@ -409,7 +414,7 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where ...@@ -409,7 +414,7 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
where where
row (DocumentsView r) = row (DocumentsView r) =
{ row: { row:
[ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ] T.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
caroussel session nodeId setLocalCategories r cat caroussel session nodeId setLocalCategories r cat
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} } --, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
......
...@@ -8,6 +8,7 @@ import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyO ...@@ -8,6 +8,7 @@ import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyO
import Data.Array (concat, filter) import Data.Array (concat, filter)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.List as L
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
...@@ -332,18 +333,19 @@ pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt ...@@ -332,18 +333,19 @@ pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt
documentUrl id = documentUrl id =
url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
comma = H.span {} [ H.text ", " ] comma = H.span {} [ H.text ", " ]
rows = row <$> filter (not <<< isDeleted) documents rows = L.fromFoldable $ row <$> filter (not <<< isDeleted) documents
row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) = row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
{ row: { row:
[ H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ] T.makeRow [
H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, maybeStricken delete [ H.text $ publicationDate dv ] , maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ] , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
, maybeStricken delete [ H.text source ] , maybeStricken delete [ H.text source ]
, maybeStricken delete [ H.text authors ] , maybeStricken delete [ H.text authors ]
-- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs) -- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
, H.input { type: "checkbox", checked: isChecked id, on: { click: toggleClick } } , H.input { type: "checkbox", checked: isChecked id, on: { click: toggleClick } }
] ]
, delete: true } , delete: true }
where where
markClick _ = markCategory session nodeId category [id] markClick _ = markCategory session nodeId category [id]
......
...@@ -24,12 +24,11 @@ import Gargantext.Sessions (OpenNodes, Session, mkNodeId) ...@@ -24,12 +24,11 @@ import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT import Gargantext.Types as GT
type CommonProps = type CommonProps =
( ( frontends :: Frontends
frontends :: Frontends , mCurrentRoute :: Maybe AppRoute
, mCurrentRoute :: Maybe AppRoute , openNodes :: R.State OpenNodes
, openNodes :: R.State OpenNodes , reload :: R.State Reload
, reload :: R.State Reload , session :: Session
, session :: Session
) )
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -93,16 +92,16 @@ toHtml p@{ frontends ...@@ -93,16 +92,16 @@ toHtml p@{ frontends
, tasks: tasks@(asyncTasks /\ setAsyncTasks) , tasks: tasks@(asyncTasks /\ setAsyncTasks)
, tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} [] , tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} []
where where
el = R.hooksComponent "NodeView" cpt el = R.hooksComponent "NodeView" cpt
commonProps = RecordE.pick p :: Record CommonProps commonProps = RecordE.pick p :: Record CommonProps
pAction = performAction (RecordE.pick p :: Record PerformActionProps) pAction = performAction (RecordE.pick p :: Record PerformActionProps)
cpt _ _ = do cpt _ _ = do
let nodeId = mkNodeId session id let nodeId = mkNodeId session id
let folderIsOpen = Set.member nodeId (fst openNodes) let folderIsOpen = Set.member nodeId (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert let setFn = if folderIsOpen then Set.delete else Set.insert
let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId) let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
let withId (NTree (LNode {id: id'}) _) = id' let withId (NTree (LNode {id: id'}) _) = id'
...@@ -154,28 +153,27 @@ childNodes props@{ children } = ...@@ -154,28 +153,27 @@ childNodes props@{ children } =
el = R.hooksComponent "ChildNodeView" cpt el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, asyncTasks} _ = do cpt {tree, asyncTasks} _ = do
tasks <- R.useState' asyncTasks tasks <- R.useState' asyncTasks
pure $ toHtml (Record.merge commonProps pure $ toHtml (Record.merge commonProps { tasks, tree })
{ tasks, tree })
type PerformActionProps = type PerformActionProps =
( openNodes :: R.State OpenNodes ( openNodes :: R.State OpenNodes
, reload :: R.State Reload , reload :: R.State Reload
, session :: Session , session :: Session
, tasks :: R.State (Array GT.AsyncTaskWithType) , tasks :: R.State (Array GT.AsyncTaskWithType)
, tree :: FTree , tree :: FTree
) )
performAction :: Record PerformActionProps performAction :: Record PerformActionProps
-> Action -> Action
-> Aff Unit -> Aff Unit
performAction { openNodes: (_ /\ setOpenNodes) performAction p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload) , reload: (_ /\ setReload)
, session , session
, tree: (NTree (LNode {id}) _) } DeleteNode = do , tree: (NTree (LNode {id}) _) } DeleteNode = do
void $ deleteNode session id void $ deleteNode session id
liftEffect do liftEffect do
setOpenNodes (Set.delete (mkNodeId session id)) setOpenNodes (Set.delete (mkNodeId session id))
setReload (_ + 1) performAction p RefreshTree
performAction { reload: (_ /\ setReload) performAction { reload: (_ /\ setReload)
, session , session
...@@ -183,23 +181,21 @@ performAction { reload: (_ /\ setReload) ...@@ -183,23 +181,21 @@ performAction { reload: (_ /\ setReload)
, tree: (NTree (LNode {id}) _) } (SearchQuery task) = do , tree: (NTree (LNode {id}) _) } (SearchQuery task) = do
liftEffect $ setAsyncTasks $ A.cons task liftEffect $ setAsyncTasks $ A.cons task
liftEffect $ log2 "[performAction] SearchQuery task:" task liftEffect $ log2 "[performAction] SearchQuery task:" task
liftEffect $ setReload (_ + 1)
performAction { reload: (_ /\ setReload) performAction p@{ reload: (_ /\ setReload)
, session , session
, tree: (NTree (LNode {id}) _) } (Submit name) = do , tree: (NTree (LNode {id}) _) } (Submit name) = do
void $ renameNode session id $ RenameValue {name} void $ renameNode session id $ RenameValue {name}
liftEffect do performAction p RefreshTree
setReload (_ + 1)
performAction { openNodes: (_ /\ setOpenNodes) performAction p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload) , reload: (_ /\ setReload)
, session , session
, tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do , tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
void $ createNode session id $ CreateValue {name, nodeType} void $ createNode session id $ CreateValue {name, nodeType}
liftEffect do liftEffect do
setOpenNodes (Set.insert (mkNodeId session id)) setOpenNodes (Set.insert (mkNodeId session id))
setReload (_ + 1) performAction p RefreshTree
performAction { session performAction { session
, tasks: (_ /\ setAsyncTasks) , tasks: (_ /\ setAsyncTasks)
...@@ -207,3 +203,6 @@ performAction { session ...@@ -207,3 +203,6 @@ performAction { session
task <- uploadFile session nodeType id fileType {mName, contents} task <- uploadFile session nodeType id fileType {mName, contents}
liftEffect $ setAsyncTasks $ A.cons task liftEffect $ setAsyncTasks $ A.cons task
liftEffect $ log2 "uploaded, task:" task liftEffect $ log2 "uploaded, task:" task
performAction { reload: (_ /\ setReload) } RefreshTree = do
liftEffect $ setReload (_ + 1)
...@@ -143,10 +143,10 @@ settingsBox Corpus = SettingsBox { ...@@ -143,10 +143,10 @@ settingsBox Corpus = SettingsBox {
, edit : true , edit : true
, doc : Documentation Corpus , doc : Documentation Corpus
, buttons : [ SearchBox , buttons : [ SearchBox
{- , Add [ NodeList , Add [ NodeList
, Graph , Graph
, Dashboard , Dashboard
] -} ]
, Upload , Upload
, Download , Download
--, Share --, Share
......
...@@ -19,6 +19,7 @@ data Action = CreateSubmit String GT.NodeType ...@@ -19,6 +19,7 @@ data Action = CreateSubmit String GT.NodeType
| SearchQuery GT.AsyncTaskWithType | SearchQuery GT.AsyncTaskWithType
| Submit String | Submit String
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents | UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| RefreshTree
----------------------------------------------------- -----------------------------------------------------
-- UploadFile Action -- UploadFile Action
......
...@@ -34,7 +34,7 @@ createNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p [] ...@@ -34,7 +34,7 @@ createNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
where where
el = R.hooksComponent "CreateNodeView" cpt el = R.hooksComponent "CreateNodeView" cpt
cpt {id, name} _ = do cpt {id, name} _ = do
nodeName <- R.useState' "Default Name" nodeName <- R.useState' "Name"
nodeType' <- R.useState' $ fromMaybe NodeUser $ head nodeTypes nodeType' <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
pure $ H.div {} pure $ H.div {}
[ panelBody readNodeType nodeName nodeType' [ panelBody readNodeType nodeName nodeType'
......
...@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Box where ...@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Box where
import Gargantext.Prelude import Gargantext.Prelude
import DOM.Simple as DOM
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (null) import Data.Nullable (null)
import Data.Tuple (fst, Tuple(..)) import Data.Tuple (fst, Tuple(..))
...@@ -12,21 +13,14 @@ import Effect (Effect) ...@@ -12,21 +13,14 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_) import Effect.Aff (Aff, launchAff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Lang (allLangs, Lang(EN))
import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox) import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView) import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox) import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView)
import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar) import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.GraphExplorer.API as GEAPI import Gargantext.Components.GraphExplorer.API as GEAPI
import Gargantext.Components.Lang (allLangs, Lang(EN))
import Gargantext.Components.Search.SearchBar (searchBar) import Gargantext.Components.Search.SearchBar (searchBar)
import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex) import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
...@@ -39,6 +33,12 @@ import Gargantext.Types as GT ...@@ -39,6 +33,12 @@ import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, glyphiconActive) import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Popover as Popover import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Web.File.FileReader.Aff (readAsText)
import DOM.Simple.Types import DOM.Simple.Types
import DOM.Simple.Window import DOM.Simple.Window
...@@ -93,13 +93,17 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el ...@@ -93,13 +93,17 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
else H.div {} [] else H.div {} []
, H.a { href: (url frontends (GT.NodePath (sessionId session) nodeType (Just id))) , H.a { href: (url frontends (GT.NodePath (sessionId session) nodeType (Just id)))
} }
[ nodeText { isSelected: (mCorpusId mCurrentRoute) == (Just id) [ nodeText { isSelected: mAppRouteId mCurrentRoute == Just id
, name: name' props } ] , name: name' props } ]
, nodeActions { id, nodeType, session } , nodeActions { id
, nodeType
, refreshTree: const $ dispatch RefreshTree
, session }
, fileTypeView {dispatch, droppedFile, id, isDragOver, nodeType} , fileTypeView {dispatch, droppedFile, id, isDragOver, nodeType}
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie
, corpusId: id , corpusId: id
, onFinish: \_ -> onAsyncTaskFinish t , onFinish: const $ onAsyncTaskFinish t
, session }) asyncTasks) , session }) asyncTasks)
] ]
where where
...@@ -198,6 +202,7 @@ type NodeActionsProps = ...@@ -198,6 +202,7 @@ type NodeActionsProps =
( (
id :: ID id :: ID
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, refreshTree :: Unit -> Aff Unit
, session :: Session , session :: Session
) )
...@@ -207,24 +212,21 @@ nodeActions p = R.createElement nodeActionsCpt p [] ...@@ -207,24 +212,21 @@ nodeActions p = R.createElement nodeActionsCpt p []
nodeActionsCpt :: R.Component NodeActionsProps nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = R.hooksComponent "G.C.F.T.N.B.nodeActions" cpt nodeActionsCpt = R.hooksComponent "G.C.F.T.N.B.nodeActions" cpt
where where
cpt { id, nodeType: GT.Graph, session } _ = do cpt { id, nodeType: GT.Graph, refreshTree, session } _ = do
refresh <- R.useState' 0 useLoader id (graphVersions session) $ \gv ->
nodeActionsGraph { id, graphVersions: gv, session, triggerRefresh: triggerRefresh refreshTree }
useLoader (id /\ fst refresh) (graphVersions session) $ \gv ->
nodeActionsGraph { id, graphVersions: gv, session, triggerRefresh: triggerRefresh refresh }
cpt _ _ = do cpt _ _ = do
pure $ H.div {} [] pure $ H.div {} []
graphVersions session (graphId /\ _) = graphVersions session graphId = GEAPI.graphVersions { graphId, session }
GEAPI.graphVersions { graphId, session } triggerRefresh refreshTree = refreshTree
triggerRefresh (_ /\ setRefresh) _ = setRefresh $ (+) 1
type NodeActionsGraphProps = type NodeActionsGraphProps =
( (
id :: ID id :: ID
, graphVersions :: Record GEAPI.GraphVersions , graphVersions :: Record GEAPI.GraphVersions
, session :: Session , session :: Session
, triggerRefresh :: Unit -> Effect Unit , triggerRefresh :: Unit -> Aff Unit
) )
nodeActionsGraph :: Record NodeActionsGraphProps -> R.Element nodeActionsGraph :: Record NodeActionsGraphProps -> R.Element
...@@ -245,7 +247,7 @@ type GraphUpdateButtonProps = ...@@ -245,7 +247,7 @@ type GraphUpdateButtonProps =
( (
id :: ID id :: ID
, session :: Session , session :: Session
, triggerRefresh :: Unit -> Effect Unit , triggerRefresh :: Unit -> Aff Unit
) )
graphUpdateButton :: Record GraphUpdateButtonProps -> R.Element graphUpdateButton :: Record GraphUpdateButtonProps -> R.Element
...@@ -268,15 +270,29 @@ graphUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.graphUpdateButton" cpt ...@@ -268,15 +270,29 @@ graphUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.graphUpdateButton" cpt
liftEffect $ setEnabled $ const false liftEffect $ setEnabled $ const false
g <- GEAPI.updateGraphVersions { graphId: id, session } g <- GEAPI.updateGraphVersions { graphId: id, session }
liftEffect $ setEnabled $ const true liftEffect $ setEnabled $ const true
liftEffect $ triggerRefresh unit triggerRefresh unit
pure unit pure unit
-- END nodeActions -- END nodeActions
mCorpusId :: Maybe AppRoute -> Maybe Int mAppRouteId :: Maybe AppRoute -> Maybe Int
mCorpusId (Just (Routes.Corpus _ id)) = Just id mAppRouteId (Just (Routes.Folder _ id)) = Just id
mCorpusId (Just (Routes.CorpusDocument _ id _ _)) = Just id mAppRouteId (Just (Routes.FolderPrivate _ id)) = Just id
mCorpusId _ = Nothing mAppRouteId (Just (Routes.FolderPublic _ id)) = Just id
mAppRouteId (Just (Routes.FolderShared _ id)) = Just id
mAppRouteId (Just (Routes.Team _ id)) = Just id
mAppRouteId (Just (Routes.Corpus _ id)) = Just id
mAppRouteId (Just (Routes.Document _ id _)) = Just id
mAppRouteId (Just (Routes.CorpusDocument _ id _ _)) = Just id
mAppRouteId (Just (Routes.PGraphExplorer _ id)) = Just id
mAppRouteId (Just (Routes.Dashboard _ id)) = Just id
mAppRouteId (Just (Routes.Texts _ id)) = Just id
mAppRouteId (Just (Routes.Lists _ id)) = Just id
mAppRouteId (Just (Routes.Annuaire _ id)) = Just id
mAppRouteId (Just (Routes.UserPage _ id)) = Just id
mAppRouteId (Just (Routes.ContactPage _ id _)) = Just id
mAppRouteId _ = Nothing
-- | START Popup View -- | START Popup View
......
...@@ -19,9 +19,13 @@ import Reactix as R ...@@ -19,9 +19,13 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
data BarType = Bar | Pie
type Props = type Props =
( (
asyncTask :: GT.AsyncTaskWithType asyncTask :: GT.AsyncTaskWithType
, barType :: BarType
, corpusId :: ID , corpusId :: ID
, onFinish :: Unit -> Effect Unit , onFinish :: Unit -> Effect Unit
, session :: Session , session :: Session
...@@ -32,9 +36,9 @@ asyncProgressBar :: Record Props -> R.Element ...@@ -32,9 +36,9 @@ asyncProgressBar :: Record Props -> R.Element
asyncProgressBar p = R.createElement asyncProgressBarCpt p [] asyncProgressBar p = R.createElement asyncProgressBarCpt p []
asyncProgressBarCpt :: R.Component Props asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.PB.asyncProgressBar" cpt
where where
cpt props@{asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}}), corpusId, onFinish} _ = do cpt props@{asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}}), barType, corpusId, onFinish} _ = do
(progress /\ setProgress) <- R.useState' 0.0 (progress /\ setProgress) <- R.useState' 0.0
intervalIdRef <- R.useRef Nothing intervalIdRef <- R.useRef Nothing
...@@ -57,16 +61,41 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt ...@@ -57,16 +61,41 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
pure unit pure unit
pure $ progressIndicator { barType, label: id, progress: toInt progress }
toInt :: Number -> Int
toInt n = unsafePartial $ fromJust $ fromNumber n
type ProgressIndicatorProps =
(
barType :: BarType
, label :: String
, progress :: Int
)
progressIndicator :: Record ProgressIndicatorProps -> R.Element
progressIndicator p = R.createElement progressIndicatorCpt p []
progressIndicatorCpt :: R.Component ProgressIndicatorProps
progressIndicatorCpt = R.hooksComponent "G.C.F.T.N.PB.progressIndicator" cpt
where
cpt { barType: Bar, label, progress } _ = do
pure $ pure $
H.div { className: "progress" } [ H.div { className: "progress" } [
H.div { className: "progress-bar" H.div { className: "progress-bar"
, role: "progressbar" , role: "progressbar"
, style: { width: (show $ toInt progress) <> "%" } , style: { width: (show $ progress) <> "%" }
} [ H.text id ] } [ H.text label ]
] ]
toInt :: Number -> Int cpt { barType: Pie, label, progress } _ = do
toInt n = unsafePartial $ fromJust $ fromNumber n pure $
H.div { className: "progress-pie" } [
H.div { className: "progress-pie-segment"
, style: { "--over50": if progress < 50 then "0" else "1"
, "--value": show $ progress } } [
]
]
queryProgress :: Record Props -> Aff GT.AsyncProgress queryProgress :: Record Props -> Aff GT.AsyncProgress
queryProgress {asyncTask: GT.AsyncTaskWithType {task: GT.AsyncTask {id}, typ}, corpusId, session} = get session p queryProgress {asyncTask: GT.AsyncTaskWithType {task: GT.AsyncTask {id}, typ}, corpusId, session} = get session p
......
...@@ -3,11 +3,12 @@ ...@@ -3,11 +3,12 @@
-- Select a backend and log into it -- Select a backend and log into it
module Gargantext.Components.Login where module Gargantext.Components.Login where
import Prelude (Unit, bind, const, discard, pure, show, ($), (<>), (*>), (<$>), (>), map) import Prelude (Unit, bind, const, discard, pure, show, ($), (<>), (*>), (<$>), (>), map, (==), (/=), not, (&&))
import Data.Array (head) import Data.Array (head)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Data.String as DST import Data.String as DST
import DOM.Simple.Console (log) import DOM.Simple.Console (log)
import Data.Sequence as DS import Data.Sequence as DS
...@@ -18,7 +19,7 @@ import Reactix as R ...@@ -18,7 +19,7 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Components.Forms (clearfix, card, cardBlock, cardGroup, center, formGroup) import Gargantext.Components.Forms (clearfix, cardBlock, cardGroup, center, formGroup)
import Gargantext.Components.Login.Types (AuthRequest(..)) import Gargantext.Components.Login.Types (AuthRequest(..))
import Gargantext.Ends (Backend(..)) import Gargantext.Ends (Backend(..))
import Gargantext.Sessions (Session, Sessions(..), postAuthRequest, unSessions) import Gargantext.Sessions (Session, Sessions(..), postAuthRequest, unSessions)
...@@ -32,7 +33,8 @@ import Gargantext.Utils.Reactix as R2 ...@@ -32,7 +33,8 @@ import Gargantext.Utils.Reactix as R2
type Props = type Props =
( backends :: Array Backend ( backends :: Array Backend
, sessions :: R2.Reductor Sessions Sessions.Action , sessions :: R2.Reductor Sessions Sessions.Action
, visible :: R.State Boolean ) , visible :: R.State Boolean
)
type ModalProps = ( visible :: R.State Boolean ) type ModalProps = ( visible :: R.State Boolean )
...@@ -53,15 +55,15 @@ modalCpt = R.hooksComponent "G.C.Login.modal" cpt where ...@@ -53,15 +55,15 @@ modalCpt = R.hooksComponent "G.C.Login.modal" cpt where
[ H.div { className: "modal-header" } [ H.div { className: "modal-header" }
[ closing [ closing
, logo , logo
, H.h2 { className: "center modal-title" } [H.text "Instances manager"]
] ]
, H.div { className: "modal-body" } children ] ] ] ] , H.div { className: "modal-body" } children ] ] ] ]
modalClass s = "modal myModal" <> if s then "" else " fade" modalClass s = "modal myModal" <> if s then "" else " fade"
logo = logo =
H.div {className: "col-md-10 col-md-push-1"} H.div {className: "col-md-10 col-md-push-1"}
[ H.h2 {className: "text-primary center m-a-2"} [ H.h2 {className: "text-primary center m-a-2"}
[ H.i {className: "material-icons md-36"} [ H.text "control_point" ] [
, H.span {className: "icon-text"} [ H.text "Gargantext" ] ] ] -- H.i {className: "material-icons md-36"} [ H.text "control_point" ]
H.span {className: "icon-text"} [ H.text "Gargantext" ] ] ]
closing = H.button { "type": "button", className: "close" closing = H.button { "type": "button", className: "close"
, "data": { dismiss: "modal" } } , "data": { dismiss: "modal" } }
...@@ -85,7 +87,7 @@ loginCpt = R.hooksComponent "G.C.Login.login" cpt ...@@ -85,7 +87,7 @@ loginCpt = R.hooksComponent "G.C.Login.login" cpt
modal {visible} $ modal {visible} $
case fst backend of case fst backend of
Nothing -> chooser { backends, backend, sessions, visible } Nothing -> chooser { backends, backend, sessions, visible }
Just b -> form { sessions, visible, backend: b } Just b -> form { sessions, visible, backend: b }
type ChooserProps = ( backend :: R.State (Maybe Backend) | Props ) type ChooserProps = ( backend :: R.State (Maybe Backend) | Props )
...@@ -96,8 +98,9 @@ chooserCpt :: R.Component ChooserProps ...@@ -96,8 +98,9 @@ chooserCpt :: R.Component ChooserProps
chooserCpt = R.staticComponent "G.C.Login.chooser" cpt where chooserCpt = R.staticComponent "G.C.Login.chooser" cpt where
cpt :: Record ChooserProps -> Array R.Element -> R.Element cpt :: Record ChooserProps -> Array R.Element -> R.Element
cpt {backend, backends, sessions} _ = cpt {backend, backends, sessions} _ =
R.fragment $ active <> new <> search R.fragment $ title <> active <> new <> search
where where
title = [H.h2 { className: "center modal-title" } [H.text "Instances manager"]]
active = if DS.length ss > 0 then [ H.h3 {} [H.text "Active connection(s)"] active = if DS.length ss > 0 then [ H.h3 {} [H.text "Active connection(s)"]
, H.ul {} [ renderSessions sessions] , H.ul {} [ renderSessions sessions]
] else [] where ] else [] where
...@@ -146,7 +149,8 @@ renderBackend state backend@(Backend {name}) = ...@@ -146,7 +149,8 @@ renderBackend state backend@(Backend {name}) =
type FormProps = type FormProps =
( backend :: Backend ( backend :: Backend
, sessions :: R2.Reductor Sessions Sessions.Action , sessions :: R2.Reductor Sessions Sessions.Action
, visible :: R.State Boolean ) , visible :: R.State Boolean
)
form :: Record FormProps -> R.Element form :: Record FormProps -> R.Element
form props = R.createElement formCpt props [] form props = R.createElement formCpt props []
...@@ -155,28 +159,36 @@ formCpt :: R.Component FormProps ...@@ -155,28 +159,36 @@ formCpt :: R.Component FormProps
formCpt = R.hooksComponent "G.C.Login.form" cpt where formCpt = R.hooksComponent "G.C.Login.form" cpt where
cpt :: Record FormProps -> Array R.Element -> R.Hooks R.Element cpt :: Record FormProps -> Array R.Element -> R.Hooks R.Element
cpt props@{backend, sessions, visible} _ = do cpt props@{backend, sessions, visible} _ = do
error <- R.useState' "" error <- R.useState' ""
username <- R.useState' "" username <- R.useState' ""
password <- R.useState' "" password <- R.useState' ""
setBox@(checkBox /\ setCheckBox) <- R.useState' false
pure $ R2.row pure $ R2.row
[ cardGroup [ cardGroup
[ card [ cardBlock
[ cardBlock [ center
[ center [ H.div {className: "text-muted"}
[ H.h4 {className: "m-b-0"} [ H.text $ "Login to garg://" <> show backend]
[ H.span {className: "icon-text"} [ H.text "Welcome :)" ] ] , requestAccessLink {}
, H.p {className: "text-muted"} ]
[ H.text $ "Login to your account or", requestAccessLink {} ] ] , H.div {}
, H.div {} [ csrfTokenInput {}
[ csrfTokenInput {} , formGroup [ H.p {} [ H.text (fst error) ], usernameInput username ]
, formGroup [ H.p {} [ H.text (fst error) ], usernameInput username ] , formGroup [ passwordInput password, clearfix {} ]
, formGroup [ passwordInput password, clearfix {} ] , center
, center [ H.label {}
[ H.label {} [ H.div {className: "checkbox"}
[ H.div {className: "checkbox"} [ termsCheckbox setBox , H.text "I accept the terms of use ", termsLink {} ] ]
[ termsCheckbox {}, H.text "I accept the terms of use ", termsLink {} ] ] ]
, loginSubmit $ ]
onClick props error username password ] ] ] ] ] ] , if checkBox == true
&& fst username /= ""
&& fst password /= ""
then H.div {} [center [loginSubmit $ onClick props error username password]]
else H.div {} []
]
]
]
onClick {backend, sessions, visible} error username password e = onClick {backend, sessions, visible} error username password e =
launchAff_ $ do launchAff_ $ do
let req = AuthRequest {username: fst username, password: fst password} let req = AuthRequest {username: fst username, password: fst password}
...@@ -193,13 +205,18 @@ csrfTokenInput _ = ...@@ -193,13 +205,18 @@ csrfTokenInput _ =
H.input { type: "hidden", name: "csrfmiddlewaretoken" H.input { type: "hidden", name: "csrfmiddlewaretoken"
, value: csrfMiddlewareToken }-- TODO hard-coded CSRF token , value: csrfMiddlewareToken }-- TODO hard-coded CSRF token
termsCheckbox :: {} -> R.Element termsCheckbox :: R.State Boolean -> R.Element
termsCheckbox _ = termsCheckbox setCheckBox =
H.input { id: "terms-accept", type: "checkbox", value: "", className: "checkbox" } H.input { id: "terms-accept"
, type: "checkbox"
, value: fst setCheckBox
, className: "checkbox"
, on: { click: \_ -> (snd setCheckBox) $ const $ not (fst setCheckBox)}
}
termsLink :: {} -> R.Element termsLink :: {} -> R.Element
termsLink _ = termsLink _ =
H.a { target: "_blank", href: termsUrl } [ H.text " [ Read the terms of use ] " ] H.a { target: "_blank", href: termsUrl } [ H.text " [Read the terms of use]" ]
where termsUrl = "http://gitlab.iscpif.fr/humanities/tofu/tree/master" where termsUrl = "http://gitlab.iscpif.fr/humanities/tofu/tree/master"
requestAccessLink :: {} -> R.Element requestAccessLink :: {} -> R.Element
......
This diff is collapsed.
module Gargantext.Components.NgramsTable.Components where
import Data.Lens ((^..), (^.), view)
import Data.Lens.At (at)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.List (null, toUnfoldable) as L
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Nullable (null, toMaybe)
import Data.Set (Set)
import Data.Set as Set
import React.DOM (a, span, text)
import React.DOM.Props as DOM
import Effect (Effect)
import FFI.Simple (delay)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsElement, NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, Replace, _NgramsElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, singletonNgramsTablePatch)
import Gargantext.Components.Table as Tbl
import Gargantext.Types as T
import Gargantext.Utils.Reactix as R2
type SearchInputProps =
(
key :: String -- to prevent refreshing & losing input
, onSearch :: String -> Effect Unit
, searchQuery :: String
)
searchInput :: Record SearchInputProps -> R.Element
searchInput props = R.createElement searchInputCpt props []
searchInputCpt :: R.Component SearchInputProps
searchInputCpt = R.hooksComponent "G.C.NT.searchInput" cpt
where
cpt { onSearch, searchQuery } _ = do
pure $ H.div { className: "input-group" } [
H.div { className: "input-group-addon" } [
H.span { className: "fa fa-search" } []
]
, H.input { className: "form-control"
, defaultValue: searchQuery
, name: "search"
, on: { input: onSearch <<< R2.unsafeEventValue }
, placeholder: "Search"
, type: "value" }
]
type SelectionCheckboxProps =
(
allNgramsSelected :: Boolean
, dispatch :: Dispatch
, ngramsSelection :: Set NgramsTerm
)
selectionCheckbox :: Record SelectionCheckboxProps -> R.Element
selectionCheckbox props = R.createElement selectionCheckboxCpt props []
selectionCheckboxCpt :: R.Component SelectionCheckboxProps
selectionCheckboxCpt = R.hooksComponent "G.C.NT.selectionCheckbox" cpt
where
cpt { allNgramsSelected, dispatch, ngramsSelection } _ = do
ref <- R.useRef null
R.useEffect' $ delay unit $ \_ -> do
let mCb = toMaybe $ R.readRef ref
case mCb of
Nothing -> pure unit
Just cb -> do
_ <- if allNgramsSelected || (Set.isEmpty ngramsSelection) then
R2.setIndeterminateCheckbox cb false
else
R2.setIndeterminateCheckbox cb true
pure unit
pure $ H.input { checked: allNgramsSelected
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelectAll }
, ref
, type: "checkbox" }
type RenderNgramsTree =
( ngrams :: NgramsTerm
, ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick
, ngramsStyle :: Array DOM.Props
, ngramsTable :: NgramsTable
)
renderNgramsTree :: Record RenderNgramsTree -> R.Element
renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = R.hooksComponent "G.C.NT.renderNgramsTree" cpt
where
cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } _ =
pure $ H.ul {} [
H.span { className: "tree" } [
tree { ngramsClick
, ngramsDepth: {ngrams, depth: 0}
, ngramsEdit
, ngramsStyle
, ngramsTable
}
]
]
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
type TreeProps =
(
ngramsClick :: NgramsClick
, ngramsDepth :: NgramsDepth
, ngramsEdit :: NgramsClick
, ngramsStyle :: Array DOM.Props
, ngramsTable :: NgramsTable
)
tree :: Record TreeProps -> R.Element
tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps
treeCpt = R.hooksComponent "G.C.NT.tree" cpt
where
cpt params@{ ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle, ngramsTable } _ =
pure $
H.li { style: {width : "100%"} }
([ H.i { className, style } [] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest cs ])
where
tag =
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span ngramsStyle
edit effect = [ H.text " "
, H.i { className: "glyphicon glyphicon-pencil"
, on: { click: const effect } } []
]
leaf = L.null cs
className = "glyphicon glyphicon-chevron-" <> if open then "down" else "right"
style = if leaf then {color: "#adb5bd"} else {color: ""}
open = not leaf || false {- TODO -}
cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsElement <<< _children <<< folded
forest =
let depth = ngramsDepth.depth + 1 in
H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
type RenderNgramsItem =
( dispatch :: Action -> Effect Unit
, ngrams :: NgramsTerm
, ngramsElement :: NgramsElement
, ngramsLocalPatch :: NgramsTablePatch
, ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable
)
renderNgramsItem :: Record RenderNgramsItem -> R.Element
renderNgramsItem p = R.createElement renderNgramsItemCpt p []
renderNgramsItemCpt :: R.Component RenderNgramsItem
renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
where
cpt { dispatch
, ngrams
, ngramsElement
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsTable } _ =
pure $ Tbl.makeRow [
selected
, checkbox T.GraphTerm
, checkbox T.StopTerm
, if ngramsParent == Nothing
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
else
H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } } [
H.i { className: "glyphicon glyphicon-plus" } []
, (R2.buff $ span ngramsStyle [text $ " " <> ngramsTermText ngrams])
]
, H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
]
where
termList = ngramsElement ^. _NgramsElement <<< _list
ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
ngramsClick
= Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
-- ^ This is the old behavior it is nicer to use since one can
-- rapidly change the ngram list without waiting for confirmation.
-- However this might expose bugs. One of them can be reproduced
-- by clicking a multiple times on the same ngram, sometimes it stays
-- transient.
-- | ngramsTransient = const Nothing
-- | otherwise = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
selected =
H.input { checked: Set.member ngrams ngramsSelection
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelect ngrams }
, type: "checkbox" }
checkbox termList' =
let chkd = termList == termList'
termList'' = if chkd then T.CandidateTerm else termList'
in
H.input { checked: chkd
, className: "checkbox"
, on: { change: const $ dispatch $
setTermListA ngrams (replace termList termList'') }
, readOnly: ngramsTransient
, type: "checkbox" }
ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ TODO here we do not look at ngramsNewElems, shall we?
ngramsOpacity
| ngramsTransient = 0.5
| otherwise = 1.0
cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))
termStyle :: T.TermList -> Number -> DOM.Props
termStyle T.GraphTerm opacity = DOM.style { color: "green", opacity }
termStyle T.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity }
setTermListA :: NgramsTerm -> Replace T.TermList -> Action
setTermListA n patch_list =
CommitPatch $
singletonNgramsTablePatch n $
NgramsPatch { patch_list, patch_children: mempty }
tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams =
isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
nextTermList :: T.TermList -> T.TermList
nextTermList T.GraphTerm = T.StopTerm
nextTermList T.StopTerm = T.CandidateTerm
nextTermList T.CandidateTerm = T.GraphTerm
...@@ -44,9 +44,13 @@ module Gargantext.Components.NgramsTable.Core ...@@ -44,9 +44,13 @@ module Gargantext.Components.NgramsTable.Core
, _parent , _parent
, _root , _root
, commitPatch , commitPatch
, commitPatchR
, putNgramsPatches , putNgramsPatches
, syncPatches , syncPatches
, syncPatchesR
, addNewNgram , addNewNgram
, Action(..)
, Dispatch
) )
where where
...@@ -83,16 +87,22 @@ import Data.Symbol (SProxy(..)) ...@@ -83,16 +87,22 @@ import Data.Symbol (SProxy(..))
import Data.Traversable (class Traversable, for, sequence, traverse, traverse_) import Data.Traversable (class Traversable, for, sequence, traverse, traverse_)
import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect.Aff (Aff) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Exception.Unsafe (unsafeThrow)
import Foreign.Object as FO import Foreign.Object as FO
import Reactix (State) as R
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Thermite (StateCoTransformer, modifyState_)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post) import Gargantext.Sessions (Session, get, put, post)
import Gargantext.Types (CTabNgramType(..), OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize) import Gargantext.Types (CTabNgramType(..), OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize)
import Gargantext.Utils.KarpRabin (indicesOfAny) import Gargantext.Utils.KarpRabin (indicesOfAny)
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Thermite (StateCoTransformer, modifyState_)
type CoreParams s = type CoreParams s =
{ nodeId :: Int { nodeId :: Int
...@@ -179,14 +189,14 @@ _list = prop (SProxy :: SProxy "list") ...@@ -179,14 +189,14 @@ _list = prop (SProxy :: SProxy "list")
derive instance newtypeNgramsElement :: Newtype NgramsElement _ derive instance newtypeNgramsElement :: Newtype NgramsElement _
_NgramsElement :: Iso' NgramsElement { _NgramsElement :: Iso' NgramsElement {
children :: Set NgramsTerm children :: Set NgramsTerm
, list :: TermList , list :: TermList
, ngrams :: NgramsTerm , ngrams :: NgramsTerm
, occurrences :: Int , occurrences :: Int
, parent :: Maybe NgramsTerm , parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm , root :: Maybe NgramsTerm
} }
_NgramsElement = _Newtype _NgramsElement = _Newtype
instance decodeJsonNgramsElement :: DecodeJson NgramsElement where instance decodeJsonNgramsElement :: DecodeJson NgramsElement where
...@@ -336,14 +346,15 @@ replace old new ...@@ -336,14 +346,15 @@ replace old new
| old == new = Keep | old == new = Keep
| otherwise = Replace { old, new } | otherwise = Replace { old, new }
instance semigroupReplace :: Semigroup (Replace a) where derive instance eqReplace :: Eq a => Eq (Replace a)
instance semigroupReplace :: Eq a => Semigroup (Replace a) where
append Keep p = p append Keep p = p
append p Keep = p append p Keep = p
append (Replace { old: _m, new }) (Replace { old, new: _m' }) = append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
-- assert _m == _m' append (Replace { new }) (Replace { old }) = replace old new
Replace { old, new }
instance semigroupMonoid :: Monoid (Replace a) where instance semigroupMonoid :: Eq a => Monoid (Replace a) where
mempty = Keep mempty = Keep
applyReplace :: forall a. Eq a => Replace a -> a -> a applyReplace :: forall a. Eq a => Replace a -> a -> a
...@@ -419,6 +430,9 @@ newtype NgramsPatch = NgramsPatch ...@@ -419,6 +430,9 @@ newtype NgramsPatch = NgramsPatch
, patch_list :: Replace TermList , patch_list :: Replace TermList
} }
derive instance eqNgramsPatch :: Eq NgramsPatch
derive instance eqPatchSetNgramsTerm :: Eq (PatchSet NgramsTerm)
instance semigroupNgramsPatch :: Semigroup NgramsPatch where instance semigroupNgramsPatch :: Semigroup NgramsPatch where
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children { patch_children: p.patch_children <> q.patch_children
...@@ -455,13 +469,16 @@ applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement ...@@ -455,13 +469,16 @@ applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement
newtype PatchMap k p = PatchMap (Map k p) newtype PatchMap k p = PatchMap (Map k p)
instance semigroupPatchMap :: (Ord k, Semigroup p) => Semigroup (PatchMap k p) where instance semigroupPatchMap :: (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
append (PatchMap p) (PatchMap q) = PatchMap (Map.unionWith append p q) append (PatchMap p) (PatchMap q) = PatchMap pMap
where
pMap = Map.filter (\v -> v /= mempty) $ Map.unionWith append p q
instance monoidPatchMap :: (Ord k, Semigroup p) => Monoid (PatchMap k p) where instance monoidPatchMap :: (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where
mempty = PatchMap Map.empty mempty = PatchMap Map.empty
derive instance newtypePatchMap :: Newtype (PatchMap k p) _ derive instance newtypePatchMap :: Newtype (PatchMap k p) _
derive instance eqPatchMap :: (Eq k, Eq p) => Eq (PatchMap k p)
_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p) _PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
_PatchMap = _Newtype _PatchMap = _Newtype
...@@ -537,9 +554,12 @@ singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch ...@@ -537,9 +554,12 @@ singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p
rootsOf :: NgramsTable -> Set NgramsTerm rootsOf :: NgramsTable -> Set NgramsTerm
rootsOf (NgramsTable m) = Map.keys $ Map.filter isRoot m rootsOf (NgramsTable m) = Map.keys $ Map.mapMaybe isRoot m
where where
isRoot (NgramsElement {parent}) = isNothing parent isRoot (NgramsElement { parent }) = parent
-- rootsOf (NgramsTable m) = Map.keys $ Map.filter isRoot m
-- where
-- isRoot (NgramsElement {parent}) = isNothing parent
type RootParent = { root :: NgramsTerm, parent :: NgramsTerm } type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
...@@ -631,6 +651,7 @@ putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff Vers ...@@ -631,6 +651,7 @@ putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff Vers
putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId) where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
-- DEPRECATED: use the Reactix version `syncPatchesR`
syncPatches :: forall p s. CoreParams p -> CoreState s -> StateCoTransformer (CoreState s) Unit syncPatches :: forall p s. CoreParams p -> CoreState s -> StateCoTransformer (CoreState s) Unit
syncPatches props { ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPatches} syncPatches props { ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPatches}
, ngramsStagePatch , ngramsStagePatch
...@@ -651,11 +672,38 @@ syncPatches props { ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPa ...@@ -651,11 +672,38 @@ syncPatches props { ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPa
, ngramsStagePatch = fromNgramsPatches mempty , ngramsStagePatch = fromNgramsPatches mempty
} }
syncPatchesR :: forall p s. CoreParams p -> R.State (CoreState s) -> Effect Unit
syncPatchesR props ({ ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPatches}
, ngramsStagePatch
, ngramsValidPatch
, ngramsVersion
} /\ setState) = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
setState $ \s ->
s { ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = ngramsLocalPatch
}
let pt = Versioned { version: ngramsVersion, data: ngramsPatches }
launchAff_ $ do
_ <- postNewElems ngramsNewElems props
Versioned {version: newVersion, data: newPatch} <- putNgramsPatches props pt
liftEffect $ setState $ \s ->
s { ngramsVersion = newVersion
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
, ngramsStagePatch = fromNgramsPatches mempty
}
-- DEPRECATED: use `commitPatchR`
commitPatch :: forall s. Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit commitPatch :: forall s. Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit
commitPatch (Versioned {version, data: tablePatch}) = do commitPatch (Versioned {version, data: tablePatch}) = do
modifyState_ $ \s -> modifyState_ $ \s ->
s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch } s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }
commitPatchR :: forall s. Versioned NgramsTablePatch -> R.State (CoreState s) -> Effect Unit
commitPatchR (Versioned {version, data: tablePatch}) (_ /\ setState) = do
setState $ \s ->
s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }
loadNgramsTable :: PageParams -> Aff VersionedNgramsTable loadNgramsTable :: PageParams -> Aff VersionedNgramsTable
loadNgramsTable loadNgramsTable
{ nodeId, listIds, termListFilter, termSizeFilter, session, scoreType { nodeId, listIds, termListFilter, termSizeFilter, session, scoreType
...@@ -689,3 +737,22 @@ convOrderBy (T.ASC (T.ColumnName "Score")) = ScoreAsc ...@@ -689,3 +737,22 @@ convOrderBy (T.ASC (T.ColumnName "Score")) = ScoreAsc
convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
convOrderBy (T.ASC _) = TermAsc convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.DESC _) = TermDesc convOrderBy (T.DESC _) = TermDesc
data Action
= CommitPatch NgramsTablePatch
| SetParentResetChildren (Maybe NgramsTerm)
-- ^ This sets `ngramsParent` and resets `ngramsChildren`.
| ToggleChild Boolean NgramsTerm
-- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`.
-- If the `Boolean` is `true` it means we want to add it if it is not here,
-- if it is `false` it is meant to be removed if not here.
| AddTermChildren
| Synchronize
| ToggleSelect NgramsTerm
-- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
| ToggleSelectAll
| ResetPatches
type Dispatch = Action -> Effect Unit
...@@ -2,13 +2,15 @@ module Gargantext.Components.Nodes.Annuaire where ...@@ -2,13 +2,15 @@ module Gargantext.Components.Nodes.Annuaire where
import Prelude (bind, const, identity, pure, ($), (<$>), (<>)) import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Array (head) import Data.Array as A
import Data.List as L
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (url, Frontends) import Gargantext.Ends (url, Frontends)
...@@ -114,7 +116,12 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt ...@@ -114,7 +116,12 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
pure $ T.table { rows, params, container, colNames, totalRecords, wrapColElts } pure $ T.table { rows, params, container, colNames, totalRecords, wrapColElts }
where where
path = fst pagePath path = fst pagePath
rows = (\c -> {row: contactCells session frontends (fst pagePath).nodeId c, delete: false}) <$> docs rows = (\c -> {
row: contactCells { annuaireId: (fst pagePath).nodeId
, frontends
, contact: c
, session }
, delete: false }) <$> L.fromFoldable docs
container = T.defaultContainer { title: "Annuaire" } -- TODO container = T.defaultContainer { title: "Annuaire" } -- TODO
colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"] colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
wrapColElts = const identity wrapColElts = const identity
...@@ -124,11 +131,26 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt ...@@ -124,11 +131,26 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
type AnnuaireId = Int type AnnuaireId = Int
contactCells :: Session -> Frontends -> AnnuaireId -> CT.Contact -> Array R.Element type ContactCellsProps =
contactCells session frontends aId = render (
annuaireId :: AnnuaireId
, contact :: CT.Contact
, frontends :: Frontends
, session :: Session
)
contactCells :: Record ContactCellsProps -> R.Element
contactCells p = R.createElement contactCellsCpt p []
contactCellsCpt :: R.Component ContactCellsProps
contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt
where where
render (CT.Contact { id, hyperdata : (CT.HyperdataUser {shared: Nothing} )}) = cpt { annuaireId
[ H.text "" , contact: (CT.Contact { id, hyperdata: (CT.HyperdataUser {shared: Nothing}) })
, frontends
, session } _ =
pure $ T.makeRow [
H.text ""
, H.span {} [ H.text "name" ] , H.span {} [ H.text "name" ]
--, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ] --, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
, H.text "No ContactWhere" , H.text "No ContactWhere"
...@@ -136,26 +158,34 @@ contactCells session frontends aId = render ...@@ -136,26 +158,34 @@ contactCells session frontends aId = render
, H.div {className: "nooverflow"} , H.div {className: "nooverflow"}
[ H.text "No ContactWhereRole" ] [ H.text "No ContactWhereRole" ]
] ]
render (CT.Contact { id, hyperdata : (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who: who, ou:ou}) } )}) = cpt { annuaireId
--let nodepath = NodePath (sessionId session) NodeContact (Just id) , contact: (CT.Contact { id
let nodepath = Routes.ContactPage (sessionId session) aId id , hyperdata: (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who, ou})}) })
href = url frontends nodepath in , frontends
[ H.text "" , session } _ =
, H.a { href} [ H.text $ maybe "name" identity contact.title ] pure $ T.makeRow [
--, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ] H.text ""
, H.text $ maybe "No ContactWhere" contactWhereOrg (head $ ou) , H.a { href } [ H.text $ maybe "name" identity contact.title ]
, H.text $ maybe "No ContactWhereDept" contactWhereDept (head $ ou) --, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
, H.div {className: "nooverflow"} , H.text $ maybe "No ContactWhere" contactWhereOrg (A.head $ ou)
[ H.text $ maybe "No ContactWhereRole" contactWhereRole (head $ ou) ] ] , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
, H.div {className: "nooverflow"} [
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization" H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
contactWhereOrg (CT.ContactWhere { organization: orga }) = ]
maybe "No orga (list)" identity (head orga) ]
contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept" where
contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) = --nodepath = NodePath (sessionId session) NodeContact (Just id)
maybe "No Dept (list)" identity (head dept) nodepath = Routes.ContactPage (sessionId session) annuaireId id
contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role" href = url frontends nodepath
contactWhereRole (CT.ContactWhere { role: Just role }) = role
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
contactWhereOrg (CT.ContactWhere { organization: orga }) =
maybe "No orga (list)" identity (A.head orga)
contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
maybe "No Dept (list)" identity (A.head dept)
contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
contactWhereRole (CT.ContactWhere { role: Just role }) = role
data HyperdataAnnuaire = HyperdataAnnuaire data HyperdataAnnuaire = HyperdataAnnuaire
......
...@@ -4,13 +4,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts ...@@ -4,13 +4,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
, userLayout ) , userLayout )
where where
import Data.Array (head)
import Data.Lens as L import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd) import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested (Tuple3, (/\)) import Data.Tuple.Nested ((/\))
import Data.Newtype (unwrap)
import Data.String (joinWith)
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
...@@ -18,8 +15,8 @@ import Effect.Aff (Aff, launchAff_) ...@@ -18,8 +15,8 @@ import Effect.Aff (Aff, launchAff_)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
......
...@@ -84,7 +84,7 @@ type NgramsViewTabsProps = ...@@ -84,7 +84,7 @@ type NgramsViewTabsProps =
ngramsView :: Record NgramsViewTabsProps -> R.Element ngramsView :: Record NgramsViewTabsProps -> R.Element
ngramsView {session,mode, defaultListId, nodeId} = ngramsView {session,mode, defaultListId, nodeId} =
NT.mainNgramsTable NT.mainNgramsTable
{ nodeId, defaultListId, tabType, session, tabNgramType } { nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate: false }
where where
tabNgramType = modeTabType' mode tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode tabType = TabPairing $ TabNgramType $ modeTabType mode
...@@ -46,7 +46,7 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt ...@@ -46,7 +46,7 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt
R.fragment R.fragment
[ chart mode [ chart mode
, NT.mainNgramsTable , NT.mainNgramsTable
{session, defaultListId, nodeId: corpusId, tabType, tabNgramType} {session, defaultListId, nodeId: corpusId, tabType, tabNgramType, withAutoUpdate: false}
] ]
where where
tabNgramType = modeTabType mode tabNgramType = modeTabType mode
......
...@@ -4,9 +4,11 @@ import Prelude ...@@ -4,9 +4,11 @@ import Prelude
import Data.Array as A import Data.Array as A
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.List as L
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -20,8 +22,8 @@ type TableContainerProps = ...@@ -20,8 +22,8 @@ type TableContainerProps =
, tableBody :: Array R.Element , tableBody :: Array R.Element
) )
type Row = { row :: Array R.Element, delete :: Boolean } type Row = { row :: R.Element, delete :: Boolean }
type Rows = Array Row type Rows = L.List Row
type OrderBy = Maybe (OrderByDirection ColumnName) type OrderBy = Maybe (OrderByDirection ColumnName)
...@@ -64,6 +66,12 @@ type State = ...@@ -64,6 +66,12 @@ type State =
, orderBy :: OrderBy , orderBy :: OrderBy
} }
paramsState :: Params -> State
paramsState {offset, limit, orderBy} = {pageSize, page, orderBy}
where
pageSize = int2PageSizes limit
page = offset / limit + 1
stateParams :: State -> Params stateParams :: State -> Params
stateParams {pageSize, page, orderBy} = {offset, limit, orderBy} stateParams {pageSize, page, orderBy} = {offset, limit, orderBy}
where where
...@@ -128,44 +136,42 @@ tableCpt :: R.Component Props ...@@ -128,44 +136,42 @@ tableCpt :: R.Component Props
tableCpt = R.hooksComponent "G.C.Table.table" cpt tableCpt = R.hooksComponent "G.C.Table.table" cpt
where where
cpt {container, colNames, wrapColElts, totalRecords, rows, params} _ = do cpt {container, colNames, wrapColElts, totalRecords, rows, params} _ = do
pageSize@(pageSize' /\ setPageSize) <- R.useState' PS10
(page /\ setPage) <- R.useState' 1
(orderBy /\ setOrderBy) <- R.useState' Nothing
let let
state = {pageSize: pageSize', orderBy, page} state = paramsState $ fst params
ps = pageSizes2Int pageSize' ps = pageSizes2Int state.pageSize
totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps) totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
colHeader :: ColumnName -> R.Element colHeader :: ColumnName -> R.Element
colHeader c = H.th {scope: "col"} [ H.b {} cs ] colHeader c = H.th {scope: "col"} [ H.b {} cs ]
where where
lnk mc = effectLink (setOrderBy (const mc)) lnk mc = effectLink $ snd params $ _ { orderBy = mc }
cs :: Array R.Element cs :: Array R.Element
cs = cs =
wrapColElts c $ wrapColElts c $
case orderBy of case state.orderBy of
Just (ASC d) | c == d -> [lnk (Just (DESC c)) "ASC ", lnk Nothing (columnName c)] Just (ASC d) | c == d -> [lnk (Just (DESC c)) "ASC ", lnk Nothing (columnName c)]
Just (DESC d) | c == d -> [lnk (Just (ASC c)) "DESC ", lnk Nothing (columnName c)] Just (DESC d) | c == d -> [lnk (Just (ASC c)) "DESC ", lnk Nothing (columnName c)]
_ -> [lnk (Just (ASC c)) (columnName c)] _ -> [lnk (Just (ASC c)) (columnName c)]
R.useEffect2' params state do
when (fst params /= stateParams state) $ (snd params) (const $ stateParams state)
pure $ container pure $ container
{ pageSizeControl: sizeDD pageSize { pageSizeControl: sizeDD { params }
, pageSizeDescription: textDescription page pageSize' totalRecords , pageSizeDescription: textDescription state.page state.pageSize totalRecords
, paginationLinks: pagination setPage totalPages page , paginationLinks: pagination params totalPages
, tableBody: map _.row $ A.fromFoldable rows
, tableHead: H.tr {} (colHeader <$> colNames) , tableHead: H.tr {} (colHeader <$> colNames)
, tableBody: map (H.tr {} <<< map (\c -> H.td {} [c]) <<< _.row) rows
} }
makeRow :: Array R.Element -> R.Element
makeRow els = H.tr {} $ (\c -> H.td {} [c]) <$> els
type FilterRowsParams = type FilterRowsParams =
( (
params :: Params params :: Params
) )
filterRows :: Record FilterRowsParams -> Rows -> Rows filterRows :: forall a. Record FilterRowsParams -> L.List a -> L.List a
filterRows { params: { limit, offset, orderBy } } rs = newRs filterRows { params: { limit, offset, orderBy } } rs = newRs
where where
newRs = A.take limit $ A.drop offset $ rs newRs = L.take limit $ L.drop offset $ rs
defaultContainer :: {title :: String} -> Record TableContainerProps -> R.Element defaultContainer :: {title :: String} -> Record TableContainerProps -> R.Element
defaultContainer {title} props = R.fragment defaultContainer {title} props = R.fragment
...@@ -193,15 +199,30 @@ graphContainer {title} props = ...@@ -193,15 +199,30 @@ graphContainer {title} props =
-- , props.pageSizeDescription -- , props.pageSizeDescription
-- , props.paginationLinks -- , props.paginationLinks
sizeDD :: R.State PageSizes -> R.Element type SizeDDProps =
sizeDD (ps /\ setPageSize) = (
H.span {} [ R2.select { className, defaultValue: ps, on: {change} } sizes ] params :: R.State Params
)
sizeDD :: Record SizeDDProps -> R.Element
sizeDD p = R.createElement sizeDDCpt p []
sizeDDCpt :: R.Component SizeDDProps
sizeDDCpt = R.hooksComponent "G.C.T.sizeDD" cpt
where where
className = "form-control" cpt {params: params /\ setParams} _ = do
change e = setPageSize $ const (string2PageSize $ R2.unsafeEventValue e) pure $ H.span {} [
sizes = map option pageSizes R2.select { className, defaultValue: show pageSize, on: {change} } sizes
option size = H.option {value} [H.text value] ]
where value = show size where
{pageSize} = paramsState params
className = "form-control"
change e = do
let ps = string2PageSize $ R2.unsafeEventValue e
setParams $ \p -> stateParams $ (paramsState p) { pageSize = ps }
sizes = map option pageSizes
option size = H.option {value} [H.text value]
where value = show size
textDescription :: Int -> PageSizes -> Int -> R.Element textDescription :: Int -> PageSizes -> Int -> R.Element
textDescription currPage pageSize totalRecords = textDescription currPage pageSize totalRecords =
...@@ -212,51 +233,53 @@ textDescription currPage pageSize totalRecords = ...@@ -212,51 +233,53 @@ textDescription currPage pageSize totalRecords =
end = if end' > totalRecords then totalRecords else end' end = if end' > totalRecords then totalRecords else end'
msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords
pagination :: (R2.Setter Int) -> Int -> Int -> R.Element pagination :: R.State Params -> Int -> R.Element
pagination changePage tp cp = pagination (params /\ setParams) tp =
H.span {} $ H.span {} $
[ H.text " ", prev, first, ldots] [ H.text " ", prev, first, ldots]
<> <>
lnums lnums
<> <>
[H.b {} [H.text $ " " <> show cp <> " "]] [H.b {} [H.text $ " " <> show page <> " "]]
<> <>
rnums rnums
<> <>
[ rdots, last, next ] [ rdots, last, next ]
where where
prev = if cp == 1 then {page} = paramsState params
changePage page = setParams $ \p -> stateParams $ (paramsState p) { page = page }
prev = if page == 1 then
H.text " Prev. " H.text " Prev. "
else else
changePageLink (cp - 1) "Prev." changePageLink (page - 1) "Prev."
next = if cp == tp then next = if page == tp then
H.text " Next " H.text " Next "
else else
changePageLink (cp + 1) "Next" changePageLink (page + 1) "Next"
first = if cp == 1 then first = if page == 1 then
H.text "" H.text ""
else else
changePageLink' 1 changePageLink' 1
last = if cp == tp then last = if page == tp then
H.text "" H.text ""
else else
changePageLink' tp changePageLink' tp
ldots = if cp >= 5 then ldots = if page >= 5 then
H.text " ... " H.text " ... "
else else
H.text "" H.text ""
rdots = if cp + 3 < tp then rdots = if page + 3 < tp then
H.text " ... " H.text " ... "
else else
H.text "" H.text ""
lnums = map changePageLink' $ A.filter (1 < _) [cp - 2, cp - 1] lnums = map changePageLink' $ A.filter (1 < _) [page - 2, page - 1]
rnums = map changePageLink' $ A.filter (tp > _) [cp + 1, cp + 2] rnums = map changePageLink' $ A.filter (tp > _) [page + 1, page + 2]
changePageLink :: Int -> String -> R.Element changePageLink :: Int -> String -> R.Element
changePageLink i s = changePageLink i s =
H.span {} H.span {}
[ H.text " " [ H.text " "
, effectLink (changePage (const i)) s , effectLink (changePage i) s
, H.text " " , H.text " "
] ]
...@@ -274,6 +297,9 @@ instance showPageSize :: Show PageSizes where ...@@ -274,6 +297,9 @@ instance showPageSize :: Show PageSizes where
show PS100 = "100" show PS100 = "100"
show PS200 = "200" show PS200 = "200"
int2PageSizes :: Int -> PageSizes
int2PageSizes i = string2PageSize $ show i
pageSizes2Int :: PageSizes -> Int pageSizes2Int :: PageSizes -> Int
pageSizes2Int PS10 = 10 pageSizes2Int PS10 = 10
pageSizes2Int PS20 = 20 pageSizes2Int PS20 = 20
......
...@@ -287,6 +287,8 @@ derive instance genericScoreType :: Generic ScoreType _ ...@@ -287,6 +287,8 @@ derive instance genericScoreType :: Generic ScoreType _
instance showScoreType :: Show ScoreType where instance showScoreType :: Show ScoreType where
show = genericShow show = genericShow
type SearchQuery = String
type NgramsGetOpts = type NgramsGetOpts =
{ tabType :: TabType { tabType :: TabType
, offset :: Offset , offset :: Offset
...@@ -296,7 +298,7 @@ type NgramsGetOpts = ...@@ -296,7 +298,7 @@ type NgramsGetOpts =
, termListFilter :: Maybe TermList , termListFilter :: Maybe TermList
, termSizeFilter :: Maybe TermSize , termSizeFilter :: Maybe TermSize
, scoreType :: ScoreType , scoreType :: ScoreType
, searchQuery :: String , searchQuery :: SearchQuery
} }
type NgramsGetTableAllOpts = type NgramsGetTableAllOpts =
...@@ -472,7 +474,7 @@ asyncTaskTypePath GraphT = "async/" ...@@ -472,7 +474,7 @@ asyncTaskTypePath GraphT = "async/"
type AsyncTaskID = String type AsyncTaskID = String
data AsyncTaskStatus = Running | Failed | Finished | Killed data AsyncTaskStatus = Running | Pending | Received | Started | Failed | Finished | Killed
derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _ derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
...@@ -481,10 +483,13 @@ instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where ...@@ -481,10 +483,13 @@ instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
pure $ readAsyncTaskStatus obj pure $ readAsyncTaskStatus obj
readAsyncTaskStatus :: String -> AsyncTaskStatus readAsyncTaskStatus :: String -> AsyncTaskStatus
readAsyncTaskStatus "failed" = Failed readAsyncTaskStatus "IsFailure" = Failed
readAsyncTaskStatus "finished" = Finished readAsyncTaskStatus "IsFinished" = Finished
readAsyncTaskStatus "killed" = Killed readAsyncTaskStatus "IsKilled" = Killed
readAsyncTaskStatus "running" = Running readAsyncTaskStatus "IsPending" = Pending
readAsyncTaskStatus "IsReceived" = Received
readAsyncTaskStatus "IsRunning" = Running
readAsyncTaskStatus "IsStarted" = Started
readAsyncTaskStatus _ = Running readAsyncTaskStatus _ = Running
newtype AsyncTask = AsyncTask { newtype AsyncTask = AsyncTask {
......
module Gargantext.Utils.List where
import Data.Ord (class Ord, comparing)
import Data.List as List
-- same as
-- https://github.com/purescript/purescript-arrays/blob/v5.3.1/src/Data/Array.purs#L715-L715
sortWith :: forall a b. Ord b => (a -> b) -> List.List a -> List.List a
sortWith f = List.sortBy (comparing f)
...@@ -22,9 +22,9 @@ import Effect.Console (logShow) ...@@ -22,9 +22,9 @@ import Effect.Console (logShow)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber) import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Effect.Uncurried (EffectFn1, EffectFn3, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn3) import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2, runEffectFn3)
import Effect.Unsafe (unsafePerformEffect) import Effect.Unsafe (unsafePerformEffect)
import FFI.Simple ((..), (...), defineProperty, delay, args2, args3) import FFI.Simple ((..), (...), (.=), defineProperty, delay, args2, args3)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (class ReactPropFields, Children, ReactClass, ReactElement) import React (class ReactPropFields, Children, ReactClass, ReactElement)
import React as React import React as React
...@@ -320,3 +320,11 @@ foreign import _setCookie :: EffectFn1 String Unit ...@@ -320,3 +320,11 @@ foreign import _setCookie :: EffectFn1 String Unit
setCookie :: String -> Effect Unit setCookie :: String -> Effect Unit
setCookie = runEffectFn1 _setCookie setCookie = runEffectFn1 _setCookie
focus :: Nullable R.Element -> Effect Unit
focus nEl = case toMaybe nEl of
Nothing -> pure unit
Just el -> el ... "focus" $ []
setIndeterminateCheckbox :: R.Element -> Boolean -> Effect R.Element
setIndeterminateCheckbox el val = pure $ (el .= "indeterminate") val
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
<head> <head>
<meta charset="utf-8"/> <meta charset="utf-8"/>
<title>CNRS GarganText</title> <title>CNRS GarganText</title>
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet"> <!-- <link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet"> -->
<!--<link href="https://use.fontawesome.com/releases/v5.0.8/styles/all.css" rel="stylesheet">--> <!--<link href="https://use.fontawesome.com/releases/v5.0.8/styles/all.css" rel="stylesheet">-->
<link rel="stylesheet" href="icons/forkawesome.css"> <link rel="stylesheet" href="icons/forkawesome.css">
<!--<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/fork-awesome@1.1.7/css/fork-awesome.min.css" integrity="sha256-gsmEoJAws/Kd3CjuOQzLie5Q3yshhvmo7YNtBG7aaEY=" crossorigin="anonymous">--> <!--<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/fork-awesome@1.1.7/css/fork-awesome.min.css" integrity="sha256-gsmEoJAws/Kd3CjuOQzLie5Q3yshhvmo7YNtBG7aaEY=" crossorigin="anonymous">-->
......
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