Commit dcc61ff7 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'feature/toestand-global-state' of...

Merge branch 'feature/toestand-global-state' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 57258f2d d5c430c4
...@@ -401,15 +401,324 @@ And with that, we've covered the entire lifecycle: ...@@ -401,15 +401,324 @@ And with that, we've covered the entire lifecycle:
And all of that controlled by just a render function! And all of that controlled by just a render function!
### Reconciliation with reality ## Handling state with Toestand
So far, we've largely glossed over the part that links the virtual DOM Dealing with state storage in React can seem a bit daunting at
with the real DOM. This is react's [reconciliation algorithm.](https://reactjs.org/docs/reconciliation.html). first. There are too many options and it's not always obvious which
you need. On top of that, if you change later, you have to rewrite a
lot of code.
Toestand is a new purescript library built on top of Reactix. It aims
to provide one extremely flexible state type, `Toestand.Box a` that is
suitable for the majority of usecases.
Passed as a property, a `Box` is like a Reactix Ref - irrelevant for
prop diffing purposes. Changing the value stored in the box does not
cause a rerender by itself.
With the `Toestand.useLive` hook, a component can opt in to rerender
when the value changes (like a `State`, but sharing the same
type!). While most of the time you will want to check equality, you
can provide a custom predicate and only rerender when you want to.
### My first box
Let's pick up our counter from earlier and rewrite it to use
Toestand. Not much code actually changes, it's pretty similar to
before:
```purescript
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
counterCpt :: R.Component Counter
counterCpt = R.hooksComponent "counter" cpt where
cpt { initialCount } _children = do
-- Create the box with the initial value
box <- T.useBox initialCount
-- Subscribe to a live count when it changes
count <- T.useLive T.unequal box
pure $ H.div {}
[ button { box }
, clicks { clicks: count } ]
-- The button now takes a box instead of a setter function.
type Button = ( setter :: T.Box Int )
buttonCpt :: R.Component Button
buttonCpt = R.hooksComponent "button" cpt where
cpt { box } _children =
pure $ H.button { on: { click } } [ H.text "Don't click me" ] where
-- Increment the value in the box
click _event = T.modify_ (_ + 1) } box
-- Everything else is identical and here for completeness.
helloCounter :: R.Element
helloCounter = counter { initialCount: 1 }
type Counter = ( initialCount :: Int )
counter :: Record Counter -> R.Element
counter props = R.createElement counterCpt props []
button :: Record Button -> R.Element
button props = R.createElement buttonCpt props []
type Clicks = ( clicks :: Int )
clicks :: Record Clicks -> R.Element
clicks props = R.createElement clicksCpt props []
clicksCpt :: R.Component Clicks
clicksCpt = R.hooksComponent "clicks" cpt where
cpt { clicks } _children =
pure $ H.text $ "Clicked " <> show clicks <> " times"
```
### Core Toestand API: a closer look
`useBox` has a fairly straightforward type signature:
```purescript
-- Creates a new Box inside a component from an initial value
useBox :: forall b. b -> R.Hooks (Box b)
```
`modify_` is slightly more complicated. `ReadWrite` is a typeclass
that `Box` implements. This constraint is basically saying a `v` can
be read from and written to a `box`. So given a function that takes
and returns a value and a box, modify the value by applying that
function to the current value of the box:
```purescript
modify_ :: forall box v. ReadWrite box v => (v -> v) -> box -> Effect Unit
```
As you might have guessed, `modify` exists too, and returns the newly set value:
```purescript
modify :: forall c v. ReadWrite c v => (v -> v) -> c -> Effect v
```
The `ReadWrite` class is actually methodless, it is a shorthand way of
referring to both the `Read` and `Write` classes:
```purescript
class (Read box val, Write box val) <= ReadWrite box val | box -> val
instance readWrite :: (Read box val, Write box val) => ReadWrite box val
```
When you don't care about the current value, you can use `write`, the
singular method of the `Write` typeclass. Its effective type is
similar to `modify` but simpler, reflecting our lack of need to read
from it:
```purescript
write :: forall box v. Write box v => v -> box -> Effect v
```
There is also the corresponding `write_` for when you want a Unit return:
```purescript
write_ :: forall box v. Write box v => v -> box -> Effect Unit
```
`read` is the most important method of the `Read` typeclass. Its effective type is:
```purescript
read :: forall box v m. Read box v => MonadDelay m => box -> m v
```
`MonadDelay` is implemented by two types we already know:
* `Effect`
* `Hooks`
This means reading can be done in either monad.
### Advanced reactix ### Live updates
The astute reader may notice that `useLive` was used in our first
example but not covered in our last section. Explaining it will take a
little longer...
Boxes have another functionality: a hook to call a function when the
value is written. Registering one of these is the purpose of the other
function in the `Read` typeclass, `listen`, which has the following
effective type:
```purescript
listen :: forall box v. Read box v => Listener v -> box -> Effect (Effect Unit)
```
We'll take that in two bites, first, the `Listener`:
```purescript
forall box v. Read box v => Listener v
```
Here's how `Listener` (and the `Change` that it mentions) are defined:
```purescript
-- | A summary of a change in value
type Change c = { new :: c, old :: c }
-- | An Effect function which is provided the new and old values.
type Listener c = Change c -> Effect Unit
```
So to listen, we provide an effectful `Listener`, which receives the
new and old values. Whenever someone calls `write` (or a function that
wraps it) on a `Box`, our callback will be executed.
The type of `listen` ends thus:
```purescript
Effect (Effect Unit)
```
Remember that an `Effect` is internally a 0-arity function used to delay the execution of some code.
The inner `Effect Unit` is a means of cancelling the subscription we
established. The outer `Effect` is used to return it without executing
it.
So, you provide a listener (which can execute effects) and you get
back a means of cancelling when you no longer need to listen. Neat!
Now we just need one more type before we can look at `useLive`:
```purescript
-- | An effect function which determines whether notifications should be sent.
type ShouldReload c = Change c -> Effect Boolean
```
Toestand ships with just one function of this type, `unequal`, which
does what you'd expect (i.e. it's `Prelude.notEq`, but in Effect):
```purescript
unequal :: forall v. Eq v => Change v -> Effect Boolean
```
And finally, we're ready to study `useLive`:
```purescript
useLive :: forall box b. Read box b => ShouldReload b -> box -> R.Hooks b
```
Wondering how it works?
* It uses `useState` to create a counter.
* It registers a listener with `listen` to hear when writes are performed.
* When a write is performed, the `ShouldReload` callback is executed.
* If it returns true, the counter is incremented.
Once you know how it works, it's not actually so mysterious :)
The nice thing about `useState` is it pushes the choice about whether
to refresh to the component that uses it. Because it even allows you
to customise the logic, it is incredibly flexible.
### Focused boxes and the single source of truth
By now, we hope you think Toestand is as cool as we do. But it's not done yet!
Sometimes, you'd like to have a box containing a data structure of
state (say a record, for example) and only pass a part of it on to a
child component, as another Box.
That was a bit of a mouthful, let's look at an example:
```purescript
use Reactix as R
use Toestand as T
type Bigger = ( count :: Int, start :: Int )
useCountBox :: Box (Record Bigger) -> R.Hooks (T.Box Int)
useCountBox box = R.useFocused reader writer box where
reader :: Record Bigger -> Int
reader {count} = count
writer :: Int -> Record Bigger -> Record Bigger
writer count old = old { count = count }
```
We have overannotated the types to be clearer here. `reader` is a
function that can look up `count` in a `Bigger` record and return
it. `write` is a function that can set a new `count` in a `Bigger`.
The `Box` that `useCountBox` takes is linked to the new `Box` it
returns. When the value inside the original `Box` changes, the value
inside the focused box may also appear to be changed, depending on the
read function. You can even write to the returned Box and have it
update the original, you just have to pass the right writer function!
If you are a haskell programmer, you may recognise the reader and
writer together as being a van Laarhoven-style lens, as used by most
of the haskell lens libraries. Indeed it is, but this is as complex as
ours get - no prisms or anything fancy.
The particular case of turning a `Box (Record a)` into `focused field
boxes` is in fact so common that we ship it in Toestand as
`useFocusedFields`:
```purescript
import Toestand as T
type Bigger = ( count :: Int, start :: Int )
type Smaller = ( count :: T.Box Int, start :: T.Box Int )
useSmaller :: T.Box (Record Bigger) -> R.Hooks (Record Smaller)
useSmaller box = T.useFocusedFields box {}
```
The final argument, {} is the base record to add the cursors to.
## Advanced Reactix
<!-- ### Reactix is a bad purescript library -->
<!-- Reactix is one of those libraries that was written because we needed -->
<!-- it and that would be great if it got all the time and attention other -->
<!-- things get. -->
<!-- This isn't to say Reactix sucks, on the contrary we're generally quite -->
<!-- fond of it, but using it effectively means understanding its -->
<!-- limitations and figuring out how to make peace with its requirements -->
<!-- of you. -->
<!-- Firstly, it's not finished. It was hastily written and we've really -->
<!-- only maintained it as much as we need to and no more. -->
<!-- In attempting to be a lightweight wrapper over modern React, Reactix -->
<!-- does not always behave the way you might expect a purescript library -->
<!-- to. In -->
<!-- ### Limitations of Reactix -->
<!-- Reactix is meant to be a relatively barebones binding to modern -->
<!-- React. Where purescript and react differ, react wins. -->
<!-- What do I mean by this? The `Hooks` monad is literally a newtype over -->
<!-- `Effect`. We take a very liberal view of this - when you are writing -->
<!-- code in `Hooks`, you are choosing to invert control to React and its -->
<!-- way of doing things. -->
<!-- It's not necessarily against the rules of purescript to do this, but -->
<!-- it does mean that some of the properties we often take for granted in -->
<!-- writing purescript code do not necessarily apply. -->
### Reconciliation and the rules of hooks
So far, we've largely glossed over the part that links the virtual DOM
with the real DOM. This is react's [reconciliation algorithm.](https://reactjs.org/docs/reconciliation.html).
This is probably a good time to mention one of the major current This is probably a good time to mention one of the major current
limitations of Reactix: the properties provided to html constructor limitations of Reactix: the properties provided to html constructor
......
...@@ -17,12 +17,13 @@ import Data.Maybe ( Maybe(..), maybe ) ...@@ -17,12 +17,13 @@ import Data.Maybe ( Maybe(..), maybe )
import Data.String.Common ( joinWith ) import Data.String.Common ( joinWith )
import Data.Tuple (Tuple(..), snd) import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ( (/\) ) import Data.Tuple.Nested ( (/\) )
--import DOM.Simple.Console (log2) -- import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect (Effect) import Effect (Effect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as HTML import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E import Reactix.SyntheticEvent as E
import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
...@@ -53,15 +54,16 @@ annotatedField = R.createElement annotatedFieldComponent ...@@ -53,15 +54,16 @@ annotatedField = R.createElement annotatedFieldComponent
annotatedFieldComponent :: R.Component Props annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = here.component "annotatedField" cpt annotatedFieldComponent = here.component "annotatedField" cpt
where where
cpt {ngrams, setTermList, text: fieldText} _ = do cpt { ngrams, setTermList, text: fieldText } _ = do
(_ /\ setRedrawMenu) <- R.useState' false redrawMenu <- T.useBox false
redrawMenu' <- T.useLive T.unequal redrawMenu
menuRef <- R.useRef (Nothing :: Maybe AnnotationMenu) menuRef <- R.useRef (Nothing :: Maybe AnnotationMenu)
let wrapperProps = { className: "annotated-field-wrapper" } let wrapperProps = { className: "annotated-field-wrapper" }
wrap (text /\ list) = { list wrap (text /\ list) = { list
, onSelect: onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList } , onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
, text } , text }
pure $ HTML.div wrapperProps pure $ HTML.div wrapperProps
...@@ -75,57 +77,69 @@ compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams) ...@@ -75,57 +77,69 @@ compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs -- Runs
onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList } Nothing event = do onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef :: R.Ref (Maybe AnnotationMenu)
, ngrams :: NgramsTable
, redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
-> Maybe (Tuple NgramsTerm TermList) -> E.SyntheticEvent e -> Effect Unit
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event = do
s <- Sel.getSelection s <- Sel.getSelection
case s of case s of
Just sel -> do Just sel -> do
case Sel.selectionToString sel of case Sel.selectionToString sel of
"" -> hideMenu { menuRef, setRedrawMenu } "" -> hideMenu { menuRef, redrawMenu }
sel' -> do sel' -> do
showMenu { event showMenu { event
, getList: findNgramTermList ngrams , getList: findNgramTermList ngrams
, menuRef , menuRef
, menuType: NewNgram , menuType: NewNgram
, ngram: normNgram CTabTerms sel' , ngram: normNgram CTabTerms sel'
, setRedrawMenu , redrawMenu
, setTermList } , setTermList }
Nothing -> hideMenu { menuRef, setRedrawMenu } Nothing -> hideMenu { menuRef, redrawMenu }
onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList } (Just (Tuple ngram list)) event = onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngram list)) event = do
showMenu { event showMenu { event
, getList: const (Just list) , getList: const (Just list)
, menuRef , menuRef
, menuType: SetTermListItem , menuType: SetTermListItem
, ngram , ngram
, setRedrawMenu , redrawMenu
, setTermList } , setTermList }
showMenu { event, getList, menuRef, menuType, ngram, setRedrawMenu, setTermList } = do -- showMenu :: forall p e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e | p } -> Effect Unit
showMenu :: forall e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e
, getList :: NgramsTerm -> Maybe TermList
, menuRef :: R.Ref (Maybe AnnotationMenu)
, menuType :: MenuType
, ngram :: NgramsTerm
, redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
-> Effect Unit
showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = do
let x = E.clientX event let x = E.clientX event
y = E.clientY event y = E.clientY event
-- n = normNgram CTabTerms text -- n = normNgram CTabTerms text
list = getList ngram list = getList ngram
redrawMenu = setRedrawMenu not -- redrawMenu = T.modify not redrawMenu
setList t = do setList t = do
setTermList ngram list t setTermList ngram list t
hideMenu { menuRef, setRedrawMenu } hideMenu { menuRef, redrawMenu }
E.preventDefault event E.preventDefault event
--range <- Sel.getRange sel 0 --range <- Sel.getRange sel 0
--log2 "[showMenu] selection range" $ Sel.rangeToTuple range --log2 "[showMenu] selection range" $ Sel.rangeToTuple range
let menu = Just let menu = Just
{ x { list
, y , onClose: hideMenu { menuRef, redrawMenu }
, list
, menuType , menuType
, onClose: hideMenu { menuRef, setRedrawMenu }
, setList , setList
} , x
, y }
R.setRef menuRef menu R.setRef menuRef menu
redrawMenu T.modify_ not redrawMenu
hideMenu { menuRef, setRedrawMenu } = do hideMenu { menuRef, redrawMenu } = do
let redrawMenu = setRedrawMenu not
R.setRef menuRef Nothing R.setRef menuRef Nothing
redrawMenu T.modify_ not redrawMenu
type Run = type Run =
( list :: List (Tuple NgramsTerm TermList) ( list :: List (Tuple NgramsTerm TermList)
......
...@@ -25,12 +25,12 @@ appCpt = here.component "app" cpt where ...@@ -25,12 +25,12 @@ appCpt = here.component "app" cpt where
cpt _ _ = do cpt _ _ = do
box <- T.useBox emptyApp -- global data box <- T.useBox emptyApp -- global data
boxes <- T.useFocusedFields box {} -- read-write access for children boxes <- T.useFocusedFields box {} -- read-write access for children
tasks <- T.useBox Nothing -- storage for asynchronous tasks reductor -- tasks <- T.useBox Nothing -- storage for asynchronous tasks reductor
R.useEffectOnce' $ do R.useEffectOnce' $ do
void $ Sessions.load boxes.sessions void $ Sessions.load boxes.sessions
tasksReductor <- GAT.useTasks boxes.reloadRoot boxes.reloadForest tasks <- GAT.useTasks boxes.reloadRoot boxes.reloadForest
R.useEffectOnce' $ do -- R.useEffectOnce' $ do
T.write (Just tasksReductor) tasks -- T.write (Just tasksReductor) tasks
R.useEffectOnce' $ do R.useEffectOnce' $ do
R2.loadLocalStorageState R2.openNodesKey boxes.forestOpen R2.loadLocalStorageState R2.openNodesKey boxes.forestOpen
T.listen (R2.listenLocalStorageState R2.openNodesKey) boxes.forestOpen T.listen (R2.listenLocalStorageState R2.openNodesKey) boxes.forestOpen
......
...@@ -2,7 +2,6 @@ ...@@ -2,7 +2,6 @@
module Gargantext.Components.ContextMenu.ContextMenu where module Gargantext.Components.ContextMenu.ContextMenu where
-- (MenuProps, Action(..), separator) where -- (MenuProps, Action(..), separator) where
import Prelude hiding (div)
import Data.Maybe ( Maybe(..) ) import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe ) import Data.Nullable ( Nullable, null, toMaybe )
import Data.Tuple.Nested ( (/\) ) import Data.Tuple.Nested ( (/\) )
...@@ -18,6 +17,9 @@ import Effect (Effect) ...@@ -18,6 +17,9 @@ import Effect (Effect)
import FFI.Simple ((..)) import FFI.Simple ((..))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as HTML import Reactix.DOM.HTML as HTML
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -25,9 +27,9 @@ here :: R2.Here ...@@ -25,9 +27,9 @@ here :: R2.Here
here = R2.here "Gargantext.Components.ContextMenu.ContextMenu" here = R2.here "Gargantext.Components.ContextMenu.ContextMenu"
type Props t = ( type Props t = (
x :: Number onClose :: Effect Unit
, x :: Number
, y :: Number , y :: Number
, onClose :: Effect Unit
) )
contextMenu :: forall t. R2.Component (Props t) contextMenu :: forall t. R2.Component (Props t)
...@@ -39,10 +41,12 @@ contextMenuCpt = here.component "contextMenu" cpt ...@@ -39,10 +41,12 @@ contextMenuCpt = here.component "contextMenu" cpt
cpt menu@{ x, y, onClose } children = do cpt menu@{ x, y, onClose } children = do
host <- R2.getPortalHost host <- R2.getPortalHost
root <- R.useRef null root <- R.useRef null
rect /\ setRect <- R.useState $ \_ -> Nothing rect <- T.useBox Nothing
rect' <- T.useLive T.unequal rect
R.useLayoutEffect1 (R.readRef root) $ do R.useLayoutEffect1 (R.readRef root) $ do
traverse_ traverse_
(\r -> setRect (\_ -> Just (Element.boundingRect r))) (\r -> T.write_ (Just (Element.boundingRect r)) rect)
(toMaybe $ R.readRef root) (toMaybe $ R.readRef root)
pure $ pure unit pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect onClose root) R.useLayoutEffect2 root rect (contextMenuEffect onClose root)
...@@ -54,7 +58,7 @@ contextMenuCpt = here.component "contextMenu" cpt ...@@ -54,7 +58,7 @@ contextMenuCpt = here.component "contextMenu" cpt
] ]
] ]
] ]
pure $ R.createPortal [ elems root menu rect $ cs ] host pure $ R.createPortal [ elems root menu rect' $ cs ] host
elems ref menu (Just rect) = HTML.div elems ref menu (Just rect) = HTML.div
{ ref { ref
, key: "context-menu" , key: "context-menu"
......
...@@ -33,11 +33,12 @@ here = R2.here "Gargantext.Components.Forest" ...@@ -33,11 +33,12 @@ here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree -- Shared by components here with Tree
type Common = type Common =
( frontends :: Frontends ( frontends :: Frontends
, handed :: T.Box Handed , handed :: T.Box Handed
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, route :: T.Box AppRoute , route :: T.Box AppRoute
, tasks :: T.Box (Maybe GAT.Reductor) -- , tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
) )
type Props = type Props =
...@@ -69,29 +70,32 @@ forestCpt = here.component "forest" cpt where ...@@ -69,29 +70,32 @@ forestCpt = here.component "forest" cpt where
, sessions , sessions
, showLogin , showLogin
, tasks } _ = do , tasks } _ = do
tasks' <- GAT.useTasks reloadRoot reloadForest -- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor
R.useEffect' $ T.write_ (Just tasks') tasks -- tasks' <- GAT.useTasks reloadRoot reloadForest
-- R.useEffect' $ do
-- T.write_ (Just tasks') tasks
handed' <- T.useLive T.unequal handed handed' <- T.useLive T.unequal handed
reloadForest' <- T.useLive T.unequal reloadForest reloadForest' <- T.useLive T.unequal reloadForest
reloadRoot' <- T.useLive T.unequal reloadRoot reloadRoot' <- T.useLive T.unequal reloadRoot
route' <- T.useLive T.unequal route route' <- T.useLive T.unequal route
forestOpen' <- T.useLive T.unequal forestOpen forestOpen' <- T.useLive T.unequal forestOpen
sessions' <- T.useLive T.unequal sessions sessions' <- T.useLive T.unequal sessions
-- TODO If `reloadForest` is set, `reload` state should be updated -- TODO If `reloadForest` is set, `reload` state should be updated
-- TODO fix tasks ref -- TODO fix tasks ref
-- R.useEffect' $ do -- R.useEffect' $ do
-- R.setRef tasks $ Just tasks' -- R.setRef tasks $ Just tasks'
R2.useCache R2.useCache
( frontends /\ route' /\ sessions' /\ handed' /\ forestOpen' ( frontends /\ route' /\ sessions' /\ handed' /\ forestOpen'
/\ reloadForest' /\ reloadRoot' /\ (fst tasks').storage ) /\ reloadForest' /\ reloadRoot' /\ (fst tasks).storage )
(cp handed' sessions' tasks') (cp handed' sessions')
where where
common = RX.pick props :: Record Common common = RX.pick props :: Record Common
cp handed' sessions' tasks' _ = cp handed' sessions' _ =
pure $ H.div { className: "forest" } pure $ H.div { className: "forest" }
(A.cons (plus handed' showLogin backend) (trees handed' sessions' tasks')) (A.cons (plus handed' showLogin backend) (trees handed' sessions'))
trees handed' sessions' tasks' = (tree handed' tasks') <$> unSessions sessions' trees handed' sessions' = (tree handed') <$> unSessions sessions'
tree handed' tasks' s@(Session {treeId}) = tree handed' s@(Session {treeId}) =
treeLoader { forestOpen treeLoader { forestOpen
, frontends , frontends
, handed: handed' , handed: handed'
...@@ -193,7 +197,7 @@ mainPage = R.createElement mainPageCpt ...@@ -193,7 +197,7 @@ mainPage = R.createElement mainPageCpt
-- mainPageCpt :: R.Memo () -- mainPageCpt :: R.Memo ()
-- mainPageCpt = R.memo (here.component "mainPage" cpt) where -- mainPageCpt = R.memo (here.component "mainPage" cpt) where
mainPageCpt :: R.Component() mainPageCpt :: R.Component ()
mainPageCpt = here.component "mainPage" cpt mainPageCpt = here.component "mainPage" cpt
where where
cpt _ children = do cpt _ children = do
......
...@@ -48,7 +48,8 @@ here = R2.here "Gargantext.Components.Forest.Tree" ...@@ -48,7 +48,8 @@ here = R2.here "Gargantext.Components.Forest.Tree"
-- Shared by every component here + performAction + nodeSpan -- Shared by every component here + performAction + nodeSpan
type Universal = type Universal =
( reloadRoot :: T.Box T2.Reload ( reloadRoot :: T.Box T2.Reload
, tasks :: T.Box (Maybe GAT.Reductor) ) -- , tasks :: T.Box (Maybe GAT.Reductor) )
, tasks :: GAT.Reductor )
-- Shared by every component here + nodeSpan -- Shared by every component here + nodeSpan
type Global = type Global =
...@@ -178,19 +179,13 @@ performAction (DeleteNode nt) p@{ forestOpen ...@@ -178,19 +179,13 @@ performAction (DeleteNode nt) p@{ forestOpen
performAction RefreshTree p performAction RefreshTree p
performAction (DoSearch task) p@{ tasks performAction (DoSearch task) p@{ tasks
, tree: (NTree (LNode {id}) _) } = liftEffect $ do , tree: (NTree (LNode {id}) _) } = liftEffect $ do
mT <- T.read tasks snd tasks $ GAT.Insert id task
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
log2 "[performAction] DoSearch task:" task log2 "[performAction] DoSearch task:" task
performAction (UpdateNode params) p@{ tasks performAction (UpdateNode params) p@{ tasks
, tree: (NTree (LNode {id}) _) } = do , tree: (NTree (LNode {id}) _) } = do
task <- updateRequest params p.session id task <- updateRequest params p.session id
liftEffect $ do liftEffect $ do
mT <- T.read tasks snd tasks $ GAT.Insert id task
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
log2 "[performAction] UpdateNode task:" task log2 "[performAction] UpdateNode task:" task
performAction (RenameNode name) p@{ tree: (NTree (LNode {id}) _) } = do performAction (RenameNode name) p@{ tree: (NTree (LNode {id}) _) } = do
void $ rename p.session id $ RenameValue { text: name } void $ rename p.session id $ RenameValue { text: name }
...@@ -213,19 +208,13 @@ performAction (UploadFile nodeType fileType mName blob) p@{ tasks ...@@ -213,19 +208,13 @@ performAction (UploadFile nodeType fileType mName blob) p@{ tasks
, tree: (NTree (LNode { id }) _) } = do , tree: (NTree (LNode { id }) _) } = do
task <- uploadFile p.session nodeType id fileType {mName, blob} task <- uploadFile p.session nodeType id fileType {mName, blob}
liftEffect $ do liftEffect $ do
mT <- T.read tasks snd tasks $ GAT.Insert id task
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
log2 "[performAction] UploadFile, uploaded, task:" task log2 "[performAction] UploadFile, uploaded, task:" task
performAction (UploadArbitraryFile mName blob) p@{ tasks performAction (UploadArbitraryFile mName blob) p@{ tasks
, tree: (NTree (LNode { id }) _) } = do , tree: (NTree (LNode { id }) _) } = do
task <- uploadArbitraryFile p.session id { blob, mName } task <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do liftEffect $ do
mT <- T.read tasks snd tasks $ GAT.Insert id task
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
performAction DownloadNode _ = liftEffect $ log "[performAction] DownloadNode" performAction DownloadNode _ = liftEffect $ log "[performAction] DownloadNode"
performAction (MoveNode {params}) p@{ forestOpen performAction (MoveNode {params}) p@{ forestOpen
......
...@@ -5,7 +5,7 @@ import Gargantext.Prelude ...@@ -5,7 +5,7 @@ import Gargantext.Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (null) import Data.Nullable (null)
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.Tuple (snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
...@@ -54,7 +54,7 @@ type NodeMainSpanProps = ...@@ -54,7 +54,7 @@ type NodeMainSpanProps =
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, route :: T.Box Routes.AppRoute , route :: T.Box Routes.AppRoute
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit)) , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
| CommonProps | CommonProps
) )
...@@ -91,16 +91,19 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -91,16 +91,19 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
} _ = do } _ = do
route' <- T.useLive T.unequal route route' <- T.useLive T.unequal route
-- only 1 popup at a time is allowed to be opened -- only 1 popup at a time is allowed to be opened
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile) droppedFile <- T.useBox (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false droppedFile' <- T.useLive T.unequal droppedFile
isDragOver <- T.useBox false
isDragOver' <- T.useLive T.unequal isDragOver
popoverRef <- R.useRef null popoverRef <- R.useRef null
R.useEffect' $ do R.useEffect' $ do
R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef
let isSelected = Just route' == Routes.nodeTypeAppRoute nodeType (sessionId session) id let isSelected = Just route' == Routes.nodeTypeAppRoute nodeType (sessionId session) id
tasks' <- T.read tasks -- tasks' <- T.read tasks
pure $ H.span (dropProps droppedFile isDragOver) pure $ H.span (dropProps droppedFile droppedFile' isDragOver isDragOver')
$ reverseHanded handed $ reverseHanded handed
[ folderIcon { folderOpen, nodeType } [] [ folderIcon { folderOpen, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf, nodeType } [] , chevronIcon { folderOpen, handed, isLeaf, nodeType } []
...@@ -114,7 +117,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -114,7 +117,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
, onFinish: onTaskFinish id t , onFinish: onTaskFinish id t
, session , session
} }
) $ GAT.getTasksMaybe tasks' id ) $ GAT.getTasks (fst tasks) id
) )
, if nodeType == GT.NodeUser , if nodeType == GT.NodeUser
then GV.versionView {session} then GV.versionView {session}
...@@ -139,10 +142,11 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -139,10 +142,11 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
] ]
where where
onTaskFinish id' t _ = do onTaskFinish id' t _ = do
mT <- T.read tasks snd tasks $ GAT.Finish id' t
case mT of -- mT <- T.read tasks
Just t' -> snd t' $ GAT.Finish id' t -- case mT of
Nothing -> pure unit -- Just t' -> snd t' $ GAT.Finish id' t
-- Nothing -> pure unit
T2.reload reloadRoot T2.reload reloadRoot
SettingsBox {show: showBox} = settingsBox nodeType SettingsBox {show: showBox} = settingsBox nodeType
...@@ -158,37 +162,37 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -158,37 +162,37 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
H.a { className: "settings fa fa-cog" H.a { className: "settings fa fa-cog"
, title : "Each node of the Tree can perform some actions.\n" , title : "Each node of the Tree can perform some actions.\n"
<> "Click here to execute one of them." } [] <> "Click here to execute one of them." } []
dropProps droppedFile isDragOver = dropProps droppedFile droppedFile' isDragOver isDragOver' =
{ className: "leaf " <> (dropClass droppedFile isDragOver) { className: "leaf " <> (dropClass droppedFile' isDragOver')
, on: { drop: dropHandler droppedFile , on: { drop: dropHandler droppedFile
, dragOver: onDragOverHandler isDragOver , dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver } , dragLeave: onDragLeave isDragOver }
} }
where where
dropClass (Just _ /\ _) _ = "file-dropped" dropClass (Just _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped" dropClass _ true = "file-dropped"
dropClass (Nothing /\ _) _ = "" dropClass Nothing _ = ""
dropHandler (_ /\ setDroppedFile) e = do
dropHandler droppedFile e = do
-- prevent redirection when file is dropped -- prevent redirection when file is dropped
E.preventDefault e E.preventDefault e
E.stopPropagation e E.stopPropagation e
blob <- R2.dataTransferFileBlob e blob <- R2.dataTransferFileBlob e
void $ launchAff do void $ launchAff do
--contents <- readAsText blob --contents <- readAsText blob
liftEffect $ setDroppedFile liftEffect $ T.write_
$ const (Just
$ Just $ DroppedFile { blob: (UploadFileBlob blob)
$ DroppedFile { blob: (UploadFileBlob blob) , fileType: Just CSV
, fileType: Just CSV , lang : EN
, lang : EN }) droppedFile
} onDragOverHandler isDragOver e = do
onDragOverHandler (_ /\ setIsDragOver) e = do
-- prevent redirection when file is dropped -- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471 -- https://stackoverflow.com/a/6756680/941471
E.preventDefault e E.preventDefault e
E.stopPropagation e E.stopPropagation e
setIsDragOver $ const true T.write_ true isDragOver
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false onDragLeave isDragOver _ = T.write_ false isDragOver
type FolderIconProps = ( type FolderIconProps = (
folderOpen :: T.Box Boolean folderOpen :: T.Box Boolean
......
module Gargantext.Components.Forest.Tree.Node.Action.Upload where module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Data.Either (fromRight) import Data.Either (fromRight)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..), fromJust, fromMaybe) import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.String.Regex as DSR import Data.String.Regex as DSR
...@@ -15,6 +17,7 @@ import Partial.Unsafe (unsafePartial) ...@@ -15,6 +17,7 @@ import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E import React.SyntheticEvent as E
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
-- import Web.File.Blob (Blob) -- import Web.File.Blob (Blob)
import Web.File.FileReader.Aff (readAsDataURL, readAsText) import Web.File.FileReader.Aff (readAsDataURL, readAsText)
...@@ -55,16 +58,19 @@ actionUpload _ _ _ _ = ...@@ -55,16 +58,19 @@ actionUpload _ _ _ _ =
-- file upload types -- file upload types
data DroppedFile = data DroppedFile =
DroppedFile { blob :: UploadFileBlob DroppedFile { blob :: UploadFileBlob
, fileType :: Maybe FileType , fileType :: Maybe FileType
, lang :: Lang , lang :: Lang
} }
derive instance genericDroppedFile :: Generic DroppedFile _
instance eqDroppedFile :: Eq DroppedFile where
eq = genericEq
type FileHash = String type FileHash = String
type UploadFile = type UploadFile =
{ blob :: UploadFileBlob { blob :: UploadFileBlob
, name :: String , name :: String
} }
...@@ -192,9 +198,9 @@ uploadButtonCpt = here.component "uploadButton" cpt ...@@ -192,9 +198,9 @@ uploadButtonCpt = here.component "uploadButton" cpt
-- START File Type View -- START File Type View
type FileTypeProps = type FileTypeProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, droppedFile :: R.State (Maybe DroppedFile) , droppedFile :: T.Box (Maybe DroppedFile)
, id :: ID , id :: ID
, isDragOver :: R.State Boolean , isDragOver :: T.Box Boolean
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
) )
...@@ -205,16 +211,21 @@ fileTypeViewCpt :: R.Component FileTypeProps ...@@ -205,16 +211,21 @@ fileTypeViewCpt :: R.Component FileTypeProps
fileTypeViewCpt = here.component "fileTypeView" cpt fileTypeViewCpt = here.component "fileTypeView" cpt
where where
cpt { dispatch cpt { dispatch
, droppedFile: Just (DroppedFile {blob, fileType}) /\ setDroppedFile , droppedFile
, isDragOver: (_ /\ setIsDragOver) , isDragOver
, nodeType , nodeType
} _ = pure } _ = do
$ H.div tooltipProps [ H.div { className: "card"} droppedFile' <- T.useLive T.unequal droppedFile
[ panelHeading
, panelBody case droppedFile' of
, panelFooter Nothing -> pure $ H.div {} []
] Just df@(DroppedFile { blob, fileType }) ->
] pure $ H.div tooltipProps [ H.div { className: "card"}
[ panelHeading
, panelBody df
, panelFooter df
]
]
where where
tooltipProps = { className: "" tooltipProps = { className: ""
, id : "file-type-tooltip" , id : "file-type-tooltip"
...@@ -231,30 +242,30 @@ fileTypeViewCpt = here.component "fileTypeView" cpt ...@@ -231,30 +242,30 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
, H.div {className: "col-md-2"} , H.div {className: "col-md-2"}
[ H.a {className: "btn glyphitem fa fa-remove-circle" [ H.a {className: "btn glyphitem fa fa-remove-circle"
, on: {click: \_ -> do , on: {click: \_ -> do
setDroppedFile $ const Nothing T.write_ Nothing droppedFile
setIsDragOver $ const false T.write_ false isDragOver
} }
, title: "Close"} [] , title: "Close"} []
] ]
] ]
] ]
panelBody = panelBody (DroppedFile { blob }) =
H.div {className: "card-body"} H.div {className: "card-body"}
[ R2.select {className: "col-md-12 form-control" [ R2.select {className: "col-md-12 form-control"
, on: {change: onChange} , on: {change: onChange blob}
} }
(map renderOption [CSV, CSV_HAL, WOS]) (map renderOption [CSV, CSV_HAL, WOS])
] ]
where where
onChange e l = onChange blob e l =
setDroppedFile $ const $ Just $ DroppedFile $ { blob T.write_ (Just $ DroppedFile $ { blob
, fileType: read $ R.unsafeEventValue e , fileType: read $ R.unsafeEventValue e
, lang : fromMaybe EN $ read $ R.unsafeEventValue l , lang : fromMaybe EN $ read $ R.unsafeEventValue l
} }) droppedFile
renderOption opt = H.option {} [ H.text $ show opt ] renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter = panelFooter (DroppedFile { blob, fileType }) =
H.div {className: "card-footer"} H.div {className: "card-footer"}
[ [
case fileType of case fileType of
...@@ -262,7 +273,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt ...@@ -262,7 +273,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
H.button {className: "btn btn-success" H.button {className: "btn btn-success"
, type: "button" , type: "button"
, on: {click: \_ -> do , on: {click: \_ -> do
setDroppedFile $ const Nothing T.write_ Nothing droppedFile
launchAff $ dispatch $ UploadFile nodeType ft Nothing blob launchAff $ dispatch $ UploadFile nodeType ft Nothing blob
} }
} [H.text "Upload"] } [H.text "Upload"]
...@@ -272,9 +283,6 @@ fileTypeViewCpt = here.component "fileTypeView" cpt ...@@ -272,9 +283,6 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
} [H.text "Upload"] } [H.text "Upload"]
] ]
cpt {droppedFile: (Nothing /\ _)} _ = do
pure $ H.div {} []
newtype FileUploadQuery = FileUploadQuery { newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType fileType :: FileType
......
...@@ -4,9 +4,9 @@ import Data.Generic.Rep (class Generic) ...@@ -4,9 +4,9 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Web.File.Blob (Blob) import Web.File.Blob (Blob, size)
import Gargantext.Prelude (class Read, class Show, class Eq) import Gargantext.Prelude
data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary
...@@ -27,3 +27,6 @@ instance readFileType :: Read FileType where ...@@ -27,3 +27,6 @@ instance readFileType :: Read FileType where
newtype UploadFileBlob = UploadFileBlob Blob newtype UploadFileBlob = UploadFileBlob Blob
derive instance genericUploadFileBlob :: Generic UploadFileBlob _
instance eqUploadFileBlob :: Eq UploadFileBlob where
eq (UploadFileBlob b1) (UploadFileBlob b2) = eq (size b1) (size b2)
...@@ -2,7 +2,6 @@ module Gargantext.Components.Forest.Tree.Node.Box where ...@@ -2,7 +2,6 @@ module Gargantext.Components.Forest.Tree.Node.Box where
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -16,7 +15,6 @@ import Gargantext.Components.Forest.Tree.Node.Action.Documentation (actionDoc) ...@@ -16,7 +15,6 @@ import Gargantext.Components.Forest.Tree.Node.Action.Documentation (actionDoc)
import Gargantext.Components.Forest.Tree.Node.Action.Download (actionDownload) import Gargantext.Components.Forest.Tree.Node.Action.Download (actionDownload)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameAction) import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameAction)
import Gargantext.Components.Forest.Tree.Node.Action.Search (actionSearch) import Gargantext.Components.Forest.Tree.Node.Action.Search (actionSearch)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Update (update) import Gargantext.Components.Forest.Tree.Node.Action.Update (update)
...@@ -51,7 +49,7 @@ nodePopupCpt = here.component "nodePopupView" cpt where ...@@ -51,7 +49,7 @@ nodePopupCpt = here.component "nodePopupView" cpt where
nodePopup <- T.useBox { action: Nothing, id, name, nodeType } nodePopup <- T.useBox { action: Nothing, id, name, nodeType }
action <- T.useFocused (_.action) (\a b -> b { action = a }) nodePopup action <- T.useFocused (_.action) (\a b -> b { action = a }) nodePopup
nodePopup' <- T.useLive T.unequal nodePopup nodePopup' <- T.useLive T.unequal nodePopup
search <- R.useState' $ defaultSearch { node_id = Just p.id }
pure $ H.div tooltipProps pure $ H.div tooltipProps
[ H.div { className: "popup-container" } [ H.div { className: "popup-container" }
[ H.div { className: "card" } [ H.div { className: "card" }
......
...@@ -53,7 +53,7 @@ type BaseProps = ...@@ -53,7 +53,7 @@ type BaseProps =
, route :: T.Box AppRoute , route :: T.Box AppRoute
, sessions :: T.Box Sessions , sessions :: T.Box Sessions
, showLogin :: T.Box Boolean , showLogin :: T.Box Boolean
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type LayoutLoaderProps = ( session :: R.Context Session | BaseProps ) type LayoutLoaderProps = ( session :: R.Context Session | BaseProps )
...@@ -277,7 +277,7 @@ type TreeProps = ( ...@@ -277,7 +277,7 @@ type TreeProps = (
, sessions :: T.Box Sessions , sessions :: T.Box Sessions
, show :: Boolean , show :: Boolean
, showLogin :: T.Box Boolean , showLogin :: T.Box Boolean
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type MSidebarProps = type MSidebarProps =
......
module Gargantext.Components.Loader where
import Prelude
import Data.Maybe (Maybe(..), maybe')
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Loader"
type Props path loaded =
( path :: path
, load :: path -> Aff loaded
, paint :: loaded -> R.Element )
loader :: forall path loaded. path
-> (path -> Aff loaded)
-> (loaded -> R.Element)
-> R.Element
loader path load paint =
R.createElement loaderCpt {path,load,paint} []
loaderCpt :: forall path loaded. R.Component (Props path loaded)
loaderCpt = here.component "loader" cpt where
cpt {path, load, paint} _ = do
(loaded /\ setLoaded) <- R.useState' Nothing
R.useEffect3 path load paint $ do
R2.affEffect "G.H.Loader.useAff" $
load path >>= (liftEffect <<< setLoaded <<< const <<< Just)
pure $ maybe' (\_ -> loadingSpinner {}) paint loaded
...@@ -263,7 +263,7 @@ type CommonProps = ( ...@@ -263,7 +263,7 @@ type CommonProps = (
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, sidePanelTriggers :: Record NT.SidePanelTriggers , sidePanelTriggers :: Record NT.SidePanelTriggers
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
, withAutoUpdate :: Boolean , withAutoUpdate :: Boolean
) )
......
...@@ -1184,7 +1184,7 @@ chartsAfterSync :: forall props discard. ...@@ -1184,7 +1184,7 @@ chartsAfterSync :: forall props discard.
, tabType :: TabType , tabType :: TabType
| props | props
} }
-> T.Box (Maybe GAT.Reductor) -> GAT.Reductor
-> T.Box T2.Reload -> T.Box T2.Reload
-> discard -> discard
-> Aff Unit -> Aff Unit
...@@ -1192,12 +1192,8 @@ chartsAfterSync path'@{ nodeId } tasks reloadForest _ = do ...@@ -1192,12 +1192,8 @@ chartsAfterSync path'@{ nodeId } tasks reloadForest _ = do
task <- postNgramsChartsAsync path' task <- postNgramsChartsAsync path'
liftEffect $ do liftEffect $ do
log2 "[chartsAfterSync] Synchronize task" task log2 "[chartsAfterSync] Synchronize task" task
mT <- T.read tasks snd tasks $ GAT.Insert nodeId task
case mT of T2.reload reloadForest
Nothing -> log "[chartsAfterSync] tasks is Nothing"
Just tasks' -> do
snd tasks' (GAT.Insert nodeId task) -- *> T2.reload reloadForest
T2.reload reloadForest
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
......
...@@ -59,7 +59,7 @@ type TabsProps = ...@@ -59,7 +59,7 @@ type TabsProps =
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
tabs :: R2.Leaf TabsProps tabs :: R2.Leaf TabsProps
...@@ -136,5 +136,5 @@ type NTCommon = ...@@ -136,5 +136,5 @@ type NTCommon =
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
...@@ -155,7 +155,7 @@ type LayoutNoSessionProps = ...@@ -155,7 +155,7 @@ type LayoutNoSessionProps =
, nodeId :: Int , nodeId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type LayoutProps = WithSession LayoutNoSessionProps type LayoutProps = WithSession LayoutNoSessionProps
......
...@@ -141,7 +141,7 @@ listElement = H.li { className: "list-group-item justify-content-between" } ...@@ -141,7 +141,7 @@ listElement = H.li { className: "list-group-item justify-content-between" }
type BasicProps = type BasicProps =
( frontends :: Frontends ( frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type ReloadProps = type ReloadProps =
......
...@@ -57,7 +57,7 @@ type TabsProps = ( ...@@ -57,7 +57,7 @@ type TabsProps = (
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
tabs :: Record TabsProps -> R.Element tabs :: Record TabsProps -> R.Element
...@@ -139,7 +139,7 @@ type NgramsViewTabsProps = ( ...@@ -139,7 +139,7 @@ type NgramsViewTabsProps = (
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
ngramsView :: R2.Component NgramsViewTabsProps ngramsView :: R2.Component NgramsViewTabsProps
......
...@@ -98,7 +98,7 @@ type CommonPropsNoSession = ...@@ -98,7 +98,7 @@ type CommonPropsNoSession =
, reloadForest :: T.Box T2.Reload , reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, sessionUpdate :: Session -> Effect Unit , sessionUpdate :: Session -> Effect Unit
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type CommonProps = WithSession CommonPropsNoSession type CommonProps = WithSession CommonPropsNoSession
......
...@@ -41,7 +41,7 @@ type Props = ( ...@@ -41,7 +41,7 @@ type Props = (
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record SidePanelTriggers , sidePanelTriggers :: Record SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type PropsWithKey = ( key :: String | Props ) type PropsWithKey = ( key :: String | Props )
......
...@@ -18,7 +18,7 @@ import Toestand as T ...@@ -18,7 +18,7 @@ import Toestand as T
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.Forest as Forest import Gargantext.Components.Forest as Forest
import Gargantext.Components.Loader (loader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.NgramsTable.Loader (clearCache) import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild) import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
...@@ -148,7 +148,7 @@ textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt ...@@ -148,7 +148,7 @@ textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt
R.useEffectOnce' $ do R.useEffectOnce' $ do
T.listen (\{ new } -> afterCacheStateChange new) cacheState T.listen (\{ new } -> afterCacheStateChange new) cacheState
pure $ loader { nodeId, session } loadCorpusWithChild $ useLoader { nodeId, session } loadCorpusWithChild $
\corpusData@{ corpusId, corpusNode, defaultListId } -> do \corpusData@{ corpusId, corpusNode, defaultListId } -> do
let NodePoly { date, hyperdata: Hyperdata h, name } = corpusNode let NodePoly { date, hyperdata: Hyperdata h, name } = corpusNode
CorpusInfo { authors, desc, query } = getCorpusInfo h.fields CorpusInfo { authors, desc, query } = getCorpusInfo h.fields
......
...@@ -6,12 +6,12 @@ ...@@ -6,12 +6,12 @@
-- | epsilon (smallest difference) -- | epsilon (smallest difference)
module Gargantext.Components.RangeSlider where module Gargantext.Components.RangeSlider where
import Prelude import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Int (fromNumber) import Data.Int (fromNumber)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (Nullable, null) import Data.Nullable (Nullable, null)
import Data.Traversable (traverse_) import Data.Traversable (traverse_)
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Document (document) import DOM.Simple.Document (document)
import DOM.Simple.Event as Event import DOM.Simple.Event as Event
...@@ -22,6 +22,9 @@ import Effect (Effect) ...@@ -22,6 +22,9 @@ import Effect (Effect)
import Math as M import Math as M
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Math (roundToMultiple) import Gargantext.Utils.Math (roundToMultiple)
import Gargantext.Utils.Range as Range import Gargantext.Utils.Range as Range
...@@ -51,6 +54,9 @@ rangeSlider :: Record Props -> R.Element ...@@ -51,6 +54,9 @@ rangeSlider :: Record Props -> R.Element
rangeSlider props = R.createElement rangeSliderCpt props [] rangeSlider props = R.createElement rangeSliderCpt props []
data Knob = MinKnob | MaxKnob data Knob = MinKnob | MaxKnob
derive instance genericKnob :: Generic Knob _
instance eqKnob :: Eq Knob where
eq = genericEq
data RangeUpdate = SetMin Number | SetMax Number data RangeUpdate = SetMin Number | SetMax Number
...@@ -70,10 +76,12 @@ rangeSliderCpt = here.component "rangeSlider" cpt ...@@ -70,10 +76,12 @@ rangeSliderCpt = here.component "rangeSlider" cpt
-- high knob -- high knob
highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the high knob highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the high knob
-- The value of the user's selection -- The value of the user's selection
value /\ setValue <- R.useState' $ initialValue props value <- T.useBox $ initialValue props
value' <- T.useLive T.unequal value
-- the knob we are currently in a drag for. set by mousedown on a knob -- the knob we are currently in a drag for. set by mousedown on a knob
dragKnob /\ setDragKnob <- R.useState' $ (Nothing :: Maybe Knob) dragKnob <- T.useBox (Nothing :: Maybe Knob)
dragKnob' <- T.useLive T.unequal dragKnob
-- the handler functions for trapping mouse events, so they can be removed -- the handler functions for trapping mouse events, so they can be removed
mouseMoveHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent))) mouseMoveHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
...@@ -84,24 +92,24 @@ rangeSliderCpt = here.component "rangeSlider" cpt ...@@ -84,24 +92,24 @@ rangeSliderCpt = here.component "rangeSlider" cpt
R.setRef mouseMoveHandler $ Nothing R.setRef mouseMoveHandler $ Nothing
R.setRef mouseUpHandler $ Nothing R.setRef mouseUpHandler $ Nothing
R2.useLayoutEffect1' dragKnob $ \_ -> do R2.useLayoutEffect1' dragKnob' $ \_ -> do
let scalePos = R2.readPositionRef scaleElem let scalePos = R2.readPositionRef scaleElem
let lowPos = R2.readPositionRef lowElem let lowPos = R2.readPositionRef lowElem
let highPos = R2.readPositionRef highElem let highPos = R2.readPositionRef highElem
case dragKnob of case dragKnob' of
Just knob -> do Just knob -> do
let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of
Just val -> do Just val -> do
setKnob knob setValue value val setKnob knob value value' val
props.onChange $ knobSetter knob value val props.onChange $ knobSetter knob value' val
Nothing -> destroy unit Nothing -> destroy unit
let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do
--props.onChange $ knobSetter knob value val --props.onChange $ knobSetter knob value val
setDragKnob $ const Nothing T.write_ Nothing dragKnob
destroy unit destroy unit
EL.addEventListener document "mousemove" onMouseMove EL.addEventListener document "mousemove" onMouseMove
EL.addEventListener document "mouseup" onMouseUp EL.addEventListener document "mouseup" onMouseUp
...@@ -109,10 +117,10 @@ rangeSliderCpt = here.component "rangeSlider" cpt ...@@ -109,10 +117,10 @@ rangeSliderCpt = here.component "rangeSlider" cpt
R.setRef mouseUpHandler $ Just onMouseUp R.setRef mouseUpHandler $ Just onMouseUp
Nothing -> destroy unit Nothing -> destroy unit
pure $ H.div { className, aria } pure $ H.div { className, aria }
[ renderScale scaleElem props value [ renderScale scaleElem props value'
, renderScaleSel scaleSelElem props value , renderScaleSel scaleSelElem props value'
, renderKnob MinKnob lowElem value props.bounds setDragKnob precision , renderKnob MinKnob lowElem value' props.bounds dragKnob precision
, renderKnob MaxKnob highElem value props.bounds setDragKnob precision , renderKnob MaxKnob highElem value' props.bounds dragKnob precision
] ]
className = "range-slider" className = "range-slider"
aria = { label: "Range Slider Control. Expresses filtering data by a minimum and maximum value range through two slider knobs. Knobs can be adjusted with the arrow keys." } aria = { label: "Range Slider Control. Expresses filtering data by a minimum and maximum value range through two slider knobs. Knobs can be adjusted with the arrow keys." }
...@@ -127,8 +135,8 @@ destroyEventHandler name ref = traverse_ destroy $ R.readRef ref ...@@ -127,8 +135,8 @@ destroyEventHandler name ref = traverse_ destroy $ R.readRef ref
EL.removeEventListener document name handler EL.removeEventListener document name handler
R.setRef ref Nothing R.setRef ref Nothing
setKnob :: Knob -> R.Setter Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit setKnob :: Knob -> T.Box Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit
setKnob knob setValue r val = setValue $ const $ knobSetter knob r val setKnob knob value r val = T.write_ (knobSetter knob r val) value
knobSetter :: Knob -> Range.NumberRange -> Number -> Range.NumberRange knobSetter :: Knob -> Range.NumberRange -> Number -> Range.NumberRange
knobSetter MinKnob = Range.withMin knobSetter MinKnob = Range.withMin
...@@ -165,7 +173,7 @@ renderScaleSel ref props (Range.Closed {min, max}) = ...@@ -165,7 +173,7 @@ renderScaleSel ref props (Range.Closed {min, max}) =
computeWidth = (show $ 100.0 * (percOffsetMax - percOffsetMin)) <> "%" computeWidth = (show $ 100.0 * (percOffsetMax - percOffsetMin)) <> "%"
renderKnob :: Knob -> R.Ref (Nullable DOM.Element) -> Range.NumberRange -> Bounds -> R.Setter (Maybe Knob) -> Int -> R.Element renderKnob :: Knob -> R.Ref (Nullable DOM.Element) -> Range.NumberRange -> Bounds -> T.Box (Maybe Knob) -> Int -> R.Element
renderKnob knob ref (Range.Closed value) bounds set precision = renderKnob knob ref (Range.Closed value) bounds set precision =
H.div { ref, tabIndex, className, aria, on: { mouseDown: onMouseDown }, style } [ H.div { ref, tabIndex, className, aria, on: { mouseDown: onMouseDown }, style } [
H.div { className: "button" } H.div { className: "button" }
...@@ -181,7 +189,7 @@ renderKnob knob ref (Range.Closed value) bounds set precision = ...@@ -181,7 +189,7 @@ renderKnob knob ref (Range.Closed value) bounds set precision =
aria = { label: labelPrefix knob <> "value: " <> show val } aria = { label: labelPrefix knob <> "value: " <> show val }
labelPrefix MinKnob = "Minimum " labelPrefix MinKnob = "Minimum "
labelPrefix MaxKnob = "Maximum " labelPrefix MaxKnob = "Maximum "
onMouseDown _ = set $ const $ Just knob onMouseDown _ = T.write_ (Just knob) set
percOffset = Range.normalise bounds val percOffset = Range.normalise bounds val
style = { left: (show $ 100.0 * percOffset) <> "%" } style = { left: (show $ 100.0 * percOffset) <> "%" }
val = case knob of val = case knob of
......
...@@ -42,7 +42,7 @@ import Gargantext.Utils.Reactix as R2 ...@@ -42,7 +42,7 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Router" here = R2.here "Gargantext.Components.Router"
type Props = ( boxes :: Boxes, tasks :: T.Box (Maybe GAT.Reductor) ) type Props = ( boxes :: Boxes, tasks :: GAT.Reductor )
type SessionProps = ( session :: R.Context Session, sessionId :: SessionId | Props ) type SessionProps = ( session :: R.Context Session, sessionId :: SessionId | Props )
......
...@@ -6,6 +6,7 @@ import Data.Tuple (Tuple) ...@@ -6,6 +6,7 @@ import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -24,21 +25,23 @@ tabs props = R.createElement tabsCpt props [] ...@@ -24,21 +25,23 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt where tabsCpt = here.component "tabs" cpt where
cpt props _ = do cpt props _ = do
(activeTab /\ setActiveTab) <- R.useState' props.selected activeTab <- T.useBox props.selected
activeTab' <- T.useLive T.unequal activeTab
pure $ H.div {} pure $ H.div {}
[ H.nav {} [ H.nav {}
[ H.br {} [ H.br {}
, H.div { className: "nav nav-tabs", title: "Search result" } , H.div { className: "nav nav-tabs", title: "Search result" }
(mapWithIndex (button setActiveTab activeTab) props.tabs) (mapWithIndex (button activeTab activeTab') props.tabs)
] ]
, H.div { className: "tab-content" } , H.div { className: "tab-content" }
(mapWithIndex (item activeTab) props.tabs) (mapWithIndex (item activeTab') props.tabs)
] ]
button setActiveTab selected index (name /\ _) = button activeTab selected index (name /\ _) =
H.a { className, on: { click } } [ H.text name ] where H.a { className, on: { click } } [ H.text name ] where
eq = index == selected eq = index == selected
className = "nav-item nav-link" <> (if eq then " active" else "") className = "nav-item nav-link" <> (if eq then " active" else "")
click e = setActiveTab (const index) click e = T.write_ index activeTab
item selected index (_ /\ cpt') = tab { selected, index } [ cpt' ] item selected index (_ /\ cpt') = tab { selected, index } [ cpt' ]
-- TODO: document what these are (selection, item indices) -- TODO: document what these are (selection, item indices)
......
module Gargantext.Components.Themes where module Gargantext.Components.Themes where
import Data.Array as A import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import FFI.Simple ((.=)) import FFI.Simple ((.=))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -18,8 +19,11 @@ here = R2.here "Gargantext.Components.Themes" ...@@ -18,8 +19,11 @@ here = R2.here "Gargantext.Components.Themes"
stylesheetElId :: String stylesheetElId :: String
stylesheetElId = "bootstrap-css" stylesheetElId = "bootstrap-css"
newtype Theme = Theme { name :: String newtype Theme = Theme { location :: String
, location :: String } , name :: String }
derive instance genericTheme :: Generic Theme _
instance genericEq :: Eq Theme where
eq = genericEq
themeName :: Theme -> String themeName :: Theme -> String
themeName (Theme { name }) = name themeName (Theme { name }) = name
...@@ -68,16 +72,17 @@ themeSwitcherCpt :: R.Component ThemeSwitcherProps ...@@ -68,16 +72,17 @@ themeSwitcherCpt :: R.Component ThemeSwitcherProps
themeSwitcherCpt = here.component "themeSwitcher" cpt themeSwitcherCpt = here.component "themeSwitcher" cpt
where where
cpt { theme, themes } _ = do cpt { theme, themes } _ = do
currentTheme <- R.useState' theme currentTheme <- T.useBox theme
currentTheme' <- T.useLive T.unequal currentTheme
let option (Theme { name }) = H.option { value: name } [ H.text name ] let option (Theme { name }) = H.option { value: name } [ H.text name ]
let options = map option themes let options = map option themes
pure $ R2.select { className: "form-control" pure $ R2.select { className: "form-control"
, defaultValue: themeName $ fst currentTheme , defaultValue: themeName currentTheme'
, on: { change: onChange currentTheme } } options , on: { change: onChange currentTheme } } options
where where
onChange (_ /\ setCurrentTheme) e = do onChange currentTheme e = do
let value = R.unsafeEventValue e let value = R.unsafeEventValue e
let mTheme = A.head $ A.filter (\(Theme { name }) -> value == name) themes let mTheme = A.head $ A.filter (\(Theme { name }) -> value == name) themes
...@@ -85,4 +90,4 @@ themeSwitcherCpt = here.component "themeSwitcher" cpt ...@@ -85,4 +90,4 @@ themeSwitcherCpt = here.component "themeSwitcher" cpt
Nothing -> pure unit Nothing -> pure unit
Just t -> do Just t -> do
switchTheme t switchTheme t
setCurrentTheme $ const t T.write_ t currentTheme
...@@ -7,6 +7,7 @@ import Effect.Class (liftEffect) ...@@ -7,6 +7,7 @@ import Effect.Class (liftEffect)
import Prelude import Prelude
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Config.REST as REST import Gargantext.Config.REST as REST
import Gargantext.Ends (toUrl) import Gargantext.Ends (toUrl)
...@@ -37,20 +38,21 @@ versionCpt :: R.Component VersionProps ...@@ -37,20 +38,21 @@ versionCpt :: R.Component VersionProps
versionCpt = here.component "version" cpt versionCpt = here.component "version" cpt
where where
cpt { session } _ = do cpt { session } _ = do
(versionBack /\ setVer) <- R.useState' "No Backend Version" versionBack <- T.useBox "No Backend Version"
versionBack' <- T.useLive T.unequal versionBack
R.useEffect' $ do R.useEffect' $ do
launchAff_ $ do launchAff_ $ do
v <- getBackendVersion session v <- getBackendVersion session
liftEffect $ setVer $ const v liftEffect $ T.write_ v versionBack
pure $ case version == versionBack of pure $ case version == versionBack' of
true -> H.a { className: "fa fa-check-circle-o" true -> H.a { className: "fa fa-check-circle-o"
, textDecoration: "none" , textDecoration: "none"
, title: "Versions match: frontend (" , title: "Versions match: frontend ("
<> version <> version
<> "), backend (" <> "), backend ("
<> versionBack <> versionBack'
<> ")" <> ")"
} [] } []
false -> H.a { className: "fa fa-exclamation-triangle" false -> H.a { className: "fa fa-exclamation-triangle"
...@@ -58,7 +60,7 @@ versionCpt = here.component "version" cpt ...@@ -58,7 +60,7 @@ versionCpt = here.component "version" cpt
, title: "Versions mismatch: frontend (" , title: "Versions mismatch: frontend ("
<> version <> version
<> "), backend (" <> "), backend ("
<> versionBack <> versionBack'
<> ")" <> ")"
} [] } []
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