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

[toestand] more fixes and refactorings, code still doesn't compile

parent fed2ce30
module Gargantext.AsyncTasks where
import Gargantext.Prelude
import DOM.Simple.Console (log2)
import Data.Argonaut (decodeJson)
import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Tuple (snd)
import DOM.Simple.Console (log2)
import Data.Tuple (fst, snd)
import Effect (Effect)
import Reactix as R
import Web.Storage.Storage as WSS
import Gargantext.Prelude
import Gargantext.Types as GT
import Gargantext.Utils as GU
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Toestand as T
import Web.Storage.Storage as WSS
localStorageKey :: String
localStorageKey = "garg-async-tasks"
......@@ -44,20 +45,25 @@ getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
getTasks :: Record ReductorProps -> GT.NodeID -> Array GT.AsyncTaskWithType
getTasks { storage } nodeId = fromMaybe [] $ Map.lookup nodeId storage
getTasksMaybe :: Maybe Reductor -> GT.NodeID -> Array GT.AsyncTaskWithType
getTasksMaybe mTasks nodeId = case mTasks of
Just tasks -> getTasks (fst tasks) nodeId
Nothing -> []
removeTaskFromList :: Array GT.AsyncTaskWithType -> GT.AsyncTaskWithType -> Array GT.AsyncTaskWithType
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = (
reloadRoot :: GUR.ReloadS
, reloadForest :: GUR.ReloadS
reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
, storage :: Storage
)
type Reductor = R2.Reductor (Record ReductorProps) Action
type ReductorAction = Action -> Effect Unit
useTasks :: GUR.ReloadS -> GUR.ReloadS -> R.Hooks Reductor
useTasks :: T.Cursor T2.Reload -> T.Cursor T2.Reload -> R.Hooks Reductor
useTasks reloadRoot reloadForest = R2.useReductor act initializer unit
where
act :: R2.Actor (Record ReductorProps) Action
......@@ -73,18 +79,18 @@ data Action =
action :: Record ReductorProps -> Action -> Effect (Record ReductorProps)
action p@{ reloadForest, storage } (Insert nodeId t) = do
_ <- GUR.bump reloadForest
_ <- GUR.bumpCursor reloadForest
let newStorage = Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) nodeId storage
pure $ p { storage = newStorage }
action p (Finish nodeId t) = do
action p (Remove nodeId t)
action p@{ reloadRoot, reloadForest, storage } (Remove nodeId t@(GT.AsyncTaskWithType { typ })) = do
_ <- if GT.asyncTaskTriggersAppReload typ then
GUR.bump reloadRoot
GUR.bumpCursor reloadRoot
else
pure unit
_ <- if GT.asyncTaskTriggersTreeReload typ then
GUR.bump reloadForest
GUR.bumpCursor reloadForest
else
pure unit
let newStorage = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) nodeId storage
......
......@@ -11,7 +11,6 @@
-- | 2. We will need a more ambitious search algorithm for skipgrams.
module Gargantext.Components.Annotation.AnnotatedField where
import Prelude
import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( Tuple )
import Data.Tuple.Nested ( (/\) )
......@@ -22,14 +21,17 @@ import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Gargantext.Prelude
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Components.Annotation.Utils ( termBootstrapClass, termClass )
import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.Annotation.Menu ( annotationMenu, MenuType(..) )
import Gargantext.Utils.Selection as Sel
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Annotation.AnnotatedField"
here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.AnnotatedField"
type Props =
( ngrams :: NgramsTable
......@@ -46,7 +48,7 @@ annotatedField :: Record Props -> R.Element
annotatedField p = R.createElement annotatedFieldComponent p []
annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField" cpt
annotatedFieldComponent = here.component "annotatedField" cpt
where
cpt {ngrams,setTermList,text: fieldText} _ = do
(_ /\ setRedrawMenu) <- R.useState' false
......
......@@ -16,8 +16,8 @@ import Gargantext.Components.Annotation.Utils (termBootstrapClass)
import Gargantext.Components.ContextMenu.ContextMenu as CM
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Annotation.Menu"
here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.Menu"
data MenuType = NewNgram | SetTermListItem
......@@ -43,7 +43,7 @@ annotationMenu {x, y, list, menuType, onClose, setList} =
]
annotationMenuCpt :: R.Component Props
annotationMenuCpt = R.hooksComponentWithModule thisModule "annotationMenu" cpt
annotationMenuCpt = here.component "annotationMenu" cpt
where
cpt props _ = pure $ R.fragment $ children props
children props = A.mapMaybe (addToList props) [ MapTerm, CandidateTerm, StopTerm ]
......
......@@ -9,14 +9,14 @@ import Gargantext.Sessions as Sessions
import Reactix as R
import Toestand as T
thisModule :: String
thisModule = "Gargantext.Components.App"
here :: R2.Here
here = R2.here "Gargantext.Components.App"
app :: R.Element
app = R.createElement appCpt {} []
appCpt :: R.Component ()
appCpt = R.hooksComponentWithModule thisModule "app" cpt where
appCpt = here.component "app" cpt where
cpt _ _ = do
cell <- T.useCell emptyApp -- global data
views <- T.useFieldViews cell -- read-only access for children
......
......@@ -13,7 +13,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
thisModule = "Gargantext.Components.AutoUpdate"
here = R2.here "Gargantext.Components.AutoUpdate"
data Action = Update
......@@ -49,7 +49,7 @@ autoUpdate :: Record PropsRow -> R.Element
autoUpdate props = R.createElement autoUpdateCpt props []
autoUpdateCpt :: R.Component PropsRow
autoUpdateCpt = R.hooksComponentWithModule thisModule "autoUpdate" cpt
autoUpdateCpt = here.component "autoUpdate" cpt
where
cpt { duration, effect } _ = do
intervalRef <- R.useRef Nothing
......
......@@ -39,8 +39,8 @@ import Gargantext.Sessions (Session, sessionId, get, delete, put)
import Gargantext.Types (NodeID, NodeType(..), OrderBy(..), TableResult, TabType, showTabType')
import Gargantext.Utils.CacheAPI as GUC
thisModule :: String
thisModule = "Gargantext.Components.Category"
here :: R2.Here
here = R2.here "Gargantext.Components.Category"
------------------------------------------------------------------------
type RatingProps =
......@@ -55,7 +55,7 @@ rating :: R2.Component RatingProps
rating = R.createElement ratingCpt
ratingCpt :: R.Component RatingProps
ratingCpt = R.hooksComponentWithModule thisModule "rating" cpt
ratingCpt = here.component "rating" cpt
where
cpt { score, nodeId, row: DocumentsView r, session, setLocalCategories } _ = do
pure $ H.div {className:"flex"} divs
......@@ -109,7 +109,7 @@ caroussel :: R2.Component CarousselProps
caroussel = R.createElement carousselCpt
carousselCpt :: R.Component CarousselProps
carousselCpt = R.hooksComponentWithModule thisModule "caroussel" cpt
carousselCpt = here.component "caroussel" cpt
where
cpt { category, nodeId, row: DocumentsView r, session, setLocalCategories } _ = do
pure $ H.div {className:"flex"} divs
......
......@@ -24,8 +24,8 @@ import Gargantext.Prelude
import Gargantext.Utils.HighlightJS as HLJS
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.CodeEditor"
here :: R2.Here
here = R2.here "Gargantext.Components.CodeEditor"
type Code = String
type Html = String
......@@ -108,7 +108,7 @@ codeEditor p = R.createElement codeEditorCpt p []
-- The overlay is to provide seamless syntax highlighting on top of the textarea.
-- I took the idea from: https://github.com/satya164/react-simple-code-editor
codeEditorCpt :: R.Component Props
codeEditorCpt = R.hooksComponentWithModule thisModule "codeEditor" cpt
codeEditorCpt = here.component "codeEditor" cpt
where
cpt {code, defaultCodeType, onChange} _ = do
controls <- initControls code defaultCodeType
......@@ -204,7 +204,7 @@ toolbar :: Record ToolbarProps -> R.Element
toolbar p = R.createElement toolbarCpt p []
toolbarCpt :: R.Component ToolbarProps
toolbarCpt = R.hooksComponentWithModule thisModule "toolbar" cpt
toolbarCpt = here.component "toolbar" cpt
where
cpt props@{controls: {codeType, error, viewType}} _ = do
pure $
......@@ -236,7 +236,7 @@ errorComponent :: Record ErrorComponentProps -> R.Element
errorComponent p = R.createElement errorComponentCpt p []
errorComponentCpt :: R.Component ErrorComponentProps
errorComponentCpt = R.hooksComponentWithModule thisModule "errorComponent" cpt
errorComponentCpt = here.component "errorComponent" cpt
where
cpt {error: (Nothing /\ _)} _ = pure $ H.div {} []
cpt {error: ((Just error) /\ _)} _ = do
......@@ -253,7 +253,7 @@ codeTypeSelector :: Record CodeTypeSelectorProps -> R.Element
codeTypeSelector p = R.createElement codeTypeSelectorCpt p []
codeTypeSelectorCpt :: R.Component CodeTypeSelectorProps
codeTypeSelectorCpt = R.hooksComponentWithModule thisModule "codeTypeSelector" cpt
codeTypeSelectorCpt = here.component "codeTypeSelector" cpt
where
cpt {codeType, onChange} _ = do
pure $ R2.select { className: "form-control"
......@@ -289,7 +289,7 @@ viewTypeSelector :: Record ViewTypeSelectorProps -> R.Element
viewTypeSelector p = R.createElement viewTypeSelectorCpt p []
viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
viewTypeSelectorCpt = R.hooksComponentWithModule thisModule "viewTypeSelector" cpt
viewTypeSelectorCpt = here.component "viewTypeSelector" cpt
where
cpt {state} _ =
pure $ H.div { className: "btn-group"
......
......@@ -21,8 +21,8 @@ import Reactix.DOM.HTML as HTML
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.ContextMenu.ContextMenu"
here :: R2.Here
here = R2.here "Gargantext.Components.ContextMenu.ContextMenu"
type Props t = (
x :: Number
......@@ -34,7 +34,7 @@ contextMenu :: forall t. R2.Component (Props t)
contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t)
contextMenuCpt = R.hooksComponentWithModule thisModule "contextMenu" cpt
contextMenuCpt = here.component "contextMenu" cpt
where
cpt menu@{ x, y, onClose } children = do
host <- R2.getPortalHost
......@@ -108,7 +108,7 @@ contextMenuItem :: Array R.Element -> R.Element
contextMenuItem = R.createElement contextMenuItemCpt {}
contextMenuItemCpt :: R.Component ()
contextMenuItemCpt = R.hooksComponentWithModule thisModule "contextMenuItem" cpt
contextMenuItemCpt = here.component "contextMenuItem" cpt
where
cpt _props children = pure $ HTML.li { className: "context-menu-item" } children
......
......@@ -45,8 +45,8 @@ import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2
thisModule :: String
thisModule = "Gargantext.Components.DocsTable"
here :: R2.Here
here = R2.here "Gargantext.Components.DocsTable"
------------------------------------------------------------------------
type TotalRecords = Int
......@@ -98,7 +98,7 @@ docViewLayout :: Record LayoutProps -> R.Element
docViewLayout props = R.createElement docViewLayoutCpt props []
docViewLayoutCpt :: R.Component LayoutProps
docViewLayoutCpt = R.hooksComponentWithModule thisModule "docViewLayout" cpt
docViewLayoutCpt = here.component "docViewLayout" cpt
where
cpt layout _children = do
query <- R.useState' ""
......@@ -115,7 +115,7 @@ docView :: R2.Component Props
docView = R.createElement docViewCpt
docViewCpt :: R.Component Props
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt where
docViewCpt = here.component "docView" cpt where
cpt { layout: { cacheState
, chart
, frontends
......@@ -153,7 +153,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt where
searchBar :: R.State Query -> R.Element
searchBar (query /\ setQuery) = R.createElement el {} []
where
el = R.hooksComponentWithModule thisModule "SearchBar" cpt
el = here.component "SearchBar" cpt
cpt {} _children = do
queryText <- R.useState' query
......@@ -240,7 +240,7 @@ pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where
pageLayoutCpt = here.component "pageLayout" cpt where
cpt props@{ cacheState
, frontends
, listId
......@@ -303,7 +303,7 @@ page :: R2.Component PageProps
page = R.createElement pageCpt
pageCpt :: R.Component PageProps
pageCpt = R.hooksComponentWithModule thisModule "pageCpt" cpt where
pageCpt = here.component "pageCpt" cpt where
cpt { documents, layout, params } _ = do
paramsS <- R.useState' params
pure $ pagePaint { documents, layout, params: paramsS } []
......@@ -318,7 +318,7 @@ pagePaint :: R2.Component PagePaintProps
pagePaint = R.createElement pagePaintCpt
pagePaintCpt :: R.Component PagePaintProps
pagePaintCpt = R.hooksComponentWithModule thisModule "pagePaintCpt" cpt
pagePaintCpt = here.component "pagePaintCpt" cpt
where
cpt { documents, layout, params } _ = do
localCategories <- R.useState' (mempty :: LocalUserScore)
......@@ -350,7 +350,7 @@ pagePaintRaw :: R2.Component PagePaintRawProps
pagePaintRaw = R.createElement pagePaintRawCpt
pagePaintRawCpt :: R.Component PagePaintRawProps
pagePaintRawCpt = R.hooksComponentWithModule thisModule "pagePaintRawCpt" cpt where
pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
cpt { documents
, layout: { frontends
, listId
......@@ -425,7 +425,7 @@ docChooser :: R2.Component DocChooser
docChooser = R.createElement docChooserCpt
docChooserCpt :: R.Component DocChooser
docChooserCpt = R.hooksComponentWithModule thisModule "docChooser" cpt
docChooserCpt = here.component "docChooser" cpt
where
cpt { mCorpusId: Nothing } _ = do
pure $ H.div {} []
......
......@@ -38,7 +38,7 @@ import Gargantext.Utils (toggleSet, zeroPad)
import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Utils.Reactix as R2
thisModule = "Gargantext.Components.FacetsTable"
here = R2.here "Gargantext.Components.FacetsTable"
------------------------------------------------------------------------
type Props =
......@@ -119,7 +119,7 @@ docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component Props
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
docViewCpt = here.component "docView" cpt
where
cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
deletions <- R.useState' initialDeletions
......@@ -173,7 +173,7 @@ docViewGraph :: Record Props -> R.Element
docViewGraph props = R.createElement docViewCpt props []
docViewGraphCpt :: R.Component Props
docViewGraphCpt = R.hooksComponentWithModule thisModule "docViewGraph" cpt
docViewGraphCpt = here.component "docViewGraph" cpt
where
cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
deletions <- R.useState' initialDeletions
......@@ -303,7 +303,7 @@ pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt
pageLayoutCpt = here.component "pageLayout" cpt
where
cpt {frontends, totalRecords, deletions, container, session, path} _ = do
useLoader (fst path) loadPage $ \rowsLoaded ->
......@@ -313,7 +313,7 @@ page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps
pageCpt = R.hooksComponentWithModule thisModule "page" cpt
pageCpt = here.component "page" cpt
where
cpt {frontends, totalRecords, container, deletions, rowsLoaded, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
pure $ T.table { syncResetButton : [ H.div {} [] ]
......
module Gargantext.Components.Footer where
import Gargantext.Prelude
import Gargantext.Sessions as Sessions
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
thisModule :: String
thisModule = "Gargantext.Components.Footer"
import Gargantext.Prelude
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Footer"
---------------------------------------------------------------------------
type FooterProps s = ( session :: s )
......@@ -16,6 +19,6 @@ footer :: forall cell c. T.Read cell c => Record (FooterProps cell) -> R.Element
footer props = R.createElement footerCpt props []
footerCpt :: forall cell c. T.Read cell c => R.Component (FooterProps cell)
footerCpt = R.hooksComponentWithModule thisModule "footer" cpt where
footerCpt = here.component "footer" cpt where
cpt { session } _ =
pure $ H.div { className: "container" } [ H.hr {}, H.footer {} [] ]
module Gargantext.Components.Forest
( forest, forestLayout, forestLayoutWithTopBar
, forestLayoutMain, forestLayoutRaw
( forest
, forestLayout
, forestLayoutWithTopBar
, forestLayoutMain
, forestLayoutRaw
, Common
, LayoutProps
) where
import Data.Array as A
......@@ -22,7 +27,6 @@ import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Types (Handed(..), reverseHanded, switchHanded)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2
here :: R2.Here
......@@ -30,70 +34,102 @@ here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree
type Common =
( tasks :: R.Ref (Maybe GAT.Reductor)
, route :: AppRoute
, frontends :: Frontends
( frontends :: Frontends
, handed :: T.Cursor Handed
, reloadRoot :: T.Cursor T2.Reload
, route :: AppRoute
, tasks :: T.Cursor (Maybe GAT.Reductor)
)
type LayoutProps =
( backend :: T.Cursor Backend
, sessions :: T.Cursor Session
, showLogin :: T.Cursor Boolean
, reloadForest :: T.Cursor T2.Reload
, sessions :: T.Cursor Sessions
, showLogin :: T.Cursor Boolean
| Common
)
type Props = ( forestOpen :: T.Cursor OpenNodes | LayoutProps )
type Props = (
forestOpen :: T.Cursor OpenNodes
| LayoutProps )
type TreeExtra =
( session :: Session, forestOpen :: T.Cursor OpenNodes )
type TreeExtra = (
forestOpen :: T.Cursor OpenNodes
, session :: Session
)
forest :: R2.Component Props
forest = R.createElement forestCpt
forestCpt :: R.Component Props
forestCpt = here.component "forest" cpt where
cpt props@{ reloadRoot, tasks, backend, route, frontends, handed
, sessions, showLogin, reloadForest } _ = do
cpt props@{ backend
, forestOpen
, frontends
, handed
, reloadForest
, reloadRoot
, route
, sessions
, showLogin
, tasks } _ = do
-- NOTE: this is a hack to reload the forest on demand
tasks' <- GAT.useTasks reloadRoot reloadForest
R.useEffect' $ do
_ <- T.write (Just tasks') tasks
pure unit
handed' <- T.useLive T.unequal handed
reloadForest' <- T.useLive T.unequal reloadForest
reloadRoot' <- T.useLive T.unequal reloadRoot
forestOpen' <- T.useLive T.unequal forestOpen
sessions' <- T.useLive T.unequal sessions
-- TODO If `reloadForest` is set, `reload` state should be updated
R.useEffect' $ do
R.setRef tasks $ Just tasks'
GUR.initializeI reloadForest reload
-- TODO fix tasks ref
-- R.useEffect' $ do
-- R.setRef tasks $ Just tasks'
-- GUR.initializeI reloadForest reload
R2.useCache
( frontends /\ route /\ sessions /\ handed' /\ fst forestOpen
/\ reloadForest /\ reloadRoot /\ (fst tasks).storage )
(cp handed') where
common = RX.pick props :: Record Common
cp handed' _ =
pure $ H.div { className: "forest" }
(A.cons (plus handed' showLogin backend) trees)
trees = tree <$> unSessions sessions
tree s@(Session {treeId}) =
treeLoader { reloadRoot, tasks, route, frontends, handed
, forestOpen, reload, root: treeId, session: s } []
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
( frontends /\ route /\ sessions' /\ handed' /\ forestOpen'
/\ reloadForest' /\ reloadRoot' /\ (fst tasks').storage )
(cp handed' sessions' tasks')
where
common = RX.pick props :: Record Common
cp handed' sessions' tasks' _ =
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}) =
treeLoader { forestOpen
, frontends
, handed: handed'
, reload: reloadForest
, reloadRoot
, root: treeId
, route
, session: s
, tasks } []
plus :: Handed -> T.Cursor Boolean -> T.Cursor Backend -> R.Element
plus handed showLogin backend = H.div { className: "row" }
H.button { title, className: buttonClass, on: { click } }
[ H.div { className: divClass } [ H.text " Log in/out " ] -- fa-lg
, H.div {} [ H.text " " ] ]
[ H.button { className: buttonClass
, on: { click }
, title }
[ H.div { className: divClass } [ H.text " Log in/out " ] -- fa-lg
, H.div {} [ H.text " " ] ]
]
--, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
--, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
-- TODO same as the one in the Login Modal (same CSS)
-- [ H.i { className: "material-icons md-36"} [] ]
where
click _ = (snd backend) (const Nothing) *> showLogin (const true)
click _ = do
-- _ <- T.modify (const Nothing) backend
_ <- T.write true showLogin
pure unit
title = "Add or remove connections to the server(s)."
divClass = "fa fa-universal-access"
buttonClass =
"btn btn-primary col-5 " <> switchHanded "ml-1 mr-auto" "mr-1 ml-auto"
"btn btn-primary col-5 " <> switchHanded "ml-1 mr-auto" "mr-1 ml-auto" handed
forestLayout :: R2.Component LayoutProps
......@@ -131,23 +167,45 @@ forestLayoutRaw props = R.createElement forestLayoutRawCpt props
forestLayoutRawCpt :: R.Component LayoutProps
forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where
cpt p@{ reloadRoot, tasks, backend, route, frontends
, sessions, showLogin, reloadForest } children = do
handed <- T.useLive T.unequal p.handed
cpt p@{ backend
, frontends
, reloadForest
, reloadRoot
, route
, sessions
, showLogin
, tasks } children = do
handed' <- T.useLive T.unequal p.handed
forestOpen <- T2.useCursed $ Set.empty
pure $ R2.row $ reverseHanded
[ H.div { className: "col-md-2", style: { paddingTop: "60px" } }
(A.cons (forest' handed) children) ] where
forest' handed =
forest
{ reloadRoot, tasks, backend, route, frontends
, handed, sessions, showLogin, reloadForest } []
[ H.div { className: "col-md-2"
, style: { paddingTop: "60px" } }
(A.cons (forest' p.handed forestOpen) children)
] handed'
where
forest' handed forestOpen =
forest { backend
, frontends
, forestOpen
, handed
, reloadForest
, reloadRoot
, route
, sessions
, showLogin
, tasks } []
mainPage :: R2.Component ()
mainPage = R.createElement mainPageCpt
mainPageCpt :: R.Memo ()
mainPageCpt = R.memo (here.component "mainPage" cpt) where
cpt _ children =
pure $ H.div { className: "col-md-10" }
[ H.div {id: "page-wrapper"}
[ H.div { className: "container-fluid" } children ]]
-- mainPageCpt :: R.Memo ()
-- mainPageCpt = R.memo (here.component "mainPage" cpt) where
mainPageCpt :: R.Component()
mainPageCpt = here.component "mainPage" cpt
where
cpt _ children = do
pure $ H.div { className: "col-md-10" }
[ H.div { id: "page-wrapper" }
[ H.div { className: "container-fluid" } children ]
]
module Gargantext.Components.Forest.Tree where
import Gargantext.Prelude
import DOM.Simple.Console (log, log2)
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Traversable (traverse_, traverse)
import Data.Tuple (snd)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
......@@ -15,23 +16,23 @@ import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Toestand as T
import Web.HTML.Event.EventTypes (offline)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (nodeSpan)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
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.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree
( FTree, LNode(..), NTree(..), fTreeID )
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute)
......@@ -48,7 +49,7 @@ here = R2.here "Gargantext.Components.Forest.Tree"
-- Shared by every component here + performAction + nodeSpan
type Universal =
( reloadRoot :: T.Cursor T2.Reload
, tasks :: GAT.Reductor )
, tasks :: T.Cursor (Maybe GAT.Reductor) )
-- Shared by every component here + nodeSpan
type Global =
......@@ -128,7 +129,7 @@ treeCpt = here.component "tree" cpt where
--- The properties tree shares in common with performAction
type PACommon =
( forestOpen :: T.Cursor OpenNodes
, reloadTree :: T.Cursor T2.Reload
, reloadTree :: T.Cursor T2.Reload
, session :: Session
, tree :: FTree
| Universal )
......@@ -173,13 +174,21 @@ performAction (DeleteNode nt) p@{ forestOpen
_ -> void $ deleteNode session nt id
_ <- liftEffect $ T.modify (Set.delete (mkNodeId session id)) forestOpen
performAction RefreshTree p
performAction (DoSearch task) p@{ tree: (NTree (LNode {id}) _) } = liftEffect $ do
(snd p.tasks) $ GAT.Insert id task
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
log2 "[performAction] DoSearch task:" task
performAction (UpdateNode params) p@{ tree: (NTree (LNode {id}) _) } = do
performAction (UpdateNode params) p@{ tasks
, tree: (NTree (LNode {id}) _) } = do
task <- updateRequest params p.session id
liftEffect $ do
(snd p.tasks) $ GAT.Insert id task
mT <- T.read tasks
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
log2 "[performAction] UpdateNode task:" task
performAction (RenameNode name) p@{ tree: (NTree (LNode {id}) _) } = do
void $ rename p.session id $ RenameValue { text: name }
...