Commit bac07dd6 authored by James Laver's avatar James Laver

push for seeg

parent 7e558a0b
......@@ -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 forceatlas2 =
type Props sigma fa2 =
( graph :: Graph
, forceAtlas2Settings :: forceatlas2
, forceAtlas2Settings :: fa2
, 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
......
......@@ -29,7 +29,7 @@ import Gargantext.Utils.Reactix as R2
type Props =
( backends :: Array Backend
, sessions :: R2.Reductor Sessions Sessions.Action
, sessions :: R2.Reducer 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.Reductor Sessions Sessions.Action -> R.Element
renderSessions :: R2.Reducer Sessions Sessions.Action -> R.Element
renderSessions sessions = R.fragment (renderSession sessions <$> unSessions (fst sessions))
renderSession :: R2.Reductor Sessions Sessions.Action -> Session -> R.Element
renderSession :: R2.Reducer 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.Reductor Sessions Sessions.Action
, sessions :: R2.Reducer Sessions Sessions.Action
, visible :: R.State Boolean )
form :: Record FormProps -> R.Element
......
......@@ -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.useReductor' performNgramsAction init
useNgramsReducer init = R2.useReducer' init performNgramsAction
performNgramsAction :: Action' -> State -> Effect State
performNgramsAction (SetParentResetChildren' term) = pure -- TODO
......
......@@ -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
......
......@@ -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);
}
......
......@@ -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
......
......@@ -112,10 +112,10 @@ instance encodeJsonSessions :: EncodeJson Sessions where
unSessions :: Sessions -> Array Session
unSessions (Sessions {sessions:s}) = A.fromFoldable s
useSessions :: R.Hooks (R2.Reductor Sessions Action)
useSessions = R2.useReductor actAndSave (const loadSessions) unit
useSessions :: R.Hooks (R2.Reducer Sessions Action)
useSessions = R2.useReducer 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
......
......@@ -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 fReactix 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 Reductor state action = Tuple state (action -> Effect Unit)
type Reducer state action = Tuple state (action -> Effect Unit)
-- | Like useReductor, but lives in Effect
useReductor :: 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)
useReducer initArg init reducer =
hook $ \_ -> pure $ currySecond $ tuple $ react ... "useReducer" $ args
where
args = args3 (mkEffectFn2 (flip reducer)) initArg init
-- | Like `useReductor`, but takes an initial state instead of an
-- | Like `useReducer`, but takes an initial state instead of an
-- | initialiser function and argument
useReductor' :: forall s a. Actor s a -> s -> R.Hooks (Reductor s a)
useReductor' r = useReductor r pure
useReducer' :: forall s a. s -> Reduce s a -> R.Hooks (Reducer s a)
useReducer' initArg = useReducer initArg pure
render :: R.Element -> DOM.Element -> Effect Unit
render e d = delay unit $ \_ -> pure $ R.reactDOM ... "render" $ args2 e d
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