Skip to content

P
purescript-gargantext
Commit bbd5a4e5 authored by Mudada's avatar Mudada
Browse files
Options

Merge conflict fixed

parents 7c002be7 ebfcb1c7
Hide whitespace changes
Inline Side-by-side
Showing with 1155 additions and 651 deletions
dist/styles/Tree.css
View file @ bbd5a4e5
......@@ -14,4 +14,41 @@
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 */
dist/styles/Tree.sass
View file @ bbd5a4e5
......@@ -9,3 +9,41 @@
cursor: pointer
&.disabled
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)
package.json
View file @ bbd5a4e5
{
"name": "Gargantext",
"version": "0.0.1.3.2",
"version": "0.0.1.4",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......
purs-packages.nix
View file @ bbd5a4e5
#Generated by soba https://github.com/justinwoo/soba
{ pkgs ? import ./pinned.nix {} }:
{ pkgs ? import <nixpkgs> {} }:
{
"aff" = pkgs.stdenv.mkDerivation {
......@@ -834,11 +834,11 @@
"reactix" = pkgs.stdenv.mkDerivation {
name = "reactix";
version = "v0.4.2";
version = "v0.4.3";
fetched = pkgs.fetchgit {
url = "https://github.com/irresponsible/purescript-reactix";
rev = "62c808db0884edd0651eeff5724d5a81f2dd334e";
sha256 = "0s9ic8ya6dl3ymbh5axxh7224nd3766m78pz2bgw94fxxgxy7mbc";
rev = "9305a56faeab499b86195ba33067666a625e8dad";
sha256 = "0sg80qs7siswqvwfcsggjqvn9viqhxpkr452alyyslx5c3p2xamw";
};
};
......@@ -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 {
name = "refs";
version = "v4.1.0";
......@@ -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 {
name = "web-dom";
version = "v3.0.0";
......
shell.nix
View file @ bbd5a4e5
......@@ -51,6 +51,16 @@ let
purs compile "src/**/*.purs" \
${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
pkgs.mkShell {
buildInputs = [
......@@ -60,6 +70,7 @@ pkgs.mkShell {
install-purs-packages
build-purs
build-purs-from-store
build
pkgs.yarn
];
}
......
src/Gargantext/Components/App.purs
View file @ bbd5a4e5
......@@ -7,7 +7,6 @@ import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
......
src/Gargantext/Components/DocsTable.purs
View file @ bbd5a4e5
......@@ -10,6 +10,7 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.List as L
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
......@@ -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
localCategories <- R.useState' (mempty :: LocalCategories)
pure $ T.table
{ rows: rows localCategories
{ colNames
, container: T.defaultContainer { title: "Documents" }
, params, colNames, totalRecords, wrapColElts }
, params
, rows: L.fromFoldable $ rows localCategories
, totalRecords
, wrapColElts
}
where
sid = sessionId session
gi Favorite = "glyphicon glyphicon-star"
......@@ -409,7 +414,7 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
where
row (DocumentsView r) =
{ 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
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only
......
src/Gargantext/Components/FacetsTable.purs
View file @ bbd5a4e5
......@@ -8,6 +8,7 @@ import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyO
import Data.Array (concat, filter)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.List as L
import Data.Maybe (Maybe(..))
import Data.Set (Set)
import Data.Set as Set
......@@ -332,18 +333,19 @@ pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt
documentUrl id =
url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
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:
[ 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
, maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
, maybeStricken delete [ H.text source ]
, maybeStricken delete [ H.text authors ]
-- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
, H.input { type: "checkbox", checked: isChecked id, on: { click: toggleClick } }
]
, maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
, maybeStricken delete [ H.text source ]
, maybeStricken delete [ H.text authors ]
-- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
, H.input { type: "checkbox", checked: isChecked id, on: { click: toggleClick } }
]
, delete: true }
where
markClick _ = markCategory session nodeId category [id]
......
src/Gargantext/Components/Forest/Tree.purs
View file @ bbd5a4e5
......@@ -24,12 +24,11 @@ import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT
type CommonProps =
(
frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute
, openNodes :: R.State OpenNodes
, reload :: R.State Reload
, session :: Session
( frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute
, openNodes :: R.State OpenNodes
, reload :: R.State Reload
, session :: Session
)
------------------------------------------------------------------------
......@@ -93,16 +92,16 @@ toHtml p@{ frontends
, tasks: tasks@(asyncTasks /\ setAsyncTasks)
, tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
el = R.hooksComponent "NodeView" cpt
commonProps = RecordE.pick p :: Record CommonProps
pAction = performAction (RecordE.pick p :: Record PerformActionProps)
pAction = performAction (RecordE.pick p :: Record PerformActionProps)
cpt _ _ = do
let nodeId = mkNodeId session id
let folderIsOpen = Set.member nodeId (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert
let nodeId = mkNodeId session id
let folderIsOpen = Set.member nodeId (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert
let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
let withId (NTree (LNode {id: id'}) _) = id'
......@@ -154,28 +153,27 @@ childNodes props@{ children } =
el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, asyncTasks} _ = do
tasks <- R.useState' asyncTasks
pure $ toHtml (Record.merge commonProps
{ tasks, tree })
pure $ toHtml (Record.merge commonProps { tasks, tree })
type PerformActionProps =
( openNodes :: R.State OpenNodes
, reload :: R.State Reload
, session :: Session
, tasks :: R.State (Array GT.AsyncTaskWithType)
, tree :: FTree
, reload :: R.State Reload
, session :: Session
, tasks :: R.State (Array GT.AsyncTaskWithType)
, tree :: FTree
)
performAction :: Record PerformActionProps
-> Action
-> Aff Unit
performAction { openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } DeleteNode = do
performAction p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } DeleteNode = do
void $ deleteNode session id
liftEffect do
setOpenNodes (Set.delete (mkNodeId session id))
setReload (_ + 1)
performAction p RefreshTree
performAction { reload: (_ /\ setReload)
, session
......@@ -183,23 +181,21 @@ performAction { reload: (_ /\ setReload)
, tree: (NTree (LNode {id}) _) } (SearchQuery task) = do
liftEffect $ setAsyncTasks $ A.cons task
liftEffect $ log2 "[performAction] SearchQuery task:" task
liftEffect $ setReload (_ + 1)
performAction { reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (Submit name) = do
performAction p@{ reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (Submit name) = do
void $ renameNode session id $ RenameValue {name}
liftEffect do
setReload (_ + 1)
performAction p RefreshTree
performAction { openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
performAction p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
void $ createNode session id $ CreateValue {name, nodeType}
liftEffect do
setOpenNodes (Set.insert (mkNodeId session id))
setReload (_ + 1)
performAction p RefreshTree
performAction { session
, tasks: (_ /\ setAsyncTasks)
......@@ -207,3 +203,6 @@ performAction { session
task <- uploadFile session nodeType id fileType {mName, contents}
liftEffect $ setAsyncTasks $ A.cons task
liftEffect $ log2 "uploaded, task:" task
performAction { reload: (_ /\ setReload) } RefreshTree = do
liftEffect $ setReload (_ + 1)
src/Gargantext/Components/Forest/Tree/Node.purs
View file @ bbd5a4e5
......@@ -143,10 +143,10 @@ settingsBox Corpus = SettingsBox {
, edit : true
, doc : Documentation Corpus
, buttons : [ SearchBox
{- , Add [ NodeList
, Add [ NodeList
, Graph
, Dashboard
] -}
]
, Upload
, Download
--, Share
......
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ bbd5a4e5
......@@ -19,6 +19,7 @@ data Action = CreateSubmit String GT.NodeType
| SearchQuery GT.AsyncTaskWithType
| Submit String
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| RefreshTree
-----------------------------------------------------
-- UploadFile Action
......
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ bbd5a4e5
......@@ -34,7 +34,7 @@ createNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt {id, name} _ = do
nodeName <- R.useState' "Default Name"
nodeName <- R.useState' "Name"
nodeType' <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
pure $ H.div {}
[ panelBody readNodeType nodeName nodeType'
......
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ bbd5a4e5
......@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Box where
import Gargantext.Prelude
import DOM.Simple as DOM
import Data.Maybe (Maybe(..))
import Data.Nullable (null)
import Data.Tuple (fst, Tuple(..))
......@@ -12,21 +13,14 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_)
import Effect.Class (liftEffect)
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.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
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.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.Lang (allLangs, Lang(EN))
import Gargantext.Components.Search.SearchBar (searchBar)
import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex)
import Gargantext.Ends (Frontends, url)
......@@ -39,6 +33,12 @@ import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Popover as Popover
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.Window
......@@ -93,13 +93,17 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
else H.div {} []
, 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 } ]
, nodeActions { id, nodeType, session }
, nodeActions { id
, nodeType
, refreshTree: const $ dispatch RefreshTree
, session }
, fileTypeView {dispatch, droppedFile, id, isDragOver, nodeType}
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie
, corpusId: id
, onFinish: \_ -> onAsyncTaskFinish t
, onFinish: const $ onAsyncTaskFinish t
, session }) asyncTasks)
]
where
......@@ -198,6 +202,7 @@ type NodeActionsProps =
(
id :: ID
, nodeType :: GT.NodeType
, refreshTree :: Unit -> Aff Unit
, session :: Session
)
......@@ -207,24 +212,21 @@ nodeActions p = R.createElement nodeActionsCpt p []
nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = R.hooksComponent "G.C.F.T.N.B.nodeActions" cpt
where
cpt { id, nodeType: GT.Graph, session } _ = do
refresh <- R.useState' 0
useLoader (id /\ fst refresh) (graphVersions session) $ \gv ->
nodeActionsGraph { id, graphVersions: gv, session, triggerRefresh: triggerRefresh refresh }
cpt { id, nodeType: GT.Graph, refreshTree, session } _ = do
useLoader id (graphVersions session) $ \gv ->
nodeActionsGraph { id, graphVersions: gv, session, triggerRefresh: triggerRefresh refreshTree }
cpt _ _ = do
pure $ H.div {} []
graphVersions session (graphId /\ _) =
GEAPI.graphVersions { graphId, session }
triggerRefresh (_ /\ setRefresh) _ = setRefresh $ (+) 1
graphVersions session graphId = GEAPI.graphVersions { graphId, session }
triggerRefresh refreshTree = refreshTree
type NodeActionsGraphProps =
(
id :: ID
, graphVersions :: Record GEAPI.GraphVersions
, session :: Session
, triggerRefresh :: Unit -> Effect Unit
, triggerRefresh :: Unit -> Aff Unit
)
nodeActionsGraph :: Record NodeActionsGraphProps -> R.Element
......@@ -245,7 +247,7 @@ type GraphUpdateButtonProps =
(
id :: ID
, session :: Session
, triggerRefresh :: Unit -> Effect Unit
, triggerRefresh :: Unit -> Aff Unit
)
graphUpdateButton :: Record GraphUpdateButtonProps -> R.Element
......@@ -268,15 +270,29 @@ graphUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.graphUpdateButton" cpt
liftEffect $ setEnabled $ const false
g <- GEAPI.updateGraphVersions { graphId: id, session }
liftEffect $ setEnabled $ const true
liftEffect $ triggerRefresh unit
triggerRefresh unit
pure unit
-- END nodeActions
mCorpusId :: Maybe AppRoute -> Maybe Int
mCorpusId (Just (Routes.Corpus _ id)) = Just id
mCorpusId (Just (Routes.CorpusDocument _ id _ _)) = Just id
mCorpusId _ = Nothing
mAppRouteId :: Maybe AppRoute -> Maybe Int
mAppRouteId (Just (Routes.Folder _ id)) = Just id
mAppRouteId (Just (Routes.FolderPrivate _ id)) = Just id
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
......
src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs
View file @ bbd5a4e5
......@@ -19,9 +19,13 @@ import Reactix as R
import Reactix.DOM.HTML as H
data BarType = Bar | Pie
type Props =
(
asyncTask :: GT.AsyncTaskWithType
, barType :: BarType
, corpusId :: ID
, onFinish :: Unit -> Effect Unit
, session :: Session
......@@ -32,9 +36,9 @@ asyncProgressBar :: Record Props -> R.Element
asyncProgressBar p = R.createElement asyncProgressBarCpt p []
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
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
intervalIdRef <- R.useRef Nothing
......@@ -57,16 +61,41 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
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 $
H.div { className: "progress" } [
H.div { className: "progress-bar"
, role: "progressbar"
, style: { width: (show $ toInt progress) <> "%" }
} [ H.text id ]
, style: { width: (show $ progress) <> "%" }
} [ H.text label ]
]
toInt :: Number -> Int
toInt n = unsafePartial $ fromJust $ fromNumber n
cpt { barType: Pie, label, progress } _ = do
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 {asyncTask: GT.AsyncTaskWithType {task: GT.AsyncTask {id}, typ}, corpusId, session} = get session p
......
src/Gargantext/Components/Login.purs
View file @ bbd5a4e5
......@@ -3,11 +3,12 @@
-- Select a backend and log into it
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.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Data.String as DST
import DOM.Simple.Console (log)
import Data.Sequence as DS
......@@ -18,7 +19,7 @@ import Reactix as R
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.Ends (Backend(..))
import Gargantext.Sessions (Session, Sessions(..), postAuthRequest, unSessions)
......@@ -32,7 +33,8 @@ import Gargantext.Utils.Reactix as R2
type Props =
( backends :: Array Backend
, sessions :: R2.Reductor Sessions Sessions.Action
, visible :: R.State Boolean )
, visible :: R.State Boolean
)
type ModalProps = ( visible :: R.State Boolean )
......@@ -53,15 +55,15 @@ modalCpt = R.hooksComponent "G.C.Login.modal" cpt where
[ H.div { className: "modal-header" }
[ closing
, logo
, H.h2 { className: "center modal-title" } [H.text "Instances manager"]
]
, H.div { className: "modal-body" } children ] ] ] ]
modalClass s = "modal myModal" <> if s then "" else " fade"
logo =
H.div {className: "col-md-10 col-md-push-1"}
[ 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"
, "data": { dismiss: "modal" } }
......@@ -85,7 +87,7 @@ loginCpt = R.hooksComponent "G.C.Login.login" cpt
modal {visible} $
case fst backend of
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 )
......@@ -96,8 +98,9 @@ chooserCpt :: R.Component ChooserProps
chooserCpt = R.staticComponent "G.C.Login.chooser" cpt where
cpt :: Record ChooserProps -> Array R.Element -> R.Element
cpt {backend, backends, sessions} _ =
R.fragment $ active <> new <> search
R.fragment $ title <> active <> new <> search
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)"]
, H.ul {} [ renderSessions sessions]
] else [] where
......@@ -146,7 +149,8 @@ renderBackend state backend@(Backend {name}) =
type FormProps =
( backend :: Backend
, sessions :: R2.Reductor Sessions Sessions.Action
, visible :: R.State Boolean )
, visible :: R.State Boolean
)
form :: Record FormProps -> R.Element
form props = R.createElement formCpt props []
......@@ -155,28 +159,36 @@ formCpt :: R.Component FormProps
formCpt = R.hooksComponent "G.C.Login.form" cpt where
cpt :: Record FormProps -> Array R.Element -> R.Hooks R.Element
cpt props@{backend, sessions, visible} _ = do
error <- R.useState' ""
error <- R.useState' ""
username <- R.useState' ""
password <- R.useState' ""
setBox@(checkBox /\ setCheckBox) <- R.useState' false
pure $ R2.row
[ cardGroup
[ card
[ cardBlock
[ center
[ H.h4 {className: "m-b-0"}
[ H.span {className: "icon-text"} [ H.text "Welcome :)" ] ]
, H.p {className: "text-muted"}
[ H.text $ "Login to your account or", requestAccessLink {} ] ]
, H.div {}
[ csrfTokenInput {}
, formGroup [ H.p {} [ H.text (fst error) ], usernameInput username ]
, formGroup [ passwordInput password, clearfix {} ]
, center
[ H.label {}
[ H.div {className: "checkbox"}
[ termsCheckbox {}, H.text "I accept the terms of use ", termsLink {} ] ]
, loginSubmit $
onClick props error username password ] ] ] ] ] ]
[ cardBlock
[ center
[ H.div {className: "text-muted"}
[ H.text $ "Login to garg://" <> show backend]
, requestAccessLink {}
]
, H.div {}
[ csrfTokenInput {}
, formGroup [ H.p {} [ H.text (fst error) ], usernameInput username ]
, formGroup [ passwordInput password, clearfix {} ]
, center
[ H.label {}
[ H.div {className: "checkbox"}
[ termsCheckbox setBox , H.text "I accept the terms of use ", termsLink {} ] ]
]
]
, 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 =
launchAff_ $ do
let req = AuthRequest {username: fst username, password: fst password}
......@@ -193,13 +205,18 @@ csrfTokenInput _ =
H.input { type: "hidden", name: "csrfmiddlewaretoken"
, value: csrfMiddlewareToken }-- TODO hard-coded CSRF token
termsCheckbox :: {} -> R.Element
termsCheckbox _ =
H.input { id: "terms-accept", type: "checkbox", value: "", className: "checkbox" }
termsCheckbox :: R.State Boolean -> R.Element
termsCheckbox setCheckBox =
H.input { id: "terms-accept"
, type: "checkbox"
, value: fst setCheckBox
, className: "checkbox"
, on: { click: \_ -> (snd setCheckBox) $ const $ not (fst setCheckBox)}
}
termsLink :: {} -> R.Element
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"
requestAccessLink :: {} -> R.Element
......
src/Gargantext/Components/NgramsTable.purs
View file @ bbd5a4e5
......@@ -5,45 +5,42 @@ module Gargantext.Components.NgramsTable
import Data.Array as A
import Data.FunctorWithIndex (mapWithIndex)
import Data.Lens (Lens', to, view, (%~), (.~), (^.), (^..), (^?))
import Data.Lens (Lens', to, (%~), (.~), (^.), (^?))
import Data.Lens.At (at)
import Data.Lens.Common (_Just)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.Lens.Record (prop)
import Data.List as List
import Data.List (List, filter, length) as L
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Maybe (Maybe(..), isNothing, maybe)
import Data.Monoid.Additive (Additive(..))
import Data.Ord.Down (Down(..))
import Data.Set (Set)
import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), snd)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||))
import Reactix as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Loader (loader)
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Core (CoreState, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, PageParams, PatchMap(..), Replace, Versioned(..), VersionedNgramsTable, _NgramsElement, _NgramsTable, _PatchMap, _children, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsPatches, applyPatchSet, commitPatch, convOrderBy, fromNgramsPatches, initialPageParams, loadNgramsTableAll, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncPatches)
import Gargantext.Components.NgramsTable.Core (Action(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, _NgramsElement, _NgramsTable, _children, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsPatches, applyPatchSet, commitPatchR, convOrderBy, fromNgramsPatches, initialPageParams, loadNgramsTableAll, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncPatchesR)
import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.Table as T
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList, readTermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), readTermList, readTermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel, toggleSet)
import Gargantext.Utils.List (sortWith) as L
import Gargantext.Utils.Reactix as R2
import Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (+), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), otherwise, when)
import React (ReactClass, ReactElement, Children)
import React.DOM (a, i, input, li, span, text, ul)
import React.DOM.Props (_type, checked, className, onChange, onClick, style, readOnly)
import React.DOM.Props as DOM
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (modifyState_)
import Thermite as Thermite
import Unsafe.Coerce (unsafeCoerce)
type State =
type State' =
CoreState
( ngramsParent :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
, ngramsChildren :: Map NgramsTerm Boolean
......@@ -53,51 +50,48 @@ type State =
-- be removed.
, ngramsSelection :: Set NgramsTerm
-- ^ The set of selected checkboxes of the first column.
, ngramsSelectAll :: Boolean
-- ^ The checkbox to select all the checkboxes of the first column.
)
_ngramsChildren :: forall row. Lens' { ngramsChildren :: Map NgramsTerm Boolean | row } (Map NgramsTerm Boolean)
_ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")
_ngramsSelectAll :: forall row. Lens' { ngramsSelectAll :: Boolean | row } Boolean
_ngramsSelectAll = prop (SProxy :: SProxy "ngramsSelectAll")
_ngramsSelection :: forall row. Lens' { ngramsSelection :: Set NgramsTerm | row } (Set NgramsTerm)
_ngramsSelection = prop (SProxy :: SProxy "ngramsSelection")
initialState :: VersionedNgramsTable -> State
initialState (Versioned {version}) =
{ ngramsLocalPatch: mempty
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
-- ^ Used only when grouping.
-- This updates the children of `ngramsParent`,
-- ngrams set to `true` are to be added, and `false` to
-- be removed.
, ngramsParent :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
, ngramsSelection :: Set NgramsTerm
-- ^ The set of selected checkboxes of the first column.
)
initialState :: VersionedNgramsTable -> State
initialState (Versioned {version}) = {
ngramsChildren: mempty
, ngramsLocalPatch: mempty
, ngramsParent: Nothing
, ngramsChildren: mempty
, ngramsSelectAll: false
, ngramsSelection: mempty
, ngramsStagePatch: mempty
, ngramsValidPatch: mempty
, ngramsVersion: version
}
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
setTermListA :: NgramsTerm -> Replace TermList -> Action
setTermListA n patch_list =
CommitPatch $
singletonNgramsTablePatch n $
NgramsPatch { patch_list, patch_children: mempty }
setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
setTermListSetA ngramsTable ns new_list =
CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
......@@ -115,256 +109,257 @@ setTermListSetA ngramsTable ns new_list =
addNewNgramA :: NgramsTerm -> Action
addNewNgramA ngram = CommitPatch $ addNewNgram ngram CandidateTerm
type Dispatch = Action -> Effect Unit
type PreConversionRows = L.List (Tuple NgramsTerm NgramsElement)
tableContainer :: { path :: R.State PageParams
, dispatch :: Dispatch
, ngramsParent :: Maybe NgramsTerm
, ngramsChildren :: Map NgramsTerm Boolean
, ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable
, tabNgramType :: CTabNgramType
, ngramsSelectAll :: Boolean
}
-> Record T.TableContainerProps -> R.Element
tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, dispatch
, ngramsParent
, ngramsChildren
, ngramsSelection
, ngramsTable: ngramsTableCache
, tabNgramType
, ngramsSelectAll
} props =
H.div {className: "container-fluid"}
[ H.div {className: "jumbotron1"}
[ R2.row
[ H.div {className: "panel panel-default"}
[ H.div {className: "panel-heading"}
[ H.h2 {className: "panel-title", style: {textAlign : "center"}}
[ H.span {className: "glyphicon glyphicon-hand-down"} []
, H.text "Extracted Terms"
]
, R2.row
[ H.div {className: "col-md-3", style: {marginTop: "6px"}}
[ H.input { className: "form-control"
, name: "search"
, placeholder: "Search"
, type: "value"
, value: searchQuery
, on: {input: setSearchQuery <<< R2.unsafeEventValue}}
, H.div {} (
if A.null props.tableBody && searchQuery /= "" then [
H.button { className: "btn btn-primary"
, on: {click: const $ dispatch
$ addNewNgramA
$ normNgram tabNgramType searchQuery
}
}
[ H.text ("Add " <> searchQuery) ]
] else [])]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: " list-group-item"}
[ R2.select { id: "picklistmenu"
, className: "form-control custom-select"
, value: (maybe "" show termListFilter)
, on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}}
(map optps1 termLists)]]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype"
, className: "form-control custom-select"
, value: (maybe "" show termSizeFilter)
, on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}}
(map optps1 termSizes)]]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
[ H.li {className: " list-group-item"}
[ props.pageSizeDescription
, props.pageSizeControl
, H.text " items / "
, props.paginationLinks]]
]]
, H.div {}
(maybe [] (\ngrams ->
let
ngramsTable =
ngramsTableCache # at ngrams
<<< _Just
<<< _NgramsElement
<<< _children
%~ applyPatchSet (patchSetFromMap ngramsChildren)
ngramsClick {depth: 1, ngrams: child} =
Just $ dispatch $ ToggleChild false child
ngramsClick _ = Nothing
ngramsEdit _ = Nothing
in
[ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, R2.buff $ renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
, H.button {className: "btn btn-primary", on: {click: (const $ dispatch AddTermChildren)}} [H.text "Save"]
, H.button {className: "btn btn-secondary", on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}} [H.text "Cancel"]
]) ngramsParent)
, selectAllButtons ngramsSelectAll
, H.div {id: "terms_table", className: "panel-body"}
[ H.table {className: "table able"}
[ H.thead {className: "tableHeader"} [props.tableHead]
, H.tbody {} props.tableBody] ]
, selectAllButtons ngramsSelectAll
type TableContainerProps =
( dispatch :: Dispatch
, ngramsChildren :: Map NgramsTerm Boolean
, ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable
, path :: R.State PageParams
, tabNgramType :: CTabNgramType
)
tableContainer :: Record TableContainerProps -> Record T.TableContainerProps -> R.Element
tableContainer p q = R.createElement (tableContainerCpt p) q []
tableContainerCpt :: Record TableContainerProps -> R.Component T.TableContainerProps
tableContainerCpt { dispatch
, ngramsChildren
, ngramsParent
, ngramsSelection
, ngramsTable: ngramsTableCache
, path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, tabNgramType
} = R.hooksComponent "G.C.NT.tableContainer" cpt
where
cpt props _ = do
pure $ H.div {className: "container-fluid"} [
H.div {className: "jumbotron1"}
[ R2.row
[ H.div {className: "panel panel-default"}
[ H.div {className: "panel-heading"}
[ H.h2 {className: "panel-title", style: {textAlign : "center"}}
[ H.span {className: "glyphicon glyphicon-hand-down"} []
, H.text "Extracted Terms"
]
, R2.row
[ H.div {className: "col-md-3", style: {marginTop: "6px"}}
[ H.div {} (
if A.null props.tableBody && searchQuery /= "" then [
H.button { className: "btn btn-primary"
, on: { click: const $ dispatch
$ addNewNgramA
$ normNgram tabNgramType searchQuery
}
}
[ H.text ("Add " <> searchQuery) ]
] else []
)
]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"}
[ R2.select { id: "picklistmenu"
, className: "form-control custom-select"
, defaultValue: (maybe "" show termListFilter)
, on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}}
(map optps1 termLists)]
]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype"
, className: "form-control custom-select"
, defaultValue: (maybe "" show termSizeFilter)
, on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}}
(map optps1 termSizes)]
]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
[ H.li {className: "list-group-item"}
[ props.pageSizeDescription
, props.pageSizeControl
, H.text " items / "
, props.paginationLinks ]
]
]
]
, editor
, selectButtons (selectionsExist ngramsSelection)
, H.div {id: "terms_table", className: "panel-body"}
[ H.table {className: "table able"}
[ H.thead {className: "tableHeader"} [props.tableHead]
, H.tbody {} props.tableBody]
]
, selectButtons (selectionsExist ngramsSelection)
]
]
where
]
]
-- WHY setPath f = origSetPageParams (const $ f path)
setSearchQuery x = setPath $ _ { searchQuery = x }
setTermListFilter x = setPath $ _ { termListFilter = x }
setTermSizeFilter x = setPath $ _ { termSizeFilter = x }
setSelection = dispatch <<< setTermListSetA ngramsTableCache ngramsSelection
selectAllButtons false = H.div {} []
selectAllButtons true =
editor = H.div {} $ maybe [] f ngramsParent
where
f ngrams = [
H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, NTC.renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
, H.button {className: "btn btn-primary", on: {click: (const $ dispatch AddTermChildren)}} [H.text "Save"]
, H.button {className: "btn btn-secondary", on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}} [H.text "Cancel"]
]
where
ngramsTable = ngramsTableCache # at ngrams
<<< _Just
<<< _NgramsElement
<<< _children
%~ applyPatchSet (patchSetFromMap ngramsChildren)
ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
ngramsClick _ = Nothing
ngramsEdit _ = Nothing
selectionsExist :: Set NgramsTerm -> Boolean
selectionsExist = not <<< Set.isEmpty
selectButtons false = H.div {} []
selectButtons true =
H.li {className: " list-group-item"} [
H.button { className: "btn btn-primary"
, on: {click: const $ setSelection GraphTerm }
} [ H.text "Map" ]
, on: { click: const $ setSelection GraphTerm }
} [ H.text "Map" ]
, H.button { className: "btn btn-primary"
, on: {click: const $ setSelection StopTerm }
} [ H.text "Stop" ]
, on: { click: const $ setSelection StopTerm }
} [ H.text "Stop" ]
, H.button { className: "btn btn-primary"
, on: {click: const $ setSelection CandidateTerm }
} [ H.text "Candidate" ]
, on: { click: const $ setSelection CandidateTerm }
} [ H.text "Candidate" ]
]
toggleMaybe :: forall a. a -> Maybe a -> Maybe a
toggleMaybe _ (Just _) = Nothing
toggleMaybe b Nothing = Just b
-- NEXT
data Action'
= SetParentResetChildren' (Maybe NgramsTerm)
| ToggleChild' (Maybe NgramsTerm) NgramsTerm
| Synchronize'
-- NEXT
type Props =
( path :: R.State PageParams
, versioned :: VersionedNgramsTable )
, state :: R.State State
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean
)
-- NEXT
loadedNgramsTable :: Record Props -> R.Element
loadedNgramsTable props = R.createElement loadedNgramsTableCpt props []
loadedNgramsTable p = R.createElement loadedNgramsTableCpt p []
-- NEXT
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponent "G.C.NgramsTable.loadedNgramsTable" cpt
loadedNgramsTableCpt = R.hooksComponent "G.C.NT.loadedNgramsTable" cpt
where
cpt {versioned} _ = do
state <- useNgramsReducer (initialState versioned)
pure $ R.fragment []
useNgramsReducer :: State -> R.Hooks (R.Reducer State Action')
useNgramsReducer init = R2.useReductor' performNgramsAction init
performNgramsAction :: Action' -> State -> Effect State
performNgramsAction (SetParentResetChildren' term) = pure -- TODO
performNgramsAction (ToggleChild' b c) = pure -- TODO
performNgramsAction Synchronize' = pure -- TODO
type LoadedNgramsTableProps =
( tabNgramType :: CTabNgramType
, path :: R.State PageParams
, versioned :: VersionedNgramsTable
)
loadedNgramsTableSpec :: Thermite.Spec State (Record LoadedNgramsTableProps) Action
loadedNgramsTableSpec = Thermite.simpleSpec performAction render
where
setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }
performAction :: Thermite.PerformAction State (Record LoadedNgramsTableProps) Action
performAction (SetParentResetChildren p) _ _ =
modifyState_ $ setParentResetChildren p
performAction (ToggleChild b c) _ _ =
modifyState_ $ _ngramsChildren <<< at c %~ toggleMaybe b
performAction (ToggleSelect c) _ _ =
modifyState_ $ _ngramsSelection <<< at c %~ toggleMaybe unit
performAction ToggleSelectAll _ { ngramsSelectAll: true } =
modifyState_ $ (_ngramsSelection .~ mempty)
<<< (_ngramsSelectAll .~ false)
performAction ToggleSelectAll { versioned: Versioned { data: initTable } }
state =
let
ngramsTable = applyNgramsPatches state initTable
roots = rootsOf ngramsTable
in
modifyState_ $ (_ngramsSelection .~ roots)
<<< (_ngramsSelectAll .~ true)
performAction Synchronize {path: path /\ _} state = do
syncPatches path state
performAction (CommitPatch pt) _ {ngramsVersion} =
commitPatch (Versioned {version: ngramsVersion, data: pt})
performAction AddTermChildren _ {ngramsParent: Nothing} =
-- impossible but harmless
pure unit
performAction AddTermChildren _
{ ngramsParent: Just parent
, ngramsChildren
, ngramsVersion
} = do
modifyState_ $ setParentResetChildren Nothing
commitPatch (Versioned {version: ngramsVersion, data: pt})
where
pc = patchSetFromMap ngramsChildren
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch parent pe
render :: Thermite.Render State (Record LoadedNgramsTableProps) Action
render dispatch { path: path@({searchQuery, scoreType, params, termListFilter} /\ setPath)
, versioned: Versioned { data: initTable }
, tabNgramType }
state@{ ngramsParent, ngramsChildren, ngramsLocalPatch
, ngramsSelection, ngramsSelectAll }
_reactChildren =
[ autoUpdateElt { duration: 5000, effect: dispatch Synchronize }
, R2.scuff $ T.table { colNames
, container
, params: params /\ setParams -- TODO-LENS
, rows: filteredRows
, totalRecords
, wrapColElts
}
]
cpt { path: path@(path'@{searchQuery, scoreType, params, termListFilter} /\ setPath)
, state: (state@{ ngramsChildren
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsVersion } /\ setState)
, tabNgramType
, versioned: Versioned { data: initTable }
, withAutoUpdate } _ = do
pure $ R.fragment $
autoUpdate <> resetSaveButtons <> [
search
, T.table { colNames
, container: tableContainer { dispatch: performAction
, ngramsChildren
, ngramsParent
, ngramsSelection
, ngramsTable
, path
, tabNgramType
}
, params: params /\ setParams -- TODO-LENS
, rows: filteredConvertedRows
, totalRecords
, wrapColElts: wrapColElts { allNgramsSelected
, dispatch: performAction
, ngramsSelection
}
}
]
where
totalRecords = A.length rows
autoUpdate :: Array R.Element
autoUpdate = if withAutoUpdate then [ R2.buff $ autoUpdateElt { duration: 5000, effect: performAction Synchronize } ] else []
resetButton :: R.Element
resetButton = H.button { className: "btn btn-primary"
, on: { click: \_ -> performAction ResetPatches } } [ H.text "Reset" ]
saveButton :: R.Element
saveButton = H.button { className: "btn btn-primary"
, on: { click: \_ -> performAction Synchronize }} [ H.text "Save" ]
resetSaveButtons :: Array R.Element
resetSaveButtons = if ngramsLocalPatch == mempty then [] else
[ H.div {} [ resetButton, saveButton ] ]
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 Nothing $ const (Just b)) 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 Synchronize = syncPatchesR path' (state /\ setState)
performAction (CommitPatch pt) =
commitPatchR (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
performAction ResetPatches =
setState $ \s -> s { ngramsLocalPatch = { ngramsNewElems: mempty, ngramsPatches: mempty } }
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
commitPatchR (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
totalRecords = L.length rows
filteredConvertedRows :: T.Rows
filteredConvertedRows = convertRow <$> filteredRows
filteredRows :: PreConversionRows
filteredRows = T.filterRows { params } rows
colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
selected =
input
[ _type "checkbox"
, className "checkbox"
, checked ngramsSelectAll
, onChange $ const $ dispatch $ ToggleSelectAll
]
-- This is used to *decorate* the Select header with the checkbox.
wrapColElts (T.ColumnName "Select") = const [R2.buff selected]
wrapColElts (T.ColumnName "Score") = (_ <> [H.text ("(" <> show scoreType <> ")")])
wrapColElts _ = identity
container = tableContainer {path, dispatch, ngramsParent, ngramsChildren, ngramsSelection, ngramsTable, tabNgramType, ngramsSelectAll}
setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
ngramsTable = applyNgramsPatches state initTable
orderWith =
case convOrderBy <$> params.orderBy of
Just ScoreAsc -> A.sortWith \x -> (snd x) ^. _NgramsElement <<< _occurrences
Just ScoreDesc -> A.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _occurrences
_ -> identity -- the server ordering is enough here
rows = convertRow <$> orderWith (addOcc <$> Map.toUnfoldable (Map.filter displayRow (ngramsTable ^. _NgramsTable)))
addOcc (Tuple ne ngramsElement) =
rows :: PreConversionRows
rows = orderWith (
addOccT <$> (
L.filter rowsFilterT $ Map.toUnfoldable (ngramsTable ^. _NgramsTable)
)
)
rowsFilter :: NgramsElement -> Boolean
rowsFilter = displayRow state searchQuery ngramsTable ngramsParentRoot termListFilter
rowsFilterT = rowsFilter <<< snd
addOccWithFilter ne ngramsElement =
if rowsFilter ngramsElement then
Just $ addOcc ne ngramsElement
else
Nothing
addOcc ne ngramsElement =
let Additive occurrences = sumOccurrences ngramsTable ngramsElement in
Tuple ne (ngramsElement # _NgramsElement <<< _occurrences .~ occurrences)
ngramsElement # _NgramsElement <<< _occurrences .~ occurrences
addOccT (Tuple ne ngramsElement) = Tuple ne $ addOcc ne ngramsElement
allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
ngramsTable = applyNgramsPatches state initTable
roots = rootsOf ngramsTable
ngramsParentRoot :: Maybe NgramsTerm
ngramsParentRoot =
(\np -> ngramsTable ^? at np
......@@ -374,37 +369,72 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
<<< _Just
) =<< ngramsParent
displayRow (NgramsElement {ngrams, root, list}) =
root == Nothing
-- ^ Display only nodes without parents
&& ngramsChildren ^. at ngrams /= Just true
-- ^ and which are not scheduled to be added already
&& Just ngrams /= ngramsParent
-- ^ and which are not our new parent
&& Just ngrams /= ngramsParentRoot
-- ^ and which are not the root of our new parent
&& queryMatchesLabel searchQuery (ngramsTermText ngrams)
-- ^ and which matches the search query.
&& maybe true (_ == list) termListFilter
-- ^ and which matches the ListType filter.
|| ngramsChildren ^. at ngrams == Just false
-- ^ unless they are scheduled to be removed.
|| tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ unless they are being processed at the moment.
convertRow (Tuple ngrams ngramsElement) =
{ row: R2.buff <$> renderNgramsItem { ngramsTable, ngrams,
ngramsLocalPatch,
ngramsParent, ngramsElement,
ngramsSelection, dispatch }
{ row: NTC.renderNgramsItem { dispatch: performAction
, ngrams
, ngramsElement
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsTable }
, delete: false
}
orderWith =
case convOrderBy <$> params.orderBy of
Just ScoreAsc -> L.sortWith \x -> (snd x) ^. _NgramsElement <<< _occurrences
Just ScoreDesc -> L.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _occurrences
Just TermAsc -> L.sortWith \x -> (snd x) ^. _NgramsElement <<< _ngrams
Just TermDesc -> L.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _ngrams
_ -> identity -- the server ordering is enough here
colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
-- This is used to *decorate* the Select header with the checkbox.
wrapColElts scProps (T.ColumnName "Select") = const [NTC.selectionCheckbox scProps]
wrapColElts _ (T.ColumnName "Score") = (_ <> [H.text ("(" <> show scoreType <> ")")])
wrapColElts _ _ = identity
setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
loadedNgramsTableClass :: ReactClass { children :: Children | LoadedNgramsTableProps }
loadedNgramsTableClass = Thermite.createClass "LoadedNgramsNgramsTable"
loadedNgramsTableSpec (\{versioned} -> initialState versioned)
search :: R.Element
search = NTC.searchInput { key: "search-input"
, onSearch: setSearchQuery
, searchQuery: searchQuery }
setSearchQuery :: String -> Effect Unit
setSearchQuery x = setPath $ _ { searchQuery = x }
displayRow :: State -> SearchQuery -> NgramsTable -> Maybe NgramsTerm -> Maybe TermList -> NgramsElement -> Boolean
displayRow state@{ ngramsChildren
, ngramsLocalPatch
, ngramsParent }
searchQuery
ngramsTable
ngramsParentRoot
termListFilter
(NgramsElement {ngrams, root, list}) =
isNothing root
-- ^ Display only nodes without parents
&& maybe true (_ == list) termListFilter
-- ^ and which matches the ListType filter.
&& queryMatchesLabel searchQuery (ngramsTermText ngrams)
-- ^ and which matches the search query.
&& ngramsChildren ^. at ngrams /= Just true
-- ^ and which are not scheduled to be added already
&& Just ngrams /= ngramsParent
-- ^ and which are not our new parent
&& Just ngrams /= ngramsParentRoot
-- ^ and which are not the root of our new parent
|| ngramsChildren ^. at ngrams == Just false
-- ^ unless they are scheduled to be removed.
|| NTC.tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ unless they are being processed at the moment.
allNgramsSelectedOnFirstPage :: Set NgramsTerm -> PreConversionRows -> Boolean
allNgramsSelectedOnFirstPage selected rows = selected == (selectNgramsOnFirstPage rows)
selectNgramsOnFirstPage :: PreConversionRows -> Set NgramsTerm
selectNgramsOnFirstPage rows = Set.fromFoldable $ fst <$> rows
loadedNgramsTable' :: Record LoadedNgramsTableProps -> R.Element
loadedNgramsTable' props = R2.createElement' (loadedNgramsTableClass) props []
type MainNgramsTableProps =
( nodeId :: Int
......@@ -413,154 +443,57 @@ type MainNgramsTableProps =
, tabType :: TabType
, session :: Session
, tabNgramType :: CTabNgramType
, withAutoUpdate :: Boolean
)
mainNgramsTable :: Record MainNgramsTableProps -> R.Element
mainNgramsTable props = R.createElement mainNgramsTableCpt props []
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt
mainNgramsTableCpt = R.hooksComponent "G.C.NT.mainNgramsTable" cpt
where
cpt {nodeId, defaultListId, tabType, session, tabNgramType} _ = do
path /\ setPath <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType
let paint versioned = loadedNgramsTable' {tabNgramType, path: path /\ setPath, versioned}
cpt {nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate} _ = do
let path = initialPageParams session nodeId [defaultListId] tabType
pure $ loader path loadNgramsTableAll \loaded -> do
case Map.lookup tabType loaded of
Just (versioned :: VersionedNgramsTable) -> paint versioned
Just (versioned :: VersionedNgramsTable) ->
mainNgramsTablePaint {path, tabNgramType, versioned, withAutoUpdate}
Nothing -> loadingSpinner {}
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
tree :: { ngramsTable :: NgramsTable
, ngramsStyle :: Array DOM.Props
, ngramsEdit :: NgramsClick
, ngramsClick :: NgramsClick
} -> NgramsDepth -> ReactElement
tree params@{ngramsTable, ngramsStyle, ngramsEdit, ngramsClick} nd =
li [ style {width : "100%"} ]
([ i icon []
, tag [text $ " " <> ngramsTermText nd.ngrams]
] <> maybe [] edit (ngramsEdit nd) <>
[ forest cs
])
type MainNgramsTablePaintProps =
(
path :: PageParams
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean
)
mainNgramsTablePaint :: Record MainNgramsTablePaintProps -> R.Element
mainNgramsTablePaint p = R.createElement mainNgramsTablePaintCpt p []
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponent "G.C.NT.mainNgramsTablePaint" cpt
where
tag =
case ngramsClick nd of
Just effect ->
a (ngramsStyle <> [onClick $ const effect])
Nothing ->
span ngramsStyle
edit effect = [ text " "
, i [ className "glyphicon glyphicon-pencil"
, onClick $ const effect ] [] ]
leaf = List.null cs
icon = gray <> [className $ "glyphicon glyphicon-chevron-" <> if open then "down" else "right"]
open = not leaf || false {- TODO -}
gray = if leaf then [style {color: "#adb5bd"}] else []
cs = ngramsTable ^.. ix nd.ngrams <<< _NgramsElement <<< _children <<< folded
forest =
let depth = nd.depth + 1 in
ul [] <<< map (\ngrams -> tree params {depth, ngrams}) <<< List.toUnfoldable
sumOccurrences' :: NgramsTable -> NgramsTerm -> Additive Int
sumOccurrences' ngramsTable label =
ngramsTable ^. ix label <<< to (sumOccurrences ngramsTable)
cpt {path, tabNgramType, versioned, withAutoUpdate} _ = do
pathS <- R.useState' path
state <- R.useState' $ initialState versioned
pure $ loadedNgramsTable {
path: pathS
, state
, tabNgramType
, versioned
, withAutoUpdate
}
sumOccurrences :: NgramsTable -> NgramsElement -> Additive Int
sumOccurrences ngramsTable (NgramsElement {occurrences, children}) =
Additive occurrences <> children ^. folded <<< to (sumOccurrences' ngramsTable)
renderNgramsTree :: { ngrams :: NgramsTerm
, ngramsTable :: NgramsTable
, ngramsStyle :: Array DOM.Props
, ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick
} -> ReactElement
renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } =
ul [] [
span [className "tree"] [tree {ngramsTable, ngramsStyle, ngramsClick, ngramsEdit} {ngrams, depth: 0}]
]
renderNgramsItem :: { ngrams :: NgramsTerm
, ngramsTable :: NgramsTable
, ngramsLocalPatch :: NgramsTablePatch
, ngramsElement :: NgramsElement
, ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm
, dispatch :: Action -> Effect Unit
} -> Array ReactElement
renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent
, ngramsSelection, ngramsLocalPatch, dispatch } =
[ selected
, checkbox GraphTerm
, checkbox StopTerm
, if ngramsParent == Nothing
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
else
a [onClick $ const $ dispatch $ ToggleChild true ngrams]
[ i [className "glyphicon glyphicon-plus"] []
, span ngramsStyle [text $ " " <> ngramsTermText ngrams]
]
, 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 =
input
[ _type "checkbox"
, className "checkbox"
, checked $ Set.member ngrams ngramsSelection
, onChange $ const $ dispatch $ ToggleSelect ngrams
]
checkbox termList' =
let chkd = termList == termList'
termList'' = if chkd then CandidateTerm else termList'
in
input
[ _type "checkbox"
, className "checkbox"
, checked chkd
, readOnly ngramsTransient
, onChange $ const $ when (not ngramsTransient) $ dispatch $
setTermListA ngrams (replace termList termList'')
]
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))
tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams =
isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
termStyle :: TermList -> Number -> DOM.Props
termStyle GraphTerm opacity = style { color: "green", opacity}
termStyle StopTerm opacity = style { color: "red", opacity
, textDecoration: "line-through"}
termStyle CandidateTerm opacity = style { color: "black", opacity}
nextTermList :: TermList -> TermList
nextTermList GraphTerm = StopTerm
nextTermList StopTerm = CandidateTerm
nextTermList CandidateTerm = GraphTerm
where
sumOccurrences' :: NgramsTable -> NgramsTerm -> Additive Int
sumOccurrences' nt label =
nt ^. ix label <<< to (sumOccurrences nt)
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
optps1 { desc, mval } = H.option {value} [H.text desc]
optps1 { desc, mval } = H.option { value: value } [H.text desc]
where value = maybe "" show mval
src/Gargantext/Components/NgramsTable/Components.purs 0 → 100644
View file @ bbd5a4e5
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
src/Gargantext/Components/NgramsTable/Core.purs
View file @ bbd5a4e5
......@@ -44,9 +44,13 @@ module Gargantext.Components.NgramsTable.Core
, _parent
, _root
, commitPatch
, commitPatchR
, putNgramsPatches
, syncPatches
, syncPatchesR
, addNewNgram
, Action(..)
, Dispatch
)
where
......@@ -83,16 +87,22 @@ import Data.Symbol (SProxy(..))
import Data.Traversable (class Traversable, for, sequence, traverse, traverse_)
import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
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 Reactix (State) as R
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Thermite (StateCoTransformer, modifyState_)
import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post)
import Gargantext.Types (CTabNgramType(..), OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize)
import Gargantext.Utils.KarpRabin (indicesOfAny)
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Thermite (StateCoTransformer, modifyState_)
type CoreParams s =
{ nodeId :: Int
......@@ -179,14 +189,14 @@ _list = prop (SProxy :: SProxy "list")
derive instance newtypeNgramsElement :: Newtype NgramsElement _
_NgramsElement :: Iso' NgramsElement {
children :: Set NgramsTerm
, list :: TermList
, ngrams :: NgramsTerm
, occurrences :: Int
, parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm
}
_NgramsElement :: Iso' NgramsElement {
children :: Set NgramsTerm
, list :: TermList
, ngrams :: NgramsTerm
, occurrences :: Int
, parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm
}
_NgramsElement = _Newtype
instance decodeJsonNgramsElement :: DecodeJson NgramsElement where
......@@ -336,14 +346,15 @@ replace old new
| old == new = Keep
| 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 p Keep = p
append (Replace { old: _m, new }) (Replace { old, new: _m' }) =
-- assert _m == _m'
Replace { old, new }
append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
append (Replace { new }) (Replace { old }) = replace old new
instance semigroupMonoid :: Monoid (Replace a) where
instance semigroupMonoid :: Eq a => Monoid (Replace a) where
mempty = Keep
applyReplace :: forall a. Eq a => Replace a -> a -> a
......@@ -419,6 +430,9 @@ newtype NgramsPatch = NgramsPatch
, patch_list :: Replace TermList
}
derive instance eqNgramsPatch :: Eq NgramsPatch
derive instance eqPatchSetNgramsTerm :: Eq (PatchSet NgramsTerm)
instance semigroupNgramsPatch :: Semigroup NgramsPatch where
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children
......@@ -455,13 +469,16 @@ applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement
newtype PatchMap k p = PatchMap (Map k p)
instance semigroupPatchMap :: (Ord k, Semigroup p) => Semigroup (PatchMap k p) where
append (PatchMap p) (PatchMap q) = PatchMap (Map.unionWith append p q)
instance semigroupPatchMap :: (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
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
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 = _Newtype
......@@ -537,9 +554,12 @@ singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p
rootsOf :: NgramsTable -> Set NgramsTerm
rootsOf (NgramsTable m) = Map.keys $ Map.filter isRoot m
rootsOf (NgramsTable m) = Map.keys $ Map.mapMaybe isRoot m
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 }
......@@ -631,6 +651,7 @@ putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff Vers
putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams
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 props { ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPatches}
, ngramsStagePatch
......@@ -651,11 +672,38 @@ syncPatches props { ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPa
, 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 (Versioned {version, data: tablePatch}) = do
modifyState_ $ \s ->
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
{ nodeId, listIds, termListFilter, termSizeFilter, session, scoreType
......@@ -689,3 +737,22 @@ convOrderBy (T.ASC (T.ColumnName "Score")) = ScoreAsc
convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
convOrderBy (T.ASC _) = TermAsc
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
src/Gargantext/Components/Nodes/Annuaire.purs
View file @ bbd5a4e5
......@@ -2,13 +2,15 @@ module Gargantext.Components.Nodes.Annuaire where
import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
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.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
import Gargantext.Components.Table as T
import Gargantext.Ends (url, Frontends)
......@@ -114,7 +116,12 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
pure $ T.table { rows, params, container, colNames, totalRecords, wrapColElts }
where
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
colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
wrapColElts = const identity
......@@ -124,11 +131,26 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
type AnnuaireId = Int
contactCells :: Session -> Frontends -> AnnuaireId -> CT.Contact -> Array R.Element
contactCells session frontends aId = render
type ContactCellsProps =
(
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
render (CT.Contact { id, hyperdata : (CT.HyperdataUser {shared: Nothing} )}) =
[ H.text ""
cpt { annuaireId
, contact: (CT.Contact { id, hyperdata: (CT.HyperdataUser {shared: Nothing}) })
, frontends
, session } _ =
pure $ T.makeRow [
H.text ""
, H.span {} [ H.text "name" ]
--, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
, H.text "No ContactWhere"
......@@ -136,26 +158,34 @@ contactCells session frontends aId = render
, H.div {className: "nooverflow"}
[ H.text "No ContactWhereRole" ]
]
render (CT.Contact { id, hyperdata : (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who: who, ou:ou}) } )}) =
--let nodepath = NodePath (sessionId session) NodeContact (Just id)
let nodepath = Routes.ContactPage (sessionId session) aId id
href = url frontends nodepath in
[ H.text ""
, H.a { href} [ H.text $ maybe "name" identity contact.title ]
--, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
, H.text $ maybe "No ContactWhere" contactWhereOrg (head $ ou)
, H.text $ maybe "No ContactWhereDept" contactWhereDept (head $ ou)
, H.div {className: "nooverflow"}
[ H.text $ maybe "No ContactWhereRole" contactWhereRole (head $ ou) ] ]
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
contactWhereOrg (CT.ContactWhere { organization: orga }) =
maybe "No orga (list)" identity (head orga)
contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
maybe "No Dept (list)" identity (head dept)
contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
contactWhereRole (CT.ContactWhere { role: Just role }) = role
cpt { annuaireId
, contact: (CT.Contact { id
, hyperdata: (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who, ou})}) })
, frontends
, session } _ =
pure $ T.makeRow [
H.text ""
, H.a { href } [ H.text $ maybe "name" identity contact.title ]
--, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
, 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)
]
]
where
--nodepath = NodePath (sessionId session) NodeContact (Just id)
nodepath = Routes.ContactPage (sessionId session) annuaireId id
href = url frontends nodepath
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
......
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
View file @ bbd5a4e5
......@@ -4,13 +4,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
, userLayout )
where
import Data.Array (head)
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.Nested (Tuple3, (/\))
import Data.Newtype (unwrap)
import Data.String (joinWith)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Class (liftEffect)
......@@ -18,8 +15,8 @@ import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
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.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
......
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs
View file @ bbd5a4e5
......@@ -84,7 +84,7 @@ type NgramsViewTabsProps =
ngramsView :: Record NgramsViewTabsProps -> R.Element
ngramsView {session,mode, defaultListId, nodeId} =
NT.mainNgramsTable
{ nodeId, defaultListId, tabType, session, tabNgramType }
{ nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate: false }
where
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @ bbd5a4e5
......@@ -46,7 +46,7 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt
R.fragment
[ chart mode
, NT.mainNgramsTable
{session, defaultListId, nodeId: corpusId, tabType, tabNgramType}
{session, defaultListId, nodeId: corpusId, tabType, tabNgramType, withAutoUpdate: false}
]
where
tabNgramType = modeTabType mode
......
src/Gargantext/Components/Table.purs
View file @ bbd5a4e5
......@@ -4,9 +4,11 @@ import Prelude
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.List as L
import Data.Maybe (Maybe(..))
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Utils.Reactix as R2
......@@ -20,8 +22,8 @@ type TableContainerProps =
, tableBody :: Array R.Element
)
type Row = { row :: Array R.Element, delete :: Boolean }
type Rows = Array Row
type Row = { row :: R.Element, delete :: Boolean }
type Rows = L.List Row
type OrderBy = Maybe (OrderByDirection ColumnName)
......@@ -64,6 +66,12 @@ type State =
, orderBy :: OrderBy
}
paramsState :: Params -> State
paramsState {offset, limit, orderBy} = {pageSize, page, orderBy}
where
pageSize = int2PageSizes limit
page = offset / limit + 1
stateParams :: State -> Params
stateParams {pageSize, page, orderBy} = {offset, limit, orderBy}
where
......@@ -128,44 +136,42 @@ tableCpt :: R.Component Props
tableCpt = R.hooksComponent "G.C.Table.table" cpt
where
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
state = {pageSize: pageSize', orderBy, page}
ps = pageSizes2Int pageSize'
state = paramsState $ fst params
ps = pageSizes2Int state.pageSize
totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
colHeader :: ColumnName -> R.Element
colHeader c = H.th {scope: "col"} [ H.b {} cs ]
where
lnk mc = effectLink (setOrderBy (const mc))
lnk mc = effectLink $ snd params $ _ { orderBy = mc }
cs :: Array R.Element
cs =
wrapColElts c $
case orderBy of
case state.orderBy of
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)]
_ -> [lnk (Just (ASC c)) (columnName c)]
R.useEffect2' params state do
when (fst params /= stateParams state) $ (snd params) (const $ stateParams state)
pure $ container
{ pageSizeControl: sizeDD pageSize
, pageSizeDescription: textDescription page pageSize' totalRecords
, paginationLinks: pagination setPage totalPages page
{ pageSizeControl: sizeDD { params }
, pageSizeDescription: textDescription state.page state.pageSize totalRecords
, paginationLinks: pagination params totalPages
, tableBody: map _.row $ A.fromFoldable rows
, 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 =
(
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
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} props = R.fragment
......@@ -193,15 +199,30 @@ graphContainer {title} props =
-- , props.pageSizeDescription
-- , props.paginationLinks
sizeDD :: R.State PageSizes -> R.Element
sizeDD (ps /\ setPageSize) =
H.span {} [ R2.select { className, defaultValue: ps, on: {change} } sizes ]
type SizeDDProps =
(
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
className = "form-control"
change e = setPageSize $ const (string2PageSize $ R2.unsafeEventValue e)
sizes = map option pageSizes
option size = H.option {value} [H.text value]
where value = show size
cpt {params: params /\ setParams} _ = do
pure $ H.span {} [
R2.select { className, defaultValue: show pageSize, on: {change} } sizes
]
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 currPage pageSize totalRecords =
......@@ -212,51 +233,53 @@ textDescription currPage pageSize totalRecords =
end = if end' > totalRecords then totalRecords else end'
msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords
pagination :: (R2.Setter Int) -> Int -> Int -> R.Element
pagination changePage tp cp =
pagination :: R.State Params -> Int -> R.Element
pagination (params /\ setParams) tp =
H.span {} $
[ H.text " ", prev, first, ldots]
<>
lnums
<>
[H.b {} [H.text $ " " <> show cp <> " "]]
[H.b {} [H.text $ " " <> show page <> " "]]
<>
rnums
<>
[ rdots, last, next ]
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. "
else
changePageLink (cp - 1) "Prev."
next = if cp == tp then
changePageLink (page - 1) "Prev."
next = if page == tp then
H.text " Next "
else
changePageLink (cp + 1) "Next"
first = if cp == 1 then
changePageLink (page + 1) "Next"
first = if page == 1 then
H.text ""
else
changePageLink' 1
last = if cp == tp then
last = if page == tp then
H.text ""
else
changePageLink' tp
ldots = if cp >= 5 then
ldots = if page >= 5 then
H.text " ... "
else
H.text ""
rdots = if cp + 3 < tp then
rdots = if page + 3 < tp then
H.text " ... "
else
H.text ""
lnums = map changePageLink' $ A.filter (1 < _) [cp - 2, cp - 1]
rnums = map changePageLink' $ A.filter (tp > _) [cp + 1, cp + 2]
lnums = map changePageLink' $ A.filter (1 < _) [page - 2, page - 1]
rnums = map changePageLink' $ A.filter (tp > _) [page + 1, page + 2]
changePageLink :: Int -> String -> R.Element
changePageLink i s =
H.span {}
[ H.text " "
, effectLink (changePage (const i)) s
, effectLink (changePage i) s
, H.text " "
]
......@@ -274,6 +297,9 @@ instance showPageSize :: Show PageSizes where
show PS100 = "100"
show PS200 = "200"
int2PageSizes :: Int -> PageSizes
int2PageSizes i = string2PageSize $ show i
pageSizes2Int :: PageSizes -> Int
pageSizes2Int PS10 = 10
pageSizes2Int PS20 = 20
......
src/Gargantext/Types.purs
View file @ bbd5a4e5
......@@ -287,6 +287,8 @@ derive instance genericScoreType :: Generic ScoreType _
instance showScoreType :: Show ScoreType where
show = genericShow
type SearchQuery = String
type NgramsGetOpts =
{ tabType :: TabType
, offset :: Offset
......@@ -296,7 +298,7 @@ type NgramsGetOpts =
, termListFilter :: Maybe TermList
, termSizeFilter :: Maybe TermSize
, scoreType :: ScoreType
, searchQuery :: String
, searchQuery :: SearchQuery
}
type NgramsGetTableAllOpts =
......@@ -472,7 +474,7 @@ asyncTaskTypePath GraphT = "async/"
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 eqAsyncTaskStatus :: Eq AsyncTaskStatus
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
......@@ -481,10 +483,13 @@ instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
pure $ readAsyncTaskStatus obj
readAsyncTaskStatus :: String -> AsyncTaskStatus
readAsyncTaskStatus "failed" = Failed
readAsyncTaskStatus "finished" = Finished
readAsyncTaskStatus "killed" = Killed
readAsyncTaskStatus "running" = Running
readAsyncTaskStatus "IsFailure" = Failed
readAsyncTaskStatus "IsFinished" = Finished
readAsyncTaskStatus "IsKilled" = Killed
readAsyncTaskStatus "IsPending" = Pending
readAsyncTaskStatus "IsReceived" = Received
readAsyncTaskStatus "IsRunning" = Running
readAsyncTaskStatus "IsStarted" = Started
readAsyncTaskStatus _ = Running
newtype AsyncTask = AsyncTask {
......
src/Gargantext/Utils/List.purs 0 → 100644
View file @ bbd5a4e5
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)
src/Gargantext/Utils/Reactix.purs
View file @ bbd5a4e5
......@@ -22,9 +22,9 @@ import Effect.Console (logShow)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Class (liftEffect)
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 FFI.Simple ((..), (...), defineProperty, delay, args2, args3)
import FFI.Simple ((..), (...), (.=), defineProperty, delay, args2, args3)
import Partial.Unsafe (unsafePartial)
import React (class ReactPropFields, Children, ReactClass, ReactElement)
import React as React
......@@ -320,3 +320,11 @@ foreign import _setCookie :: EffectFn1 String Unit
setCookie :: String -> Effect Unit
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
src/index.html
View file @ bbd5a4e5
......@@ -3,7 +3,7 @@
<head>
<meta charset="utf-8"/>
<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 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">-->
......
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