Commit 7cad1696 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-arxiv

parents 2a29dcc9 9e3893bb
Pipeline #2699 failed with stage
in 0 seconds
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
{
"name": "Gargantext",
"version": "0.0.5.8.4",
"version": "0.0.5.8.5",
"scripts": {
"generate-purs-packages-nix": "./nix/generate-purs-packages.nix",
"generate-psc-packages-nix": "./nix/generate-packages-json.bash",
......
......@@ -15,12 +15,14 @@ type Props =
)
type Options =
( className :: String
( className :: String
, contentClassName :: String
)
options :: Record Options
options =
{ className: ""
{ className : ""
, contentClassName : ""
}
-- | Component simulating a native <fieldset>
......@@ -36,12 +38,21 @@ component = R.hooksComponent componentName cpt where
cpt props@{ titleSlot
} children = do
-- Computed
className <- pure $ intercalate " "
-- provided custom className
[ props.className
-- BEM classNames
, componentName
]
let
className = intercalate " "
-- provided custom className
[ props.className
-- BEM classNames
, componentName
]
contentClassName = intercalate " "
-- provided custom className
[ props.contentClassName
-- BEM classNames
, componentName <> "__content"
]
-- Render
pure $
......@@ -53,6 +64,6 @@ component = R.hooksComponent componentName cpt where
[ titleSlot ]
,
H.div
{ className: componentName <> "__content" }
{ className: contentClassName}
children
]
......@@ -14,7 +14,9 @@ import Gargantext.Components.Bootstrap.Icon(icon) as Exports
import Gargantext.Components.Bootstrap.IconButton(iconButton) as Exports
import Gargantext.Components.Bootstrap.ProgressBar(progressBar) as Exports
import Gargantext.Components.Bootstrap.Spinner(spinner) as Exports
import Gargantext.Components.Bootstrap.Tooltip(tooltip, tooltipBind, tooltipContainer) as Exports
import Gargantext.Components.Bootstrap.Tabs(tabs) as Exports
import Gargantext.Components.Bootstrap.Tooltip(tooltip, TooltipBindingProps, tooltipBind, tooltipBind', tooltipContainer) as Exports
import Gargantext.Components.Bootstrap.Wad(wad, wad', wad_) as Exports
import Gargantext.Components.Bootstrap.Shortcut(
div', div_
......
module Gargantext.Components.Bootstrap.Tooltip
( tooltip
, tooltipBind
, TooltipBindingProps, tooltipBind, tooltipBind'
, tooltipContainer
) where
......@@ -90,6 +90,13 @@ tooltipBind =
, "data-tip": true
}
-- | Derived empty state
tooltipBind' :: Record TooltipBindingProps
tooltipBind' =
{ "data-for": ""
, "data-tip": false
}
-------------------------------------------------------------
type ContainerProps =
......
module Gargantext.Components.Bootstrap.Wad
( wad
, wad'
, wad_
) where
import Gargantext.Prelude
import Data.Foldable (intercalate)
import Reactix as R
import Reactix.DOM.HTML as H
componentName :: String
componentName = "b-wad"
-- | Structural Component for a simple Element only serving the purpose to add
-- | some classes in it
-- |
-- | Hence the name: Wad (noun): a small mass, lump, or ball of anything ;
-- | a roll of something
wad :: Array String -> Array R.Element -> R.Element
wad classes children = R.createDOMElement "div" cls children
where
cls = { className: intercalate " " $
[ componentName
] <> classes
}
-- | Shorthand for using <wad> Component without writing its text node
wad' :: Array String -> String -> R.Element
wad' classes text = R.createDOMElement "div" cls chd
where
cls = { className: intercalate " " $
[ componentName
] <> classes
}
chd = [ H.text text ]
-- | Shorthand for using <wad> Component without any child
wad_ :: Array String -> R.Element
wad_ classes = R.createDOMElement "div" cls []
where
cls = { className: intercalate " " $
[ componentName
] <> classes
}
module Gargantext.Components.Bootstrap.Tabs(tabs) where
import Gargantext.Prelude
import Data.Foldable (intercalate)
import Effect (Effect)
import Gargantext.Utils ((?))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
type Props a =
( value :: a
, callback :: a -> Effect Unit
, list :: Array a
| Options
)
type Options =
( className :: String
)
options :: Record Options
options =
{ className : ""
}
-- | Structural molecular component to the Bootstrap <nav-tabs> + <nav-item>
-- | simplifying a lot of the available UI/UX possibilites (type, disabled
-- | tabs, etc)
-- |
-- | https://getbootstrap.com/docs/4.6/components/navs/#tabs
tabs :: forall r a.
Show a
=> Eq a
=> R2.OptLeaf Options (Props a) r
tabs = R2.optLeaf component options
componentName :: String
componentName = "b-tabs"
component :: forall a.
Show a
=> Eq a
=> R.Component (Props a)
component = R.hooksComponent componentName cpt where
cpt props@{ list, value, callback } _ = do
-- Computed
let
className = intercalate " "
-- provided custom className
[ props.className
-- BEM classNames
, componentName
-- Bootstrap specific classNames
, "nav nav-tabs"
]
-- Render
pure $
H.ul
{ className } $
flip map list \item ->
H.li
{ className: "nav-item"
, on: { click: \_ -> callback item }
}
[
H.a
{ className: intercalate " "
[ "nav-link"
, value == item ? "active" $ ""
]
}
[
H.text $ show item
]
]
......@@ -16,7 +16,6 @@ import Gargantext.Ends (Frontends)
import Gargantext.Hooks.LinkHandler (useLinkHandler)
import Gargantext.Routes (AppRoute(..))
import Gargantext.Sessions (Session(..), unSessions)
import Gargantext.Utils (nbsp)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -132,9 +131,10 @@ plusCpt = here.component "plus" cpt where
, variant: ButtonVariant Light
}
[
B.icon { name: "universal-access" }
B.icon
{ name: "universal-access" }
,
H.text $ nbsp 1
B.wad_ [ "d-inline-block", "w-1" ]
,
H.text $ "Log in/out"
]
......@@ -150,7 +150,7 @@ forestLayout :: R2.Leaf Props
forestLayout = R2.leaf forestLayoutCpt
forestLayoutCpt :: R.Memo Props
forestLayoutCpt = R.memo' $ here.component "forestLayout" cpt where
cpt p children = pure $
cpt p _ = pure $
H.div
{ className: "forest-layout" }
......
exports.nodeUserRegexp = /(@{1}.*).gargantext.org$/;
......@@ -31,15 +31,15 @@ type NodeActionsGraphProps =
nodeActionsGraph :: R2.Component NodeActionsGraphProps
nodeActionsGraph = R.createElement nodeActionsGraphCpt
nodeActionsGraphCpt :: R.Component NodeActionsGraphProps
nodeActionsGraphCpt = here.component "nodeActionsGraph" cpt
where
cpt { id, graphVersions, session, refresh } _ = do
pure $ H.div { className: "node-actions" } [
if graphVersions.gv_graph == Just graphVersions.gv_repo then
H.div {} []
else
graphUpdateButton { id, session, refresh }
]
nodeActionsGraphCpt = here.component "nodeActionsGraph" cpt where
cpt { id, graphVersions, session, refresh } _ =
let sameVersions = (graphVersions.gv_graph == Just graphVersions.gv_repo)
in pure $
R2.if' (not sameVersions) $
graphUpdateButton { id, session, refresh }
type GraphUpdateButtonProps =
( id :: GT.ID
......@@ -99,12 +99,9 @@ type NodeActionsNodeListProps =
nodeActionsNodeList :: Record NodeActionsNodeListProps -> R.Element
nodeActionsNodeList p = R.createElement nodeActionsNodeListCpt p []
nodeActionsNodeListCpt :: R.Component NodeActionsNodeListProps
nodeActionsNodeListCpt = here.component "nodeActionsNodeList" cpt
where
cpt props _ = do
pure $ H.div { className: "node-actions" } [
nodeListUpdateButton props
]
nodeActionsNodeListCpt = here.component "nodeActionsNodeList" cpt where
cpt props _ = pure $ nodeListUpdateButton props
type NodeListUpdateButtonProps =
( listId :: GT.ListId
......
......@@ -132,9 +132,12 @@ graphCpt = here.component "graph" cpt where
Sigma.stopForceAtlas2 sig
case mCamera of
Nothing -> pure unit
Just (GET.Camera { ratio, x, y }) -> do
Sigma.updateCamera sig { ratio, x, y }
-- Default camera: slightly de-zoom the graph to avoid
-- nodes sticking to the container borders
Nothing ->
Sigma.updateCamera sig { ratio: 1.1, x: 0.0, y: 0.0 }
-- Reload Sigma on Theme changes
_ <- flip T.listen boxes.theme \{ old, new } ->
......
module Gargantext.Components.GraphExplorer.Button
( Props, centerButton, simpleButton, cameraButton ) where
module Gargantext.Components.GraphExplorer.Buttons
( Props
, centerButton
, simpleButton
, cameraButton
, edgesToggleButton
, louvainToggleButton
, pauseForceAtlasButton
, resetForceAtlasButton
, multiSelectEnabledButton
) where
import Prelude
import DOM.Simple.Console (log2)
import Data.DateTime as DDT
import Data.DateTime.Instant as DDI
import Data.Either (Either(..))
import Data.Enum (fromEnum)
import Data.Maybe (Maybe(..))
import Data.DateTime as DDT
import Data.DateTime.Instant as DDI
import Data.String as DS
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Effect.Now as EN
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), ComponentStatus(..), Variant(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryData)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat(..))
import Gargantext.Components.GraphExplorer.API (cloneGraph)
import Gargantext.Components.GraphExplorer.Resources as Graph
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Sessions (Session)
import Gargantext.Utils ((?))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Button"
......@@ -36,9 +50,12 @@ type Props = (
, text :: String
)
-- @WIP
simpleButton :: Record Props -> R.Element
simpleButton props = R.createElement simpleButtonCpt props []
------------------------------------------------------
simpleButtonCpt :: R.Component Props
simpleButtonCpt = here.component "simpleButton" cpt
where
......@@ -48,14 +65,16 @@ simpleButtonCpt = here.component "simpleButton" cpt
} [ R2.small {} [ H.text text ] ]
centerButton :: R.Ref Sigmax.Sigma -> R.Element
centerButton sigmaRef = simpleButton {
onClick: \_ -> do
centerButton sigmaRef = B.button
{ variant: OutlinedButtonVariant Secondary
, callback: \_ -> do
let sigma = R.readRef sigmaRef
Sigmax.dependOnSigma sigma "[centerButton] sigma: Nothing" $ \s ->
Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
, text: "Center"
}
[ H.text "Center" ]
------------------------------------------------------
type CameraButtonProps =
( id :: Int
......@@ -71,8 +90,10 @@ cameraButton { id
, hyperdataGraph: GET.HyperdataGraph { graph: GET.GraphData hyperdataGraph }
, session
, sigmaRef
, reloadForest } = simpleButton {
onClick: \_ -> do
, reloadForest } = B.button
{ variant: OutlinedButtonVariant Secondary
, callback: \_ -> do
let sigma = R.readRef sigmaRef
Sigmax.dependOnSigma sigma "[cameraButton] sigma: Nothing" $ \s -> do
screen <- Sigma.takeScreenshot s
......@@ -105,5 +126,171 @@ cameraButton { id
Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
Right _ret -> do
liftEffect $ T2.reload reloadForest
, text: "Screenshot"
}
[ H.text "Screenshot" ]
------------------------------------------------------
type EdgesButtonProps =
( state :: T.Box SigmaxTypes.ShowEdgesState
, stateAtlas :: T.Box SigmaxTypes.ForceAtlasState
)
edgesToggleButton :: R2.Leaf EdgesButtonProps
edgesToggleButton = R2.leaf edgesToggleButtonCpt
edgesToggleButtonCpt :: R.Component EdgesButtonProps
edgesToggleButtonCpt = here.component "edgesToggleButton" cpt
where
cpt { state, stateAtlas } _ = do
-- States
state' <- R2.useLive' state
stateAtlas' <- R2.useLive' stateAtlas
-- Computed
let
cst SigmaxTypes.InitialRunning = Disabled
cst SigmaxTypes.Running = Disabled
cst _ = Enabled
-- Render
pure $
B.button
{ variant: state' == SigmaxTypes.EShow ?
ButtonVariant Secondary $
OutlinedButtonVariant Secondary
, status: cst stateAtlas'
-- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges
, callback: \_ -> T.modify_ SigmaxTypes.toggleShowEdgesState state
}
[ H.text "Edges" ]
------------------------------------------------------
type LouvainToggleButtonProps =
( state :: T.Box Boolean
)
louvainToggleButton :: R2.Leaf LouvainToggleButtonProps
louvainToggleButton = R2.leaf louvainToggleButtonCpt
louvainToggleButtonCpt :: R.Component LouvainToggleButtonProps
louvainToggleButtonCpt = here.component "louvainToggleButton" cpt
where
cpt { state } _ = do
state' <- R2.useLive' state
pure $
B.button
{ variant: state' ?
ButtonVariant Secondary $
OutlinedButtonVariant Secondary
, callback: \_ -> T.modify_ (not) state
}
[ H.text "Louvain" ]
--------------------------------------------------------------
type ForceAtlasProps =
( state :: T.Box SigmaxTypes.ForceAtlasState
)
pauseForceAtlasButton :: R2.Leaf ForceAtlasProps
pauseForceAtlasButton = R2.leaf pauseForceAtlasButtonCpt
pauseForceAtlasButtonCpt :: R.Component ForceAtlasProps
pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt
where
cpt { state } _ = do
-- States
state' <- R2.useLive' state
-- Computed
let
cls SigmaxTypes.InitialRunning = "on-running-animation active"
cls SigmaxTypes.Running = "on-running-animation active"
cls _ = ""
vrt SigmaxTypes.InitialRunning = ButtonVariant Secondary
vrt SigmaxTypes.Running = ButtonVariant Secondary
vrt _ = OutlinedButtonVariant Secondary
icn SigmaxTypes.InitialRunning = "pause"
icn SigmaxTypes.InitialStopped = "play"
icn SigmaxTypes.Running = "pause"
icn SigmaxTypes.Paused = "play"
icn SigmaxTypes.Killed = "play"
-- Render
pure $
B.button
{ variant: vrt state'
, className: cls state'
, callback: \_ -> T.modify_ SigmaxTypes.toggleForceAtlasState state
}
[
B.icon
{ name: icn state'}
]
--------------------------------------------------------
type ResetForceAtlasProps =
( forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
, sigmaRef :: R.Ref Sigmax.Sigma
)
resetForceAtlasButton :: R2.Leaf ResetForceAtlasProps
resetForceAtlasButton = R2.leaf resetForceAtlasButtonCpt
resetForceAtlasButtonCpt :: R.Component ResetForceAtlasProps
resetForceAtlasButtonCpt = here.component "resetForceAtlasToggleButton" cpt
where
cpt { forceAtlasState, sigmaRef } _ = do
pure $ H.button { className: "btn btn-outline-secondary"
, on: { click: onClick forceAtlasState sigmaRef }
} [ R2.small {} [ H.text "Reset Force Atlas" ] ]
onClick forceAtlasState sigmaRef _ = do
-- TODO Sigma.killForceAtlas2 sigma
-- startForceAtlas2 sigma
Sigmax.dependOnSigma (R.readRef sigmaRef) "[resetForceAtlasButton] no sigma" $ \sigma -> do
Sigma.killForceAtlas2 sigma
Sigma.refreshForceAtlas sigma Graph.forceAtlas2Settings
T.write_ SigmaxTypes.Killed forceAtlasState
------------------------------------------------------------------
type MultiSelectEnabledButtonProps =
( state :: T.Box Boolean
)
multiSelectEnabledButton :: R2.Leaf MultiSelectEnabledButtonProps
multiSelectEnabledButton = R2.leaf multiSelectEnabledButtonCpt
multiSelectEnabledButtonCpt :: R.Component MultiSelectEnabledButtonProps
multiSelectEnabledButtonCpt = here.component "multiSelectEnabledButton" cpt
where
cpt { state } _ = do
state' <- R2.useLive' state
pure $
H.div
{ className: "btn-group"
, role: "group"
}
[
B.button
{ variant: state' ?
OutlinedButtonVariant Secondary $
ButtonVariant Secondary
, callback: \_ -> T.write_ false state
}
[ H.text "Single" ]
,
B.button
{ variant: state' ?
ButtonVariant Secondary $
OutlinedButtonVariant Secondary
, callback: \_ -> T.write_ true state
}
[ H.text "Multiple" ]
]
module Gargantext.Components.GraphExplorer.Legend
( Props, legend, legendCpt
( Props, legend
) where
import Prelude hiding (map)
......@@ -7,31 +7,39 @@ import Prelude hiding (map)
import Data.Sequence (Seq)
import Data.Traversable (foldMap)
import Reactix as R
import Reactix.DOM.HTML as RH
import Reactix.DOM.HTML as H
import Gargantext.Components.GraphExplorer.Types (Legend(..), intColor)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Legend"
type Props = ( items :: Seq Legend )
legend :: Record Props -> R.Element
legend props = R.createElement legendCpt props []
legend :: R2.Leaf Props
legend = R2.leaf legendCpt
legendCpt :: R.Component Props
legendCpt = here.component "legend" cpt
where
cpt {items} _ = pure $ RH.div {} [foldMap entry items]
entry :: Legend -> R.Element
entry (Legend {id_, label}) =
RH.p {}
[ RH.span { style: { width : 10
, height: 10
, backgroundColor: intColor id_
, display: "inline-block"
}
} []
, RH.text $ " " <> label
]
legendCpt = here.component "legend" cpt where
cpt { items } _ = pure $
H.ul
{ className: "graph-legend" }
[
flip foldMap items \(Legend { id_, label }) ->
H.li
{ className: "graph-legend__item" }
[
H.span
{ className: "graph-legend__code"
, style: { backgroundColor: intColor id_ }
}
[]
,
H.span
{ className: "graph-legend__caption" }
[ H.text label ]
]
]
......@@ -18,37 +18,45 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.RangeControl"
type Props = (
caption :: String
type Props =
( caption :: String
, sliderProps :: Record RS.Props
)
rangeControl :: R2.Component Props
rangeControl = R.createElement rangeControlCpt
rangeControl :: R2.Leaf Props
rangeControl = R2.leaf rangeControlCpt
rangeControlCpt :: R.Component Props
rangeControlCpt = here.component "rangeButton" cpt
where
cpt {caption, sliderProps} _ = do
pure $
H.span {className: "range text-center"}
[ H.label {} [ R2.small {} [ H.text caption ] ]
, RS.rangeSlider sliderProps
]
type EdgeConfluenceControlProps = (
range :: Range.NumberRange
cpt {caption, sliderProps} _ = pure $
H.span
{ className: "range-control" }
[
H.label
{ className: "range-control__label" }
[ H.text caption ]
,
RS.rangeSlider sliderProps
]
----------------------------------------
type EdgeConfluenceControlProps =
( range :: Range.NumberRange
, state :: T.Box Range.NumberRange
)
edgeConfluenceControl :: R2.Component EdgeConfluenceControlProps
edgeConfluenceControl = R.createElement edgeConfluenceControlCpt
edgeConfluenceControl :: R2.Leaf EdgeConfluenceControlProps
edgeConfluenceControl = R2.leaf edgeConfluenceControlCpt
edgeConfluenceControlCpt :: R.Component EdgeConfluenceControlProps
edgeConfluenceControlCpt = here.component "edgeConfluenceControl" cpt
where
cpt { range: Range.Closed { min, max }
, state } _ = do
, state
} _ = do
state' <- T.useLive T.unequal state
pure $ rangeControl {
......@@ -62,21 +70,24 @@ edgeConfluenceControlCpt = here.component "edgeConfluenceControl" cpt