Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
148
Issues
148
List
Board
Labels
Milestones
Merge Requests
2
Merge Requests
2
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
bac07dd6
Commit
bac07dd6
authored
Nov 04, 2019
by
James Laver
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
push for seeg
parent
7e558a0b
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
151 additions
and
101 deletions
+151
-101
Graph.purs
src/Gargantext/Components/Graph.purs
+80
-6
Login.purs
src/Gargantext/Components/Login.purs
+4
-4
NgramsTable.purs
src/Gargantext/Components/NgramsTable.purs
+1
-1
Sigmax.purs
src/Gargantext/Hooks/Sigmax.purs
+22
-34
Sigma.js
src/Gargantext/Hooks/Sigmax/Sigma.js
+2
-2
Sigma.purs
src/Gargantext/Hooks/Sigmax/Sigma.purs
+19
-18
Sessions.purs
src/Gargantext/Sessions.purs
+3
-3
Reactix.purs
src/Gargantext/Utils/Reactix.purs
+20
-33
No files found.
src/Gargantext/Components/Graph.purs
View file @
bac07dd6
...
...
@@ -4,12 +4,17 @@ module Gargantext.Components.Graph
-- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings
-- )
where
import Prelude (bind, discard, pure, ($))
import Prelude (bind, discard, pure, ($), (<$>), (<*>))
import Data.Either (Either(..), either, note)
import Data.Maybe (Maybe)
import Data.Nullable (null)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as Sigmax
type OnProps = ()
...
...
@@ -26,11 +31,16 @@ type Edge = ( id :: String, source :: String, target :: String )
type Graph = Sigmax.Graph Node Edge
type Props sigma f
orceatlas
2 =
type Props sigma f
a
2 =
( graph :: Graph
, forceAtlas2Settings :: f
orceatlas
2
, forceAtlas2Settings :: f
a
2
, sigmaSettings :: sigma
, sigmaRef :: R.Ref (Maybe Sigma)
)
type Last sigma fa2 =
( graph :: R.Ref (Maybe Graph))
, fa2 :: R.Ref (Maybe fa2))
, sigma :: R.Ref (Maybe sigma)
)
graph :: forall s fa2. Record (Props s fa2) -> R.Element
...
...
@@ -40,11 +50,75 @@ graphCpt :: forall s fa2. R.Component (Props s fa2)
graphCpt = R.hooksComponent "Graph" cpt
where
cpt props _ = do
ref <- R.useRef null
containerRef <- R2.nullRef
sigmaRef <- R2.nothingRef
last <- R2.nothingRef
R.useEffectOnce do
let r = (/\) <$> assertContainer containerRef <*> assertCreateSigma unit
case r of
Left e -> e *> pure R.nothing
Right (container /\ sigma) -> do
Sigma.setSettings sigma props.sigmaSettings
good <- addRenderer container sigma
if good
setLast last props
R.setRef sigmaRef sigma
R.useEffect3 props.graph props.forceAtlas2Settings props.sigmaSettings
startSigma ref props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph
pure $ RH.div { ref, style: {height: "95%"} } []
pure $ RH.div { ref: containerRef, style: {height: "95%"} } []
graphEffect {graph, forceAtlas2Settings, sigmaSettings} =
R.useEffect3 graph forceAtlas2Settings sigmaSettings do
setLast :: forall s fa2. R.Ref (Record (Last s fa2)) -> R.Record (Props s fa2) -> Effect Unit
setLast ref {graph, forceAtlas2Settings, sigmaSettings} = R.setRef ref new where
new = {graph, fa2: forceAtlas2Settings, sigma: sigmaSettings}
assertContainer :: R.Ref (Nullable DOM.Element) -> Either (Effect Unit) DOM.Element
assertContainer ref = note err $ R.readNullableRef containerRef where
err = log "[G.C.Graph.graph] container not found"
assertCreateSigma :: Unit -> Either (Effect Unit) Sigma
assertCreateSigma = either err Right $ Sigma.sigma where
err = log2 "[G.C.Graph.graph] Error initialising sigma: "
addRenderer :: DOM.Element -> Sigma -> Effect Bool
addRenderer container sigma = do
ret <- Sigma.addRenderer sigma {container, "type": "canvas"}
case ret of
Right r -> pure True
Left e -> log2 "[G.C.Graph.graph] Error creating renderer: " e *> pure False
either err Right $ Sigma.sigma where
err = log2 "[G.C.Graph.graph] Error initialising sigma: "
useSigma containerRef props = do
sigmaRef <- R2.nothingRef
R.useEffectOnce $ delay unit $ \_ ->
case R.readNullableRef containerRef of
Nothing -> log "[G.C.Graph.useSigma] container not found!" *> pure R.nothing
Just container ->
case Sigma.sigma unit of
Left e -> log2 "[G.C.Graph.useSigma] Error initialising sigma: " e *> pure R.nothing
Right sigma -> do
log2 "[G.H.Sigmax.useSigma] Sigma initialised: " sigma
R.setRef sigmaRef sigma
pure $ Sigma.killSigma sigma
h sigma = do
log2 "[G.C.Graph.graph] Found sigma!" sigma
pure sigmaRef
where
named msg = "[G.C.Graph.useSigma] " <> msg
signed = log <<< named
signed2 msg = log2 <<< named msg
assertAddRenderer sigma container =
type SigmaSettings =
( animationsTime :: Number
, autoRescale :: Boolean
...
...
src/Gargantext/Components/Login.purs
View file @
bac07dd6
...
...
@@ -29,7 +29,7 @@ import Gargantext.Utils.Reactix as R2
type Props =
( backends :: Array Backend
, sessions :: R2.Reduc
to
r Sessions Sessions.Action
, sessions :: R2.Reduc
e
r Sessions Sessions.Action
, visible :: R.State Boolean )
type ModalProps = ( visible :: R.State Boolean )
...
...
@@ -104,11 +104,11 @@ chooserCpt = R.staticComponent "G.C.Login.chooser" cpt where
, H.ul {} [renderBackends backends backend ]
]
renderSessions :: R2.Reduc
to
r Sessions Sessions.Action -> R.Element
renderSessions :: R2.Reduc
e
r Sessions Sessions.Action -> R.Element
renderSessions sessions = R.fragment (renderSession sessions <$> unSessions (fst sessions))
renderSession :: R2.Reduc
to
r Sessions Sessions.Action -> Session -> R.Element
renderSession :: R2.Reduc
e
r Sessions Sessions.Action -> Session -> R.Element
renderSession sessions session = H.li {} $ [ H.text $ "Active session: " <> show session ]
<> [ H.a { on : {click}
, className: glyphicon "log-out"
...
...
@@ -140,7 +140,7 @@ renderBackend backend@(Backend {name}) state =
type FormProps =
( backend :: Backend
, sessions :: R2.Reduc
to
r Sessions Sessions.Action
, sessions :: R2.Reduc
e
r Sessions Sessions.Action
, visible :: R.State Boolean )
form :: Record FormProps -> R.Element
...
...
src/Gargantext/Components/NgramsTable.purs
View file @
bac07dd6
...
...
@@ -200,7 +200,7 @@ loadedNgramsTableCpt = R.hooksComponent "G.C.NgramsTable.loadedNgramsTable" cpt
pure $ R.fragment []
useNgramsReducer :: State -> R.Hooks (R.Reducer State Action')
useNgramsReducer init = R2.useReduc
tor' performNgramsAction init
useNgramsReducer init = R2.useReduc
er' init performNgramsAction
performNgramsAction :: Action' -> State -> Effect State
performNgramsAction (SetParentResetChildren' term) = pure -- TODO
...
...
src/Gargantext/Hooks/Sigmax.purs
View file @
bac07dd6
...
...
@@ -3,11 +3,11 @@ module Gargantext.Hooks.Sigmax
-- )
where
import Prelude
(Unit, bind, const, discard, flip, pure, unit, ($), (*>), (<$), (<$>), (<<<), (<>), (>>=))
import Prelude
import Data.Array as A
import Data.Either (Either(..), either)
import Data.Foldable (sequence_)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..)
, isJust
)
import Data.Nullable (Nullable)
import Data.Sequence as Seq
import Data.Sequence (Seq)
...
...
@@ -70,36 +70,24 @@ startSigma ref sigmaRef settings forceAtlas2Settings graph = do
Sigma.refreshForceAtlas s
pure $ pure unit
-- | Manages a sigma with the given settings
useSigma :: forall settings. R.Ref (Nullable Element) -> settings -> R.Ref (Maybe Sigma) -> R.Hooks {sigma :: Sigma, isNew :: Boolean}
useSigma container settings sigmaRef = do
sigma <- newSigma sigmaRef
let isNew = case (readSigma sigma) of
Just _ -> false
_ -> true
R.useEffect1 isNew $ do
log2 "isNew" isNew
log2 "sigmaRef" $ R.readRef sigmaRef
log2 "sigma" sigma
delay unit $ handleSigma sigma (readSigma sigma)
pure $ {sigma, isNew}
where
newSigma sigmaRef' = do
let mSigma = R.readRef sigmaRef'
case mSigma of
Just sigma -> pure sigma
Nothing -> do
s <- R2.nothingRef
c <- R.useRef Seq.empty
pure {sigma: s, cleanup: c}
handleSigma sigma (Just _) _ = do
pure R.nothing
handleSigma sigma Nothing _ = do
ret <- createSigma settings
traverse_ (writeSigma sigma <<< Just) ret
R.setRef sigmaRef $ Just sigma
--pure $ cleanupSigma sigma "useSigma"
pure $ R.nothing
useSigma :: R.Hooks (R.Ref (Maybe Sigma))
useSigma = do
sigmaRef <- R2.nothingRef
R.useEffectOnce $ delay unit $ \_ ->
case Sigma.sigma unit of
Left e ->
log2 "[G.H.Sigmax.useSigma] Error initialising sigma: " e
Right sigma -> do
log2 "[G.H.Sigmax.useSigma] Sigma initialised: " sigma
R.setRef sigmaRef (Sigma.sigma unit)
updateSettings :: forall settings. Sigma -> R.Ref settings -> settings -> Effect Bool
updateSettings sigma ref settings =
| (R.readRef ref) == settings = pure false
| otherwise
= Sigma.setSettings sigma settings
*> pure $ R.setRef ref settings
*> pure true
-- | Manages a renderer for the sigma
useCanvasRenderer :: R.Ref (Nullable Element) -> Sigma -> R.Hooks Unit
...
...
@@ -193,8 +181,8 @@ useForceAtlas2 sigma settings =
log sigma
Sigma.startForceAtlas2 sig settings
cleanupFirst sigma (Sigma.killForceAtlas2 sig)
startingMsg = "[
Graph
] Starting ForceAtlas2"
sigmaNotFoundMsg = "[
Graph
] Sigma not found, not initialising"
startingMsg = "[
Sigmax
] Starting ForceAtlas2"
sigmaNotFoundMsg = "[
Sigmax
] Sigma not found, not initialising"
dependOnSigma :: Sigma -> String -> (Sigma.Sigma -> Effect Unit) -> Effect Unit
dependOnSigma sigma notFoundMsg f = do
...
...
src/Gargantext/Hooks/Sigmax/Sigma.js
View file @
bac07dd6
...
...
@@ -8,9 +8,9 @@ if (typeof window !== 'undefined') {
require
(
'sigma/plugins/garg.js'
).
init
(
sigma
,
window
);
function
_sigma
(
left
,
right
,
opts
)
{
function
_sigma
(
left
,
right
)
{
try
{
return
right
(
new
sigma
(
opts
));
return
right
(
new
sigma
());
}
catch
(
e
)
{
return
left
(
e
);
}
...
...
src/Gargantext/Hooks/Sigmax/Sigma.purs
View file @
bac07dd6
...
...
@@ -2,7 +2,9 @@ module Gargantext.Hooks.Sigmax.Sigma where
import Prelude
import Data.Either (Either(..))
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Nullable (null)
import DOM.Simple.Console (log)
import Effect (Effect, foreachE)
import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, mkEffectFn1, runEffectFn1, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3, EffectFn4, runEffectFn4)
...
...
@@ -27,15 +29,14 @@ instance edgeProps
type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }
type SigmaOpts s = { settings :: s }
sigma :: forall
opts err. SigmaOpts opts -> Effect
(Either err Sigma)
sigma
= runEffectFn3
_sigma Left Right
sigma :: forall
err. Unit ->
(Either err Sigma)
sigma
_ = runFn2
_sigma Left Right
foreign import _sigma ::
forall a b opts err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
(SigmaOpts opts)
(Either err Sigma)
forall a b err.
Fn2 (a -> Either a b)
(b -> Either a b)
(Either err Sigma)
graphRead :: forall node edge err. Sigma -> Graph node edge -> Effect (Either err Unit)
graphRead = runEffectFn4 _graphRead Left Right
...
...
@@ -58,13 +59,15 @@ refreshForceAtlas sigma = do
isRunning <- isForceAtlas2Running sigma
if isRunning then
pure unit
else do
_ <- setTimeout 100 $ do
restartForceAtlas2 sigma
_ <- setTimeout 100 $
stopForceAtlas2 sigma
pure unit
pure unit
else
void do
log "refreshForceAtlas not running"
setTimeout 100 $ void do
log "refreshForceAtlas restarting"
restartForceAtlas2 sigma
setTimeout 2000 $ void do
log "refreshForceAtlas stopping"
stopForceAtlas2 sigma
addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
addRenderer = runEffectFn4 _addRenderer Left Right
...
...
@@ -109,9 +112,7 @@ bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
setSettings :: forall settings. Sigma -> settings -> Effect Unit
setSettings sigma settings = do
runEffectFn2 _setSettings sigma settings
refresh sigma
setSettings = runEffectFn2 _setSettings
foreign import _setSettings :: forall settings. EffectFn2 Sigma settings Unit
...
...
@@ -122,7 +123,7 @@ restartForceAtlas2 :: Sigma -> Effect Unit
restartForceAtlas2 sigma = runEffectFn2 _startForceAtlas2 sigma null
stopForceAtlas2 :: Sigma -> Effect Unit
stopForceAtlas2
= runEffectFn1 _stopForceAtlas2
stopForceAtlas2
s = runEffectFn1 _stopForceAtlas2 s *> log "stopped"
killForceAtlas2 :: Sigma -> Effect Unit
killForceAtlas2 = runEffectFn1 _killForceAtlas2
...
...
src/Gargantext/Sessions.purs
View file @
bac07dd6
...
...
@@ -112,10 +112,10 @@ instance encodeJsonSessions :: EncodeJson Sessions where
unSessions :: Sessions -> Array Session
unSessions (Sessions {sessions:s}) = A.fromFoldable s
useSessions :: R.Hooks (R2.Reduc
to
r Sessions Action)
useSessions = R2.useReduc
tor actAndSave (const loadSessions) unit
useSessions :: R.Hooks (R2.Reduc
e
r Sessions Action)
useSessions = R2.useReduc
er unit (const loadSessions) actAndSave
where
actAndSave :: R2.
Actor
Sessions Action
actAndSave :: R2.
Reduce
Sessions Action
actAndSave a s = act s a >>= saveSessions
lookup :: SessionId -> Sessions -> Maybe Session
...
...
src/Gargantext/Utils/Reactix.purs
View file @
bac07dd6
...
...
@@ -28,10 +28,8 @@ newtype Point = Point { x :: Number, y :: Number }
-- a setter function, for useState
type Setter t = (t -> t) -> Effect Unit
-- a reducer function living in effector, for useReductor
-- | Turns a ReactElement into a
f
Reactix Element
-- | buff (v.) to polish
buff :: ReactElement -> R.Element
buff = unsafeCoerce
...
...
@@ -41,18 +39,6 @@ buff = unsafeCoerce
scuff :: R.Element -> ReactElement
scuff = unsafeCoerce
-- class ToElement a where
-- toElement :: a -> R.Element
-- instance toElementElement :: ToElement R.Element where
-- toElement = identity
-- instance toElementReactElement :: ToElement ReactElement where
-- toElement = buff
-- instance toElementArray :: ToElement a => ToElement (Array a) where
-- toElement = R.fragment <<< map toElement
createElement' :: forall required given
. ReactPropFields required given
=> ReactClass { children :: Children | required }
...
...
@@ -60,15 +46,6 @@ createElement' :: forall required given
createElement' reactClass props children =
buff $ React.createElement reactClass props $ scuff <$> children
{-
instance isComponentReactClass
:: R.IsComponent (ReactClass { children :: Children
| props
}) props (Array R.Element) where
createElement reactClass props children =
React.createElement reactClass props children
-}
-- | Turns an aff into a useEffect-compatible Effect (Effect Unit)
affEffect :: forall a. String -> Aff a -> Effect (Effect Unit)
affEffect errmsg aff = do
...
...
@@ -80,6 +57,7 @@ mousePosition e = Point { x: RE.clientX e, y: RE.clientY e }
domMousePosition :: DE.MouseEvent -> Point
domMousePosition = mousePosition <<< unsafeCoerce
-- | This is naughty, it quietly mutates the input and returns it
named :: forall o. String -> o -> o
named = flip $ defineProperty "name"
...
...
@@ -125,6 +103,12 @@ readPositionRef el = do
let posRef = R.readRef el
Element.boundingRect <$> toMaybe posRef
readRefE :: forall r. R.Ref r -> Effect r
readRefE ref = delay unit $ \_ -> pure $ R.readRef ref
readNullableRefE :: forall r. R.Ref (Nullable r) -> Effect (Maybe r)
readNullableRefE ref = delay unit $ \_ -> pure $ R.readNullableRef ref
unsafeEventTarget :: forall event. event -> DOM.Element
unsafeEventTarget e = (unsafeCoerce e).target
...
...
@@ -151,19 +135,22 @@ showText = text <<< show
----- Reactix's new effectful reducer: sneak-peek because anoe wants to demo on tuesday
type Reduce state action = action -> state -> Effect state
-- | Like a reducer, but lives in Effect
type Reduc
to
r state action = Tuple state (action -> Effect Unit)
type Reduc
e
r state action = Tuple state (action -> Effect Unit)
-- | Like useReductor, but lives in Effect
useReduc
tor :: forall s a i. Actor s a -> (i -> Effect s) -> i -> R.Hooks (Reductor s a)
useReductor f i j =
hook $ \_ ->
pure $ currySecond $ tuple $ react ... "useReducer" $ args3 (mkEffectFn2 (flip f)) j (mkEffectFn1 i)
useReducer :: forall s a i. i -> (i -> Effect s) -> Reduce s a -> R.Hooks (Reducer s a)
useReduc
er initArg init reducer =
hook $ \_ -> pure $ currySecond $ tuple $ react ... "useReducer" $ args
where
args = args3 (mkEffectFn2 (flip reducer)) initArg init
-- | Like `useReduc
to
r`, but takes an initial state instead of an
-- | Like `useReduc
e
r`, but takes an initial state instead of an
-- | initialiser function and argument
useReduc
tor' :: forall s a. Actor s a -> s -> R.Hooks (Reducto
r s a)
useReduc
tor' r = useReductor r
pure
useReduc
er' :: forall s a. s -> Reduce s a -> R.Hooks (Reduce
r s a)
useReduc
er' initArg = useReducer initArg
pure
render :: R.Element -> DOM.Element -> Effect Unit
render e d = delay unit $ \_ -> pure $ R.reactDOM ... "render" $ args2 e d
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment