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
This diff is collapsed.
......@@ -17,12 +17,13 @@ import Data.Maybe ( Maybe(..), maybe )
import Data.String.Common ( joinWith )
import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ( (/\) )
--import DOM.Simple.Console (log2)
-- import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Toestand as T
import Gargantext.Prelude
......@@ -53,15 +54,16 @@ annotatedField = R.createElement annotatedFieldComponent
annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = here.component "annotatedField" cpt
where
cpt {ngrams, setTermList, text: fieldText} _ = do
(_ /\ setRedrawMenu) <- R.useState' false
cpt { ngrams, setTermList, text: fieldText } _ = do
redrawMenu <- T.useBox false
redrawMenu' <- T.useLive T.unequal redrawMenu
menuRef <- R.useRef (Nothing :: Maybe AnnotationMenu)
let wrapperProps = { className: "annotated-field-wrapper" }
wrap (text /\ list) = { list
, onSelect: onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList }
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
, text }
pure $ HTML.div wrapperProps
......@@ -75,57 +77,69 @@ compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- 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
case s of
Just sel -> do
case Sel.selectionToString sel of
"" -> hideMenu { menuRef, setRedrawMenu }
"" -> hideMenu { menuRef, redrawMenu }
sel' -> do
showMenu { event
, getList: findNgramTermList ngrams
, menuRef
, menuType: NewNgram
, ngram: normNgram CTabTerms sel'
, setRedrawMenu
, redrawMenu
, setTermList }
Nothing -> hideMenu { menuRef, setRedrawMenu }
onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList } (Just (Tuple ngram list)) event =
Nothing -> hideMenu { menuRef, redrawMenu }
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngram list)) event = do
showMenu { event
, getList: const (Just list)
, menuRef
, menuType: SetTermListItem
, ngram
, setRedrawMenu
, redrawMenu
, 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
y = E.clientY event
-- n = normNgram CTabTerms text
list = getList ngram
redrawMenu = setRedrawMenu not
-- redrawMenu = T.modify not redrawMenu
setList t = do
setTermList ngram list t
hideMenu { menuRef, setRedrawMenu }
hideMenu { menuRef, redrawMenu }
E.preventDefault event
--range <- Sel.getRange sel 0
--log2 "[showMenu] selection range" $ Sel.rangeToTuple range
let menu = Just
{ x
, y
, list
{ list
, onClose: hideMenu { menuRef, redrawMenu }
, menuType
, onClose: hideMenu { menuRef, setRedrawMenu }
, setList
}
, x
, y }
R.setRef menuRef menu
redrawMenu
T.modify_ not redrawMenu
hideMenu { menuRef, setRedrawMenu } = do
let redrawMenu = setRedrawMenu not
hideMenu { menuRef, redrawMenu } = do
R.setRef menuRef Nothing
redrawMenu
T.modify_ not redrawMenu
type Run =
( list :: List (Tuple NgramsTerm TermList)
......
......@@ -25,12 +25,12 @@ appCpt = here.component "app" cpt where
cpt _ _ = do
box <- T.useBox emptyApp -- global data
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
void $ Sessions.load boxes.sessions
tasksReductor <- GAT.useTasks boxes.reloadRoot boxes.reloadForest
R.useEffectOnce' $ do
T.write (Just tasksReductor) tasks
tasks <- GAT.useTasks boxes.reloadRoot boxes.reloadForest
-- R.useEffectOnce' $ do
-- T.write (Just tasksReductor) tasks
R.useEffectOnce' $ do
R2.loadLocalStorageState R2.openNodesKey boxes.forestOpen
T.listen (R2.listenLocalStorageState R2.openNodesKey) boxes.forestOpen
......
......@@ -2,7 +2,6 @@
module Gargantext.Components.ContextMenu.ContextMenu where
-- (MenuProps, Action(..), separator) where
import Prelude hiding (div)
import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe )
import Data.Tuple.Nested ( (/\) )
......@@ -18,6 +17,9 @@ import Effect (Effect)
import FFI.Simple ((..))
import Reactix as R
import Reactix.DOM.HTML as HTML
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
......@@ -25,9 +27,9 @@ here :: R2.Here
here = R2.here "Gargantext.Components.ContextMenu.ContextMenu"
type Props t = (
x :: Number
onClose :: Effect Unit
, x :: Number
, y :: Number
, onClose :: Effect Unit
)
contextMenu :: forall t. R2.Component (Props t)
......@@ -39,10 +41,12 @@ contextMenuCpt = here.component "contextMenu" cpt
cpt menu@{ x, y, onClose } children = do
host <- R2.getPortalHost
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
traverse_
(\r -> setRect (\_ -> Just (Element.boundingRect r)))
(\r -> T.write_ (Just (Element.boundingRect r)) rect)
(toMaybe $ R.readRef root)
pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect onClose root)
......@@ -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
{ ref
, key: "context-menu"
......
......@@ -33,11 +33,12 @@ here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree
type Common =
( frontends :: Frontends
, handed :: T.Box Handed
, reloadRoot :: T.Box T2.Reload
, route :: T.Box AppRoute
, tasks :: T.Box (Maybe GAT.Reductor)
( frontends :: Frontends
, handed :: T.Box Handed
, reloadRoot :: T.Box T2.Reload
, route :: T.Box AppRoute
-- , tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
type Props =
......@@ -69,29 +70,32 @@ forestCpt = here.component "forest" cpt where
, sessions
, showLogin
, tasks } _ = do
tasks' <- GAT.useTasks reloadRoot reloadForest
R.useEffect' $ T.write_ (Just tasks') tasks
-- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor
-- tasks' <- GAT.useTasks reloadRoot reloadForest
-- R.useEffect' $ do
-- T.write_ (Just tasks') tasks
handed' <- T.useLive T.unequal handed
reloadForest' <- T.useLive T.unequal reloadForest
reloadRoot' <- T.useLive T.unequal reloadRoot
route' <- T.useLive T.unequal route
forestOpen' <- T.useLive T.unequal forestOpen
sessions' <- T.useLive T.unequal sessions
-- TODO If `reloadForest` is set, `reload` state should be updated
-- TODO fix tasks ref
-- R.useEffect' $ do
-- R.setRef tasks $ Just tasks'
R2.useCache
( frontends /\ route' /\ sessions' /\ handed' /\ forestOpen'
/\ reloadForest' /\ reloadRoot' /\ (fst tasks').storage )
(cp handed' sessions' tasks')
/\ reloadForest' /\ reloadRoot' /\ (fst tasks).storage )
(cp handed' sessions')
where
common = RX.pick props :: Record Common
cp handed' sessions' tasks' _ =
cp handed' sessions' _ =
pure $ H.div { className: "forest" }
(A.cons (plus handed' showLogin backend) (trees handed' sessions' tasks'))
trees handed' sessions' tasks' = (tree handed' tasks') <$> unSessions sessions'
tree handed' tasks' s@(Session {treeId}) =
(A.cons (plus handed' showLogin backend) (trees handed' sessions'))
trees handed' sessions' = (tree handed') <$> unSessions sessions'
tree handed' s@(Session {treeId}) =
treeLoader { forestOpen
, frontends
, handed: handed'
......@@ -193,7 +197,7 @@ mainPage = R.createElement mainPageCpt
-- mainPageCpt :: R.Memo ()
-- mainPageCpt = R.memo (here.component "mainPage" cpt) where
mainPageCpt :: R.Component()
mainPageCpt :: R.Component ()
mainPageCpt = here.component "mainPage" cpt
where
cpt _ children = do
......
......@@ -48,7 +48,8 @@ here = R2.here "Gargantext.Components.Forest.Tree"
-- Shared by every component here + performAction + nodeSpan
type Universal =
( 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
type Global =
......@@ -178,19 +179,13 @@ performAction (DeleteNode nt) p@{ forestOpen
performAction RefreshTree p
performAction (DoSearch task) p@{ tasks
, tree: (NTree (LNode {id}) _) } = liftEffect $ do
mT <- T.read tasks
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
snd tasks $ GAT.Insert id task
log2 "[performAction] DoSearch task:" task
performAction (UpdateNode params) p@{ tasks
, tree: (NTree (LNode {id}) _) } = do
task <- updateRequest params p.session id
liftEffect $ do
mT <- T.read tasks
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
snd tasks $ GAT.Insert id task
log2 "[performAction] UpdateNode task:" task
performAction (RenameNode name) p@{ tree: (NTree (LNode {id}) _) } = do
void $ rename p.session id $ RenameValue { text: name }
......@@ -213,19 +208,13 @@ performAction (UploadFile nodeType fileType mName blob) p@{ tasks
, tree: (NTree (LNode { id }) _) } = do
task <- uploadFile p.session nodeType id fileType {mName, blob}
liftEffect $ do
mT <- T.read tasks
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
snd tasks $ GAT.Insert id task
log2 "[performAction] UploadFile, uploaded, task:" task
performAction (UploadArbitraryFile mName blob) p@{ tasks
, tree: (NTree (LNode { id }) _) } = do
task <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do
mT <- T.read tasks
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
snd tasks $ GAT.Insert id task
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
performAction DownloadNode _ = liftEffect $ log "[performAction] DownloadNode"
performAction (MoveNode {params}) p@{ forestOpen
......
......@@ -5,7 +5,7 @@ import Gargantext.Prelude
import Data.Maybe (Maybe(..))
import Data.Nullable (null)
import Data.Symbol (SProxy(..))
import Data.Tuple (snd)
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
......@@ -54,7 +54,7 @@ type NodeMainSpanProps =
, reloadRoot :: T.Box T2.Reload
, route :: T.Box Routes.AppRoute
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
| CommonProps
)
......@@ -91,16 +91,19 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
} _ = do
route' <- T.useLive T.unequal route
-- only 1 popup at a time is allowed to be opened
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
droppedFile <- T.useBox (Nothing :: Maybe DroppedFile)
droppedFile' <- T.useLive T.unequal droppedFile
isDragOver <- T.useBox false
isDragOver' <- T.useLive T.unequal isDragOver
popoverRef <- R.useRef null
R.useEffect' $ do
R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef
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
[ folderIcon { folderOpen, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf, nodeType } []
......@@ -114,7 +117,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
, onFinish: onTaskFinish id t
, session
}
) $ GAT.getTasksMaybe tasks' id
) $ GAT.getTasks (fst tasks) id
)
, if nodeType == GT.NodeUser
then GV.versionView {session}
......@@ -139,10 +142,11 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
]
where
onTaskFinish id' t _ = do
mT <- T.read tasks
case mT of
Just t' -> snd t' $ GAT.Finish id' t
Nothing -> pure unit
snd tasks $ GAT.Finish id' t
-- mT <- T.read tasks
-- case mT of
-- Just t' -> snd t' $ GAT.Finish id' t
-- Nothing -> pure unit
T2.reload reloadRoot
SettingsBox {show: showBox} = settingsBox nodeType
......@@ -158,37 +162,37 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
H.a { className: "settings fa fa-cog"
, title : "Each node of the Tree can perform some actions.\n"
<> "Click here to execute one of them." } []
dropProps droppedFile isDragOver =
{ className: "leaf " <> (dropClass droppedFile isDragOver)
dropProps droppedFile droppedFile' isDragOver isDragOver' =
{ className: "leaf " <> (dropClass droppedFile' isDragOver')
, on: { drop: dropHandler droppedFile
, dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver }
}
where
dropClass (Just _ /\ _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped"
dropClass (Nothing /\ _) _ = ""
dropHandler (_ /\ setDroppedFile) e = do
dropClass (Just _) _ = "file-dropped"
dropClass _ true = "file-dropped"
dropClass Nothing _ = ""
dropHandler droppedFile e = do
-- prevent redirection when file is dropped
E.preventDefault e
E.stopPropagation e
blob <- R2.dataTransferFileBlob e
void $ launchAff do
--contents <- readAsText blob
liftEffect $ setDroppedFile
$ const
$ Just
$ DroppedFile { blob: (UploadFileBlob blob)
, fileType: Just CSV
, lang : EN
}
onDragOverHandler (_ /\ setIsDragOver) e = do
liftEffect $ T.write_
(Just
$ DroppedFile { blob: (UploadFileBlob blob)
, fileType: Just CSV
, lang : EN
}) droppedFile
onDragOverHandler isDragOver e = do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver $ const true
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
T.write_ true isDragOver
onDragLeave isDragOver _ = T.write_ false isDragOver
type FolderIconProps = (
folderOpen :: T.Box Boolean
......
module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Data.Either (fromRight)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype)
import Data.String.Regex as DSR
......@@ -15,6 +17,7 @@ import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import URI.Extra.QueryPairs as QP
-- import Web.File.Blob (Blob)
import Web.File.FileReader.Aff (readAsDataURL, readAsText)
......@@ -55,16 +58,19 @@ actionUpload _ _ _ _ =
-- file upload types
data DroppedFile =
DroppedFile { blob :: UploadFileBlob
DroppedFile { blob :: UploadFileBlob
, fileType :: Maybe FileType
, lang :: Lang
}
derive instance genericDroppedFile :: Generic DroppedFile _
instance eqDroppedFile :: Eq DroppedFile where
eq = genericEq
type FileHash = String
type UploadFile =
{ blob :: UploadFileBlob
{ blob :: UploadFileBlob
, name :: String
}
......@@ -192,9 +198,9 @@ uploadButtonCpt = here.component "uploadButton" cpt
-- START File Type View
type FileTypeProps =
( dispatch :: Action -> Aff Unit
, droppedFile :: R.State (Maybe DroppedFile)
, droppedFile :: T.Box (Maybe DroppedFile)
, id :: ID
, isDragOver :: R.State Boolean
, isDragOver :: T.Box Boolean
, nodeType :: GT.NodeType
)
......@@ -205,16 +211,21 @@ fileTypeViewCpt :: R.Component FileTypeProps
fileTypeViewCpt = here.component "fileTypeView" cpt
where
cpt { dispatch
, droppedFile: Just (DroppedFile {blob, fileType}) /\ setDroppedFile
, isDragOver: (_ /\ setIsDragOver)
, droppedFile
, isDragOver
, nodeType
} _ = pure
$ H.div tooltipProps [ H.div { className: "card"}
[ panelHeading
, panelBody
, panelFooter
]
]
} _ = do
droppedFile' <- T.useLive T.unequal droppedFile
case droppedFile' of
Nothing -> pure $ H.div {} []
Just df@(DroppedFile { blob, fileType }) ->
pure $ H.div tooltipProps [ H.div { className: "card"}
[ panelHeading
, panelBody df
, panelFooter df
]
]
where
tooltipProps = { className: ""
, id : "file-type-tooltip"
......@@ -231,30 +242,30 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
, H.div {className: "col-md-2"}
[ H.a {className: "btn glyphitem fa fa-remove-circle"
, on: {click: \_ -> do
setDroppedFile $ const Nothing
setIsDragOver $ const false
T.write_ Nothing droppedFile
T.write_ false isDragOver
}
, title: "Close"} []
]
]
]
panelBody =
panelBody (DroppedFile { blob }) =
H.div {className: "card-body"}
[ R2.select {className: "col-md-12 form-control"
, on: {change: onChange}
, on: {change: onChange blob}
}
(map renderOption [CSV, CSV_HAL, WOS])
]
where
onChange e l =
setDroppedFile $ const $ Just $ DroppedFile $ { blob
, fileType: read $ R.unsafeEventValue e
, lang : fromMaybe EN $ read $ R.unsafeEventValue l
}
onChange blob e l =
T.write_ (Just $ DroppedFile $ { blob
, fileType: read $ R.unsafeEventValue e
, lang : fromMaybe EN $ read $ R.unsafeEventValue l
}) droppedFile
renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter =
panelFooter (DroppedFile { blob, fileType }) =
H.div {className: "card-footer"}
[
case fileType of
......@@ -262,7 +273,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
H.button {className: "btn btn-success"
, type: "button"
, on: {click: \_ -> do
setDroppedFile $ const Nothing
T.write_ Nothing droppedFile
launchAff $ dispatch $ UploadFile nodeType ft Nothing blob
}
} [H.text "Upload"]
......@@ -272,9 +283,6 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
} [H.text "Upload"]
]
cpt {droppedFile: (Nothing /\ _)} _ = do
pure $ H.div {} []
newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
......
......@@ -4,9 +4,9 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
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
......@@ -27,3 +27,6 @@ instance readFileType :: Read FileType where
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
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -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.Rename (renameAction)
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.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Update (update)
......@@ -51,7 +49,7 @@ nodePopupCpt = here.component "nodePopupView" cpt where
nodePopup <- T.useBox { action: Nothing, id, name, nodeType }
action <- T.useFocused (_.action) (\a b -> b { action = a }) nodePopup
nodePopup' <- T.useLive T.unequal nodePopup
search <- R.useState' $ defaultSearch { node_id = Just p.id }
pure $ H.div tooltipProps
[ H.div { className: "popup-container" }
[ H.div { className: "card" }
......
......@@ -53,7 +53,7 @@ type BaseProps =
, route :: T.Box AppRoute
, sessions :: T.Box Sessions
, showLogin :: T.Box Boolean
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
type LayoutLoaderProps = ( session :: R.Context Session | BaseProps )
......@@ -277,7 +277,7 @@ type TreeProps = (
, sessions :: T.Box Sessions
, show :: Boolean
, showLogin :: T.Box Boolean
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
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 = (
, reloadRoot :: T.Box T2.Reload
, sidePanelTriggers :: Record NT.SidePanelTriggers
, tabNgramType :: CTabNgramType
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
, withAutoUpdate :: Boolean
)
......
......@@ -1184,7 +1184,7 @@ chartsAfterSync :: forall props discard.
, tabType :: TabType
| props
}
-> T.Box (Maybe GAT.Reductor)
-> GAT.Reductor
-> T.Box T2.Reload
-> discard
-> Aff Unit
......@@ -1192,12 +1192,8 @@ chartsAfterSync path'@{ nodeId } tasks reloadForest _ = do
task <- postNgramsChartsAsync path'
liftEffect $ do
log2 "[chartsAfterSync] Synchronize task" task
mT <- T.read tasks
case mT of
Nothing -> log "[chartsAfterSync] tasks is Nothing"
Just tasks' -> do
snd tasks' (GAT.Insert nodeId task) -- *> T2.reload reloadForest
T2.reload reloadForest
snd tasks $ GAT.Insert nodeId task
T2.reload reloadForest
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
......
......@@ -59,7 +59,7 @@ type TabsProps =
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
tabs :: R2.Leaf TabsProps
......@@ -136,5 +136,5 @@ type NTCommon =
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
......@@ -155,7 +155,7 @@ type LayoutNoSessionProps =
, nodeId :: Int
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
type LayoutProps = WithSession LayoutNoSessionProps
......
......@@ -141,7 +141,7 @@ listElement = H.li { className: "list-group-item justify-content-between" }
type BasicProps =
( frontends :: Frontends
, nodeId :: Int
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
type ReloadProps =
......
......@@ -57,7 +57,7 @@ type TabsProps = (
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
tabs :: Record TabsProps -> R.Element
......@@ -139,7 +139,7 @@ type NgramsViewTabsProps = (
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
ngramsView :: R2.Component NgramsViewTabsProps
......
......@@ -98,7 +98,7 @@ type CommonPropsNoSession =
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, sessionUpdate :: Session -> Effect Unit
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
type CommonProps = WithSession CommonPropsNoSession
......
......@@ -41,7 +41,7 @@ type Props = (
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
)
type PropsWithKey = ( key :: String | Props )
......
......@@ -18,7 +18,7 @@ import Toestand as T
import Gargantext.Components.DocsTable as DT
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.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
......@@ -148,7 +148,7 @@ textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt
R.useEffectOnce' $ do
T.listen (\{ new } -> afterCacheStateChange new) cacheState
pure $ loader { nodeId, session } loadCorpusWithChild $
useLoader { nodeId, session } loadCorpusWithChild $
\corpusData@{ corpusId, corpusNode, defaultListId } -> do
let NodePoly { date, hyperdata: Hyperdata h, name } = corpusNode
CorpusInfo { authors, desc, query } = getCorpusInfo h.fields
......
......@@ -6,12 +6,12 @@
-- | epsilon (smallest difference)
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.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (Nullable, null)
import Data.Traversable (traverse_)
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM
import DOM.Simple.Document (document)
import DOM.Simple.Event as Event
......@@ -22,6 +22,9 @@ import Effect (Effect)
import Math as M
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Math (roundToMultiple)
import Gargantext.Utils.Range as Range
......@@ -51,6 +54,9 @@ rangeSlider :: Record Props -> R.Element
rangeSlider props = R.createElement rangeSliderCpt props []
data Knob = MinKnob | MaxKnob
derive instance genericKnob :: Generic Knob _
instance eqKnob :: Eq Knob where
eq = genericEq
data RangeUpdate = SetMin Number | SetMax Number
......@@ -70,10 +76,12 @@ rangeSliderCpt = here.component "rangeSlider" cpt
-- 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
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
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
mouseMoveHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
......@@ -84,24 +92,24 @@ rangeSliderCpt = here.component "rangeSlider" cpt
R.setRef mouseMoveHandler $ Nothing
R.setRef mouseUpHandler $ Nothing
R2.useLayoutEffect1' dragKnob $ \_ -> do
R2.useLayoutEffect1' dragKnob' $ \_ -> do
let scalePos = R2.readPositionRef scaleElem
let lowPos = R2.readPositionRef lowElem
let highPos = R2.readPositionRef highElem
case dragKnob of
case dragKnob' of
Just knob -> do
let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of
Just val -> do
setKnob knob setValue value val
props.onChange $ knobSetter knob value val
setKnob knob value value' val
props.onChange $ knobSetter knob value' val
Nothing -> destroy unit
let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do
--props.onChange $ knobSetter knob value val
setDragKnob $ const Nothing
T.write_ Nothing dragKnob
destroy unit
EL.addEventListener document "mousemove" onMouseMove
EL.addEventListener document "mouseup" onMouseUp
......@@ -109,10 +117,10 @@ rangeSliderCpt = here.component "rangeSlider" cpt
R.setRef mouseUpHandler $ Just onMouseUp
Nothing -> destroy unit
pure $ H.div { className, aria }
[ renderScale scaleElem props value
, renderScaleSel scaleSelElem props value
, renderKnob MinKnob lowElem value props.bounds setDragKnob precision
, renderKnob MaxKnob highElem value props.bounds setDragKnob precision
[ renderScale scaleElem props value'
, renderScaleSel scaleSelElem props value'
, renderKnob MinKnob lowElem value' props.bounds dragKnob precision
, renderKnob MaxKnob highElem value' props.bounds dragKnob precision
]
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." }
......@@ -127,8 +135,8 @@ destroyEventHandler name ref = traverse_ destroy $ R.readRef ref
EL.removeEventListener document name handler
R.setRef ref Nothing
setKnob :: Knob -> R.Setter Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit
setKnob knob setValue r val = setValue $ const $ knobSetter knob r val
setKnob :: Knob -> T.Box Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit
setKnob knob value r val = T.write_ (knobSetter knob r val) value
knobSetter :: Knob -> Range.NumberRange -> Number -> Range.NumberRange
knobSetter MinKnob = Range.withMin
......@@ -165,7 +173,7 @@ renderScaleSel ref props (Range.Closed {min, max}) =
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 =
H.div { ref, tabIndex, className, aria, on: { mouseDown: onMouseDown }, style } [
H.div { className: "button" }
......@@ -181,7 +189,7 @@ renderKnob knob ref (Range.Closed value) bounds set precision =
aria = { label: labelPrefix knob <> "value: " <> show val }
labelPrefix MinKnob = "Minimum "
labelPrefix MaxKnob = "Maximum "
onMouseDown _ = set $ const $ Just knob
onMouseDown _ = T.write_ (Just knob) set
percOffset = Range.normalise bounds val
style = { left: (show $ 100.0 * percOffset) <> "%" }
val = case knob of
......
......@@ -42,7 +42,7 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here
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 )
......
......@@ -6,6 +6,7 @@ import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Utils.Reactix as R2
......@@ -24,21 +25,23 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt where
cpt props _ = do
(activeTab /\ setActiveTab) <- R.useState' props.selected
activeTab <- T.useBox props.selected
activeTab' <- T.useLive T.unequal activeTab
pure $ H.div {}
[ H.nav {}
[ H.br {}
, 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" }
(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
eq = index == selected
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' ]
-- TODO: document what these are (selection, item indices)
......
module Gargantext.Components.Themes where
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..))
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import FFI.Simple ((.=))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
......@@ -18,8 +19,11 @@ here = R2.here "Gargantext.Components.Themes"
stylesheetElId :: String
stylesheetElId = "bootstrap-css"
newtype Theme = Theme { name :: String
, location :: String }
newtype Theme = Theme { location :: String
, name :: String }
derive instance genericTheme :: Generic Theme _
instance genericEq :: Eq Theme where
eq = genericEq
themeName :: Theme -> String
themeName (Theme { name }) = name
......@@ -68,16 +72,17 @@ themeSwitcherCpt :: R.Component ThemeSwitcherProps
themeSwitcherCpt = here.component "themeSwitcher" cpt
where
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 options = map option themes
pure $ R2.select { className: "form-control"
, defaultValue: themeName $ fst currentTheme
, defaultValue: themeName currentTheme'
, on: { change: onChange currentTheme } } options
where
onChange (_ /\ setCurrentTheme) e = do
onChange currentTheme e = do
let value = R.unsafeEventValue e
let mTheme = A.head $ A.filter (\(Theme { name }) -> value == name) themes
......@@ -85,4 +90,4 @@ themeSwitcherCpt = here.component "themeSwitcher" cpt
Nothing -> pure unit
Just t -> do
switchTheme t
setCurrentTheme $ const t
T.write_ t currentTheme
......@@ -7,6 +7,7 @@ import Effect.Class (liftEffect)
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Config.REST as REST
import Gargantext.Ends (toUrl)
......@@ -37,20 +38,21 @@ versionCpt :: R.Component VersionProps
versionCpt = here.component "version" cpt
where
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
launchAff_ $ do
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"
, textDecoration: "none"
, title: "Versions match: frontend ("
<> version
<> "), backend ("
<> versionBack
<> versionBack'
<> ")"
} []
false -> H.a { className: "fa fa-exclamation-triangle"
......@@ -58,7 +60,7 @@ versionCpt = here.component "version" cpt
, title: "Versions mismatch: frontend ("
<> version
<> "), 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