Commit bbd5a4e5 authored by Mudada's avatar Mudada

Merge conflict fixed

parents 7c002be7 ebfcb1c7
......@@ -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 */
......@@ -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)
{
"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",
......
#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";
......
......@@ -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
];
}
......
......@@ -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
......
......@@ -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
......
......@@ -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]
......
......@@ -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)
......@@ -143,10 +143,10 @@ settingsBox Corpus = SettingsBox {
, edit : true
, doc : Documentation Corpus
, buttons : [ SearchBox
{- , Add [ NodeList
, Add [ NodeList
, Graph
, Dashboard
] -}
]
, Upload
, Download
--, Share
......
......@@ -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
......
......@@ -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'
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
This diff is collapsed.
module Gargantext.Components.NgramsTable.Components where
import Data.Lens ((^..), (^.), view)
import Data.Lens.At (at)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.List (null, toUnfoldable) as L
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Nullable (null, toMaybe)
import Data.Set (Set)
import Data.Set as Set
import React.DOM (a, span, text)
import React.DOM.Props as DOM
import Effect (Effect)
import FFI.Simple (delay)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsElement, NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, Replace, _NgramsElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, singletonNgramsTablePatch)
import Gargantext.Components.Table as Tbl
import Gargantext.Types as T
import Gargantext.Utils.Reactix as R2
type SearchInputProps =
(
key :: String -- to prevent refreshing & losing input
, onSearch :: String -> Effect Unit
, searchQuery :: String
)
searchInput :: Record SearchInputProps -> R.Element
searchInput props = R.createElement searchInputCpt props []
searchInputCpt :: R.Component SearchInputProps
searchInputCpt = R.hooksComponent "G.C.NT.searchInput" cpt
where
cpt { onSearch, searchQuery } _ = do
pure $ H.div { className: "input-group" } [
H.div { className: "input-group-addon" } [
H.span { className: "fa fa-search" } []
]
, H.input { className: "form-control"
, defaultValue: searchQuery
, name: "search"
, on: { input: onSearch <<< R2.unsafeEventValue }
, placeholder: "Search"
, type: "value" }
]
type SelectionCheckboxProps =
(
allNgramsSelected :: Boolean
, dispatch :: Dispatch
, ngramsSelection :: Set NgramsTerm
)
selectionCheckbox :: Record SelectionCheckboxProps -> R.Element
selectionCheckbox props = R.createElement selectionCheckboxCpt props []
selectionCheckboxCpt :: R.Component SelectionCheckboxProps
selectionCheckboxCpt = R.hooksComponent "G.C.NT.selectionCheckbox" cpt
where
cpt { allNgramsSelected, dispatch, ngramsSelection } _ = do
ref <- R.useRef null
R.useEffect' $ delay unit $ \_ -> do
let mCb = toMaybe $ R.readRef ref
case mCb of
Nothing -> pure unit
Just cb -> do
_ <- if allNgramsSelected || (Set.isEmpty ngramsSelection) then
R2.setIndeterminateCheckbox cb false
else
R2.setIndeterminateCheckbox cb true
pure unit
pure $ H.input { checked: allNgramsSelected
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelectAll }
, ref
, type: "checkbox" }
type RenderNgramsTree =
( ngrams :: NgramsTerm
, ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick
, ngramsStyle :: Array DOM.Props
, ngramsTable :: NgramsTable
)
renderNgramsTree :: Record RenderNgramsTree -> R.Element
renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = R.hooksComponent "G.C.NT.renderNgramsTree" cpt
where
cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } _ =
pure $ H.ul {} [
H.span { className: "tree" } [
tree { ngramsClick
, ngramsDepth: {ngrams, depth: 0}
, ngramsEdit
, ngramsStyle
, ngramsTable
}
]
]
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
type TreeProps =
(
ngramsClick :: NgramsClick
, ngramsDepth :: NgramsDepth
, ngramsEdit :: NgramsClick
, ngramsStyle :: Array DOM.Props
, ngramsTable :: NgramsTable
)
tree :: Record TreeProps -> R.Element
tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps
treeCpt = R.hooksComponent "G.C.NT.tree" cpt
where
cpt params@{ ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle, ngramsTable } _ =
pure $
H.li { style: {width : "100%"} }
([ H.i { className, style } [] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest cs ])
where
tag =
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span ngramsStyle
edit effect = [ H.text " "
, H.i { className: "glyphicon glyphicon-pencil"
, on: { click: const effect } } []
]
leaf = L.null cs
className = "glyphicon glyphicon-chevron-" <> if open then "down" else "right"
style = if leaf then {color: "#adb5bd"} else {color: ""}
open = not leaf || false {- TODO -}
cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsElement <<< _children <<< folded
forest =
let depth = ngramsDepth.depth + 1 in
H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
type RenderNgramsItem =
( dispatch :: Action -> Effect Unit
, ngrams :: NgramsTerm
, ngramsElement :: NgramsElement
, ngramsLocalPatch :: NgramsTablePatch
, ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable
)
renderNgramsItem :: Record RenderNgramsItem -> R.Element
renderNgramsItem p = R.createElement renderNgramsItemCpt p []
renderNgramsItemCpt :: R.Component RenderNgramsItem
renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
where
cpt { dispatch
, ngrams
, ngramsElement
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsTable } _ =
pure $ Tbl.makeRow [
selected
, checkbox T.GraphTerm
, checkbox T.StopTerm
, if ngramsParent == Nothing
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
else
H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } } [
H.i { className: "glyphicon glyphicon-plus" } []
, (R2.buff $ span ngramsStyle [text $ " " <> ngramsTermText ngrams])
]
, H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
]
where
termList = ngramsElement ^. _NgramsElement <<< _list
ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
ngramsClick
= Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
-- ^ This is the old behavior it is nicer to use since one can
-- rapidly change the ngram list without waiting for confirmation.
-- However this might expose bugs. One of them can be reproduced
-- by clicking a multiple times on the same ngram, sometimes it stays
-- transient.
-- | ngramsTransient = const Nothing
-- | otherwise = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
selected =
H.input { checked: Set.member ngrams ngramsSelection
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelect ngrams }
, type: "checkbox" }
checkbox termList' =
let chkd = termList == termList'
termList'' = if chkd then T.CandidateTerm else termList'
in
H.input { checked: chkd
, className: "checkbox"
, on: { change: const $ dispatch $
setTermListA ngrams (replace termList termList'') }
, readOnly: ngramsTransient
, type: "checkbox" }
ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ TODO here we do not look at ngramsNewElems, shall we?
ngramsOpacity
| ngramsTransient = 0.5
| otherwise = 1.0
cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))
termStyle :: T.TermList -> Number -> DOM.Props
termStyle T.GraphTerm opacity = DOM.style { color: "green", opacity }
termStyle T.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity }
setTermListA :: NgramsTerm -> Replace T.TermList -> Action
setTermListA n patch_list =
CommitPatch $
singletonNgramsTablePatch n $
NgramsPatch { patch_list, patch_children: mempty }
tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams =
isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
nextTermList :: T.TermList -> T.TermList
nextTermList T.GraphTerm = T.StopTerm
nextTermList T.StopTerm = T.CandidateTerm
nextTermList T.CandidateTerm = T.GraphTerm
......@@ -44,9 +44,13 @@ module Gargantext.Components.NgramsTable.Core
, _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
......@@ -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
......
......@@ -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
......
......@@ -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
......@@ -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
......
......@@ -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
......
......@@ -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 {
......
module Gargantext.Utils.List where
import Data.Ord (class Ord, comparing)
import Data.List as List
-- same as
-- https://github.com/purescript/purescript-arrays/blob/v5.3.1/src/Data/Array.purs#L715-L715
sortWith :: forall a b. Ord b => (a -> b) -> List.List a -> List.List a
sortWith f = List.sortBy (comparing f)
......@@ -22,9 +22,9 @@ import Effect.Console (logShow)
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
......@@ -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