Commit c10a6d14 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[boxes] refactoring of boxes

parent 4da3ef16
Pipeline #1716 canceled with stage
......@@ -15,7 +15,7 @@ import Gargantext.Routes (AppRoute(Home))
import Gargantext.Sessions (Session, Sessions)
import Gargantext.Sessions as Sessions
import Gargantext.Sessions.Types (OpenNodes(..))
import Gargantext.Types (FrontendError(..), Handed(RightHanded), SidePanelState(..))
import Gargantext.Types (FrontendError, Handed(RightHanded), SidePanelState(..))
import Gargantext.Utils.Toestand as T2
type App =
......
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where
import Gargantext.Prelude
import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Data.Array as A
......@@ -21,6 +23,7 @@ import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData)
......@@ -31,7 +34,6 @@ import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get, delete)
......@@ -60,15 +62,14 @@ type Path a =
)
type CommonProps =
( cacheState :: T.Box NT.CacheState
, errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, cacheState :: T.Box NT.CacheState
, frontends :: Frontends
, listId :: Int
, mCorpusId :: Maybe Int
, nodeId :: Int
, session :: Session
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tabType :: TabType
-- ^ tabType is not ideal here since it is too much entangled with tabs and
-- ngramtable. Let's see how this evolves. )
......@@ -77,16 +78,14 @@ type CommonProps =
)
type LayoutProps =
(
chart :: R.Element
( chart :: R.Element
, showSearch :: Boolean
| CommonProps
-- , path :: Record (Path a)
)
type PageLayoutProps =
(
key :: String -- NOTE Necessary to clear the component when cache state changes
( key :: String -- NOTE Necessary to clear the component when cache state changes
, params :: TT.Params
, query :: Query
| CommonProps
......@@ -115,9 +114,9 @@ docView :: R2.Component Props
docView = R.createElement docViewCpt
docViewCpt :: R.Component Props
docViewCpt = here.component "docView" cpt where
cpt { layout: { cacheState
cpt { layout: { boxes
, cacheState
, chart
, errors
, frontends
, listId
, mCorpusId
......@@ -125,7 +124,6 @@ docViewCpt = here.component "docView" cpt where
, session
, showSearch
, sidePanel
, sidePanelState
, tabType
, totalRecords
, yearFilter
......@@ -141,8 +139,8 @@ docViewCpt = here.component "docView" cpt where
[ chart
, if showSearch then searchBar { query } [] else H.div {} []
, H.div {className: "col-md-12"}
[ pageLayout { cacheState
, errors
[ pageLayout { boxes
, cacheState
, frontends
, key: "docView-" <> (show cacheState')
, listId
......@@ -152,7 +150,6 @@ docViewCpt = here.component "docView" cpt where
, query: query'
, session
, sidePanel
, sidePanelState
, tabType
, totalRecords
, yearFilter
......@@ -262,9 +259,8 @@ pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt where
cpt props@{ cacheState
, errors
, frontends
cpt props@{ boxes
, cacheState
, listId
, mCorpusId
, nodeId
......@@ -298,16 +294,16 @@ pageLayoutCpt = here.component "pageLayout" cpt where
case cacheState' of
NT.CacheOn -> do
let paint (Tuple count docs) = page { documents: docs
, errors
let paint (Tuple count docs) = page { boxes
, documents: docs
, layout: props { totalRecords = count }
, params } []
mkRequest :: PageParams -> GUC.Request
mkRequest p = GUC.makeGetRequest session $ tableRoute p
useLoaderWithCacheAPI {
cacheEndpoint: getPageHash session
, errors
useLoaderWithCacheAPI
{ boxes
, cacheEndpoint: getPageHash session
, handleResponse
, mkRequest
, path
......@@ -335,9 +331,9 @@ pageLayoutCpt = here.component "pageLayout" cpt where
, loader
, render }
type PageProps = (
documents :: Array DocumentsView
, errors :: T.Box (Array FrontendError)
type PageProps =
( boxes :: Boxes
, documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, params :: TT.Params
)
......@@ -383,8 +379,8 @@ pagePaintCpt = here.component "pagePaintCpt" cpt
filteredRows params' = TT.filterRows { params: params' } $ (orderWith params') $ A.toUnfoldable documents
type PagePaintRawProps = (
documents :: Array DocumentsView
type PagePaintRawProps =
( documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, localCategories :: T.Box LocalUserScore
, params :: T.Box TT.Params
......@@ -392,21 +388,19 @@ type PagePaintRawProps = (
pagePaintRaw :: R2.Component PagePaintRawProps
pagePaintRaw = R.createElement pagePaintRawCpt
pagePaintRawCpt :: R.Component PagePaintRawProps
pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
cpt { documents
, layout: { frontends
, layout: { boxes
, frontends
, listId
, mCorpusId
, nodeId
, session
, sidePanel
, sidePanelState
, totalRecords }
, localCategories
, params } _ = do
reload <- T.useBox T2.newReload
mCurrentDocId <- T.useFocused
(maybe Nothing _.mCurrentDocId)
(\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
......@@ -416,17 +410,15 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
pure $ TT.table
{ colNames
, container: TT.defaultContainer { title: "Documents" }
, container: TT.defaultContainer
, params
, rows: rows reload localCategories' mCurrentDocId'
, rows: rows localCategories' mCurrentDocId'
, syncResetButton : [ H.div {} [] ]
, totalRecords
, wrapColElts
}
where
sid = sessionId session
gi Star_1 = "fa fa-star"
gi _ = "fa fa-star-empty"
trashClassName Star_0 _ = "trash"
trashClassName _ true = "active"
trashClassName _ false = ""
......@@ -435,18 +427,17 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
| otherwise = Routes.Document sid listId
colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
wrapColElts = const identity
rows reload localCategories' mCurrentDocId' = row <$> A.toUnfoldable documents
rows localCategories' mCurrentDocId' = row <$> A.toUnfoldable documents
where
row dv@(DocumentsView r@{ _id, category }) =
{ row:
TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
H.div { className: "" }
[ docChooser { listId
[ docChooser { boxes
, listId
, mCorpusId
, nodeId: r._id
, sidePanel
, sidePanelState
, tableReload: reload } []
, sidePanel } []
]
--, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
, H.div { className: "column-tag flex" }
......@@ -471,32 +462,28 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
-- checked = Star_1 == cat
selected = mCurrentDocId' == Just r._id
tClassName = trashClassName cat selected
className = gi cat
type DocChooser = (
listId :: ListId
boxes :: Boxes
, listId :: ListId
, mCorpusId :: Maybe NodeID
, nodeId :: NodeID
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tableReload :: T2.ReloadS
)
docChooser :: R2.Component DocChooser
docChooser = R.createElement docChooserCpt
docChooserCpt :: R.Component DocChooser
docChooserCpt = here.component "docChooser" cpt
where
cpt { mCorpusId: Nothing } _ = do
pure $ H.div {} []
cpt { listId
cpt { boxes: { sidePanelState }
, listId
, mCorpusId: Just corpusId
, nodeId
, sidePanel
, sidePanelState
, tableReload } _ = do
, sidePanel } _ = do
mCurrentDocId <- T.useFocused
(maybe Nothing _.mCurrentDocId)
(\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
......
module Gargantext.Components.FolderView where
import Control.Monad.Error.Class (throwError)
import Data.Array as A
import Data.Either (Either(..))
import Data.Either (Either)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (null)
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Aff (Aff, error)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
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
......@@ -30,7 +30,7 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Ordering, Unit, bind, compare, discard, pure, unit, void, ($), (<$>), (<>))
import Gargantext.Routes (AppRoute(Home), SessionRoute(..), appPath, nodeTypeAppRoute)
import Gargantext.Sessions (Session, get, sessionId)
import Gargantext.Types (FrontendError, NodeType(..))
import Gargantext.Types (NodeType(..))
import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
......@@ -48,11 +48,9 @@ here = R2.here "Gargantext.Components.FolderView"
type Props =
( backFolder :: Boolean
, errors :: T.Box (Array FrontendError)
, boxes :: Boxes
, nodeId :: Int
, reloadForest :: T.Box T2.Reload
, session :: Session
, tasks :: T.Box GAT.Storage
)
data FolderStyle = FolderUp | FolderChild
......@@ -61,7 +59,7 @@ folderView :: R2.Leaf Props
folderView props = R.createElement folderViewCpt props []
folderViewCpt :: R.Component Props
folderViewCpt = here.component "folderViewCpt" cpt where
cpt { errors, nodeId, session, backFolder, tasks, reloadForest } _ = do
cpt { backFolder, boxes, nodeId, session } _ = do
setPopoverRef <- R.useRef Nothing
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
......@@ -69,27 +67,23 @@ folderViewCpt = here.component "folderViewCpt" cpt where
, loader: loadFolders
, path: { nodeId, session, reload: reload'}
, render: \folders -> folderViewMain { backFolder
, errors
, boxes
, folders
, nodeId
, session
, tasks
, reload
, setPopoverRef
, reloadForest} }
, setPopoverRef } }
where
errorHandler err = here.log2 "[folderView] RESTError" err
type FolderViewProps =
( backFolder :: Boolean
, errors :: T.Box (Array FrontendError)
, boxes :: Boxes
, folders :: FTree
, nodeId :: Int
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
, session :: Session
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box GAT.Storage
)
folderViewMain :: Record FolderViewProps -> R.Element
......@@ -97,30 +91,26 @@ folderViewMain props = R.createElement folderViewMainCpt props []
folderViewMainCpt :: R.Component FolderViewProps
folderViewMainCpt = here.component "folderViewMainCpt" cpt where
cpt { backFolder
, errors
, boxes
, folders: NTree (LNode {parent_id: parentId, nodeType}) (folders)
, nodeId
, reload
, reloadForest
, session
, setPopoverRef
, tasks } _ = do
, setPopoverRef } _ = do
let foldersS = A.sortBy sortFolders folders
let backHome = isBackHome nodeType
let parent = makeParentFolder parentId session backFolder backHome
let children = makeFolderElements foldersS { errors, session, setPopoverRef, nodeId, tasks, reload, reloadForest }
let children = makeFolderElements foldersS { boxes, nodeId, reload, session, setPopoverRef }
pure $ H.div {className: "fv folders"} $ parent <> children
makeFolderElements foldersS props = makeFolderElementsMap <$> foldersS where
makeFolderElementsMap :: NTree LNode -> R.Element
makeFolderElementsMap (NTree (LNode node) _) = folder { errors: props.errors
makeFolderElementsMap (NTree (LNode node) _) = folder { boxes: props.boxes
, nodeId: node.id
, nodeType: node.nodeType
, parentId: props.nodeId
, tasks: props.tasks
, reload: props.reload
, reloadForest: props.reloadForest
, session: props.session
, setPopoverRef: props.setPopoverRef
, style: FolderChild
......@@ -180,12 +170,10 @@ folderSimpleCpt = here.component "folderSimpleCpt" cpt where
getFolderPath nodeType sid nodeId = appPath $ fromMaybe Home $ nodeTypeAppRoute nodeType sid nodeId
type FolderProps =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, parentId :: Int
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box GAT.Storage
| FolderSimpleProps
)
......@@ -193,9 +181,17 @@ folder :: R2.Component FolderProps
folder = R.createElement folderCpt
folderCpt :: R.Component FolderProps
folderCpt = here.component "folderCpt" cpt where
cpt props@{ errors, style, text, nodeId, session, nodeType, setPopoverRef, parentId, tasks, reload, reloadForest } _ = do
cpt props@{ boxes
, nodeId
, nodeType
, parentId
, reload
, session
, setPopoverRef
, style
, text } _ = do
let sid = sessionId session
let dispatch a = performAction a { errors, nodeId, parentId, tasks, reload, reloadForest, session, setPopoverRef }
let dispatch a = performAction a { boxes, nodeId, parentId, reload, session, setPopoverRef }
popoverRef <- R.useRef null
R.useEffect' $ do
......@@ -211,7 +207,7 @@ folderCpt = here.component "folderCpt" cpt where
, ref: popoverRef
} [
popOverIcon
, mNodePopupView (Record.merge props {dispatch}) (onPopoverClose popoverRef)
, mNodePopupView (Record.merge props { dispatch }) (onPopoverClose popoverRef)
]]
, H.button {on: {click: link ("/#/" <> getFolderPath nodeType sid nodeId) }, className: "btn btn-primary fv btn" } [
H.i {className: icon style nodeType} []
......@@ -234,14 +230,13 @@ folderCpt = here.component "folderCpt" cpt where
<> "Click here to execute one of them." } []
]
mNodePopupView props opc = nodePopupView { dispatch: props.dispatch
, errors: props.errors
mNodePopupView props opc = nodePopupView { boxes: props.boxes
, dispatch: props.dispatch
, id: props.nodeId
, onPopoverClose: opc
, nodeType: props.nodeType
, name: props.text
, session: props.session
, handed: GT.RightHanded
}
backButton :: R.Element
......@@ -273,14 +268,12 @@ loadFolders :: Record LoadProps -> Aff (Either RESTError FTree)
loadFolders {nodeId, session} = get session $ TreeFirstLevel (Just nodeId) ""
type PerformActionProps =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, nodeId :: Int
, parentId :: Int
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, session :: Session
, tasks :: T.Box GAT.Storage
)
performAction :: Action -> Record PerformActionProps -> Aff Unit
......@@ -306,77 +299,77 @@ performAction = performAction' where
closePopover { setPopoverRef } =
liftEffect $ traverse_ (\set -> set false) (R.readRef setPopoverRef)
refreshFolders p = do
liftEffect $ T2.reload p.reload
liftEffect $ T2.reload p.reloadForest
refreshFolders p@{ boxes: { reloadForest }, reload } = do
liftEffect $ T2.reload reload
liftEffect $ T2.reload reloadForest
closePopover p
deleteNode' nt p@{ nodeId: id, parentId: parent_id } = do
deleteNode' nt p@{ nodeId: id, parentId: parent_id, session } = do
case nt of
NodePublic FolderPublic -> void $ deleteNode p.session nt id
NodePublic _ -> void $ unpublishNode p.session (Just parent_id) id
_ -> void $ deleteNode p.session nt id
NodePublic FolderPublic -> void $ deleteNode session nt id
NodePublic _ -> void $ unpublishNode session (Just parent_id) id
_ -> void $ deleteNode session nt id
refreshFolders p
doSearch task { tasks, nodeId: id } = liftEffect $ do
doSearch task { boxes: { tasks }, nodeId: id } = liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] DoSearch task:" task
updateNode params p@{ errors, tasks, nodeId: id } = do
eTask <- updateRequest params p.session id
updateNode params { boxes: { errors, tasks }, nodeId: id, session } = do
eTask <- updateRequest params session id
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] UpdateNode task:" task
shareTeam username p@{ errors, nodeId: id} = do
eTask <- Share.shareReq p.session id $ Share.ShareTeamParams {username}
shareTeam username { boxes: { errors }, nodeId: id, session } = do
eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
handleRESTError errors eTask $ \_task -> pure unit
sharePublic params p@{ errors } = traverse_ f params where
sharePublic params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
addContact params p@{ nodeId: id } =
void $ Contact.contactReq p.session id params
addContact params { nodeId: id, session } =
void $ Contact.contactReq session id params
uploadFile' nodeType fileType mName contents p@{ errors, tasks, nodeId: id } = do
eTask <- uploadFile { contents, fileType, id, nodeType, mName, session: p.session }
uploadFile' nodeType fileType mName contents { boxes: { errors, tasks }, nodeId: id, session } = do
eTask <- uploadFile { contents, fileType, id, nodeType, mName, session }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ errors, tasks, nodeId: id } = do
eTask <- uploadArbitraryFile p.session id { blob, mName }
uploadArbitraryFile' mName blob { boxes: { errors, tasks }, nodeId: id, session } = do
eTask <- uploadArbitraryFile session id { blob, mName }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ errors } = traverse_ f params where
moveNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- moveNodeReq p.session in' out
eTask <- moveNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
mergeNode params p@{ errors } = traverse_ f params where
mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- mergeNodeReq p.session in' out
eTask <- mergeNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
linkNode nodeType params p@{ errors } = traverse_ f params where
linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- linkNodeReq p.session nodeType in' out
eTask <- linkNodeReq session nodeType in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
renameNode name p@{ errors, nodeId: id } = do
eTask <- rename p.session id $ RenameValue { text: name }
renameNode name p@{ boxes: { errors }, nodeId: id, session } = do
eTask <- rename session id $ RenameValue { text: name }
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
addNode' name nodeType p@{ errors, nodeId: id } = do
eTask <- addNode p.session id $ AddNodeValue {name, nodeType}
addNode' name nodeType p@{ boxes: { errors }, nodeId: id, session } = do
eTask <- addNode session id $ AddNodeValue {name, nodeType}
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
module Gargantext.Components.Forest
( forest
, forestLayout
, Common
, Props
) where
......@@ -9,62 +8,33 @@ import Gargantext.Prelude
import Data.Array as A
import Data.Maybe (Maybe(..))
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree (treeLoader)
import Gargantext.Ends (Frontends, Backend)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Types (FrontendError, Handed, switchHanded)
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session(..), unSessions)
import Gargantext.Types (switchHanded)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record.Extra as RX
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree
type Common =
( frontends :: Frontends
, handed :: T.Box Handed
, reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, route :: T.Box AppRoute
)
type Props =
( backend :: T.Box (Maybe Backend)
, errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes
, reloadForest :: T2.ReloadS
, sessions :: T.Box Sessions
, showLogin :: T.Box Boolean
, tasks :: T.Box GAT.Storage
| Common
)
type TreeExtra = (
forestOpen :: T.Box OpenNodes
( boxes :: Boxes
, frontends :: Frontends
)
forest :: R2.Component Props
forest = R.createElement forestCpt
forestCpt :: R.Component Props
forestCpt = here.component "forest" cpt where
cpt props@{ backend
, errors
, forestOpen
, frontends
, handed
cpt { boxes: boxes@{ handed
, reloadForest
, reloadMainPage
, reloadRoot
, route
, sessions
, showLogin
, tasks } _ = do
, sessions }
, frontends } _ = do
-- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor
-- tasks' <- GAT.useTasks reloadRoot reloadForest
-- R.useEffect' $ do
......@@ -78,33 +48,24 @@ forestCpt = here.component "forest" cpt where
-- TODO If `reloadForest` is set, `reload` state should be updated
-- TODO fix tasks ref
pure $ H.div { className: "forest-layout-content" }
(A.cons (plus { backend, handed, showLogin }) (trees handed' sessions'))
(A.cons (plus { boxes }) (trees handed' sessions'))
where
common = RX.pick props :: Record Common
trees handed' sessions' = (tree handed') <$> unSessions sessions'
tree handed' s@(Session {treeId}) =
treeLoader { errors
, forestOpen
tree handed' s@(Session { treeId }) =
treeLoader { boxes
, frontends
, handed: handed'
, reload: reloadForest
, reloadMainPage
, reloadRoot
, root: treeId
, route
, session: s
, tasks } []
, session: s } []
type Plus =
( backend :: T.Box (Maybe Backend)
, handed :: T.Box Handed
, showLogin :: T.Box Boolean )
type Plus = ( boxes :: Boxes )
plus :: R2.Leaf Plus
plus p = R.createElement plusCpt p []
plusCpt :: R.Component Plus
plusCpt = here.component "plus" cpt where
cpt { backend, handed, showLogin } _ = do
cpt { boxes: { backend, handed, showLogin } } _ = do
handed' <- T.useLive T.unequal handed
pure $ H.div {}
......
......@@ -10,6 +10,7 @@ import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node (nodeSpan)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
......@@ -28,11 +29,10 @@ import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute)
import Gargantext.Routes as GR
import Gargantext.Sessions (OpenNodes, Session, get, mkNodeId)
import Gargantext.Sessions (Session, get, mkNodeId)
import Gargantext.Sessions.Types (useOpenNodesMemberBox, openNodesInsert, openNodesDelete)
import Gargantext.Types (FrontendError, Handed, ID, isPublic, publicize, switchHanded)
import Gargantext.Types (Handed, ID, isPublic, publicize, switchHanded)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
......@@ -45,28 +45,59 @@ import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree"
-- Shared by every component here + performAction + nodeSpan
type Universal =
( reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS )
-- Shared by every component here + nodeSpan
type Global =
( frontends :: Frontends
, handed :: Handed
, route :: T.Box AppRoute
, tasks :: T.Box GAT.Storage
| Universal )
-- Shared by every component here
type Common =
( errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes
( boxes :: Boxes
, frontends :: Frontends
, handed :: Handed
, reload :: T2.ReloadS
| Global
)
type LoaderProps = ( session :: Session, root :: ID | Common )
type LoaderProps =
( root :: ID
, session :: Session
| Common )
type NodeProps =
( reloadTree :: T2.ReloadS
, session :: Session
| Common )
type TreeProps =
( tree :: FTree
| NodeProps )
type ChildrenTreeProps =
( childProps :: { children' :: Array FTree
, folderOpen :: T.Box Boolean
, render :: R2.Leaf TreeProps }
| TreeProps )
--- The properties tree shares in common with performAction
type PACommon =
( boxes :: Boxes
, reloadTree :: T2.ReloadS
, session :: Session
, tree :: FTree
)
-- The properties tree shares in common with nodeSpan
type NSCommon =
( frontends :: Frontends
, handed :: Handed
, session :: Session )
-- The annoying 'render' here is busting a cycle in the low tech
-- way. This function is only called by functions in this module, so
-- we just have to careful in what we pass.
type ChildLoaderProps =
( id :: ID
, render :: R2.Leaf TreeProps
| NodeProps )
type PerformActionProps =
( setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
| PACommon )
-- | Loads and renders the tree starting at the given root node id.
treeLoader :: R2.Component LoaderProps
......@@ -96,47 +127,48 @@ getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
getNodeTreeFirstLevel :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
type NodeProps = ( reloadTree :: T2.ReloadS, session :: Session | Common )
type TreeProps = ( tree :: FTree | NodeProps )
tree :: R2.Leaf TreeProps
tree props = R.createElement treeCpt props []
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where
cpt p@{ errors, reload, session, tree: NTree (LNode { id, name, nodeType }) children } _ = do
cpt p@{ boxes: boxes@{ forestOpen }
, frontends
, handed
, reload
, session
, tree: NTree (LNode { id, name, nodeType }) children } _ = do
setPopoverRef <- R.useRef Nothing
folderOpen <- useOpenNodesMemberBox nodeId p.forestOpen
folderOpen <- useOpenNodesMemberBox nodeId forestOpen
pure $ H.ul { className: ulClass }
[ H.li { className: childrenClass children' }
[ nodeSpan (nsprops { errors, folderOpen, name, id, nodeType, setPopoverRef, isLeaf })
[ nodeSpan { boxes
, dispatch: dispatch setPopoverRef
, folderOpen
, frontends
, id
, isLeaf
, name
, nodeType
, reload
, session
, setPopoverRef }
[ renderChildren (Record.merge p { childProps: { children', folderOpen, render: tree } } ) [] ]
]
]
where
isLeaf = A.null children
nodeId = mkNodeId session id
ulClass = switchHanded "ml left" "mr right" p.handed <> "-auto tree handed"
ulClass = switchHanded "ml left" "mr right" handed <> "-auto tree handed"
children' = A.sortWith fTreeID pubChildren
pubChildren = if isPublic nodeType then map (map pub) children else children
nsprops extra = Record.merge common extra' where
common = RecordE.pick p :: Record NSCommon
extra' = Record.merge extra { dispatch, reload } where
dispatch a = performAction a (Record.merge common' spr) where
dispatch setPopoverRef a = performAction a (Record.merge common' spr) where
common' = RecordE.pick p :: Record PACommon
spr = { errors, setPopoverRef: extra.setPopoverRef }
spr = { setPopoverRef }
pub (LNode n@{ nodeType: t }) = LNode (n { nodeType = publicize t })
childrenClass [] = "no-children"
childrenClass _ = "with-children"
type ChildrenTreeProps =
( childProps :: { children' :: Array FTree
, folderOpen :: T.Box Boolean
, render :: R2.Leaf TreeProps }
| TreeProps )
renderChildren :: R2.Component ChildrenTreeProps
renderChildren = R.createElement renderChildrenCpt
renderChildrenCpt :: R.Component ChildrenTreeProps
......@@ -154,7 +186,6 @@ renderTreeChildren = R.createElement renderTreeChildrenCpt
renderTreeChildrenCpt :: R.Component ChildrenTreeProps
renderTreeChildrenCpt = here.component "renderTreeChildren" cpt where
cpt p@{ childProps: { children'
, folderOpen
, render } } _ = do
pure $ R.fragment (map renderChild children')
......@@ -163,32 +194,15 @@ renderTreeChildrenCpt = here.component "renderTreeChildren" cpt where
renderChild (NTree (LNode {id: cId}) _) = childLoader props [] where
props = Record.merge nodeProps { id: cId, render }
--- The properties tree shares in common with performAction
type PACommon =
( errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes
, reloadTree :: T2.ReloadS
, session :: Session
, tasks :: T.Box GAT.Storage
, tree :: FTree
| Universal )
-- The properties tree shares in common with nodeSpan
type NSCommon = ( session :: Session | Global )
-- The annoying 'render' here is busting a cycle in the low tech
-- way. This function is only called by functions in this module, so
-- we just have to careful in what we pass.
type ChildLoaderProps = ( id :: ID, render :: R2.Leaf TreeProps | NodeProps )
childLoader :: R2.Component ChildLoaderProps
childLoader = R.createElement childLoaderCpt
childLoaderCpt :: R.Component ChildLoaderProps
childLoaderCpt = here.component "childLoader" cpt where
cpt p@{ render } _ = do
cpt p@{ boxes: { reloadRoot }
, reloadTree
, render } _ = do
reload <- T.useBox T2.newReload
let reloads = [ reload, p.reloadRoot, p.reloadTree ]
let reloads = [ reload, reloadRoot, reloadTree ]
cache <- (A.cons p.id) <$> traverse (T.useLive T.unequal) reloads
useLoader { errorHandler
, loader: fetch
......@@ -202,86 +216,83 @@ childLoaderCpt = here.component "childLoader" cpt where
extra = { tree: tree' }
nodeProps = RecordE.pick p :: Record NodeProps
type PerformActionProps =
( setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit)) | PACommon )
closePopover { setPopoverRef } =
liftEffect $ traverse_ (\set -> set false) (R.readRef setPopoverRef)
refreshTree p = liftEffect $ T2.reload p.reloadTree *> closePopover p
refreshTree p@{ reloadTree } = liftEffect $ T2.reload reloadTree *> closePopover p
deleteNode' nt p@{ tree: (NTree (LNode {id, parent_id}) _) } = do
deleteNode' nt p@{ boxes: { forestOpen }, session, tree: (NTree (LNode {id, parent_id}) _) } = do
case nt of
GT.NodePublic GT.FolderPublic -> void $ deleteNode p.session nt id
GT.NodePublic _ -> void $ unpublishNode p.session parent_id id
_ -> void $ deleteNode p.session nt id
liftEffect $ T.modify_ (openNodesDelete (mkNodeId p.session id)) p.forestOpen
GT.NodePublic GT.FolderPublic -> void $ deleteNode session nt id
GT.NodePublic _ -> void $ unpublishNode session parent_id id
_ -> void $ deleteNode session nt id
liftEffect $ T.modify_ (openNodesDelete (mkNodeId session id)) forestOpen
refreshTree p
doSearch task p@{ tasks, tree: NTree (LNode {id}) _ } = liftEffect $ do
doSearch task p@{ boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
GAT.insert id task tasks
here.log2 "[doSearch] DoSearch task:" task
updateNode params p@{ errors, tasks, tree: (NTree (LNode {id}) _) } = do
eTask <- updateRequest params p.session id
updateNode params { boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- updateRequest params session id
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[updateNode] UpdateNode task:" task
renameNode name p@{ errors, tree: (NTree (LNode {id}) _) } = do
eTask <- rename p.session id $ RenameValue { text: name }
renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- rename session id $ RenameValue { text: name }
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
shareTeam username p@{ errors, tree: (NTree (LNode {id}) _)} = do
eTask <- Share.shareReq p.session id $ Share.ShareTeamParams {username}
shareTeam username p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _)} = do
eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
handleRESTError errors eTask $ \_task -> pure unit
sharePublic params p@{ errors, forestOpen } = traverse_ f params where
sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
handleRESTError errors eTask $ \_task -> do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
refreshTree p
addContact params p@{ errors, tree: (NTree (LNode {id}) _) } = do
eTask <- Contact.contactReq p.session id params
addContact params p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- Contact.contactReq session id params
handleRESTError errors eTask $ \_task -> pure unit
addNode' name nodeType p@{ errors, forestOpen, tree: (NTree (LNode { id }) _) } = do
eId <- addNode p.session id $ AddNodeValue {name, nodeType}
addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree (LNode { id }) _) } = do
eId <- addNode session id $ AddNodeValue { name, nodeType }
handleRESTError errors eId $ \_id -> liftEffect $ do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session id)) forestOpen
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen
refreshTree p
uploadFile' nodeType fileType mName contents p@{ errors, tasks, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadFile { contents, fileType, id, mName, nodeType, session: p.session }
uploadFile' nodeType fileType mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadFile { contents, fileType, id, mName, nodeType, session }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ errors, tasks, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadArbitraryFile p.session id { blob, mName }
uploadArbitraryFile' mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadArbitraryFile session id { blob, mName }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ errors, forestOpen, session } = traverse_ f params where
moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- moveNodeReq p.session in' out
eTask <- moveNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen
refreshTree p
mergeNode params p@{ errors } = traverse_ f params where
mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- mergeNodeReq p.session in' out
eTask <- mergeNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
linkNode nodeType params p@{ errors } = traverse_ f params where
linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- linkNodeReq p.session nodeType in' out
eTask <- linkNodeReq session nodeType in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
......
......@@ -5,17 +5,15 @@ import Gargantext.Prelude
import Data.Maybe (Maybe(..))
import Data.Nullable (null)
import Data.Symbol (SProxy(..))
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeLink)
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
......@@ -27,7 +25,7 @@ import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (FrontendError, ID, Name, reverseHanded)
import Gargantext.Types (ID, Name, reverseHanded)
import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
......@@ -44,7 +42,8 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node"
-- Main Node
type NodeMainSpanProps =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, dispatch :: Action -> Aff Unit
, folderOpen :: T.Box Boolean
, frontends :: Frontends
, id :: ID
......@@ -52,12 +51,8 @@ type NodeMainSpanProps =
, name :: Name
, nodeType :: GT.NodeType
, reload :: T2.ReloadS
, reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, route :: T.Box Routes.AppRoute
, session :: Session
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box GAT.Storage
| CommonProps
)
type IsLeaf = Boolean
......@@ -67,8 +62,9 @@ nodeSpan = R.createElement nodeSpanCpt
nodeSpanCpt :: R.Component NodeMainSpanProps
nodeSpanCpt = here.component "nodeSpan" cpt
where
cpt props@{ handed } children = do
let className = case handed of
cpt props@{ boxes: { handed } } children = do
handed' <- T.useLive T.unequal handed
let className = case handed' of
GT.LeftHanded -> "lefthanded"
GT.RightHanded -> "righthanded"
......@@ -79,23 +75,23 @@ nodeMainSpan = R.createElement nodeMainSpanCpt
nodeMainSpanCpt :: R.Component NodeMainSpanProps
nodeMainSpanCpt = here.component "nodeMainSpan" cpt
where
cpt props@{ dispatch
, errors
cpt props@{ boxes: boxes@{ errors
, handed
, reloadMainPage
, reloadRoot
, route
, tasks }
, dispatch
, folderOpen
, frontends
, handed
, id
, isLeaf
, name
, nodeType
, reload
, reloadMainPage
, reloadRoot
, route
, session
, setPopoverRef
, tasks
} _ = do
handed' <- T.useLive T.unequal handed
route' <- T.useLive T.unequal route
-- only 1 popup at a time is allowed to be opened
droppedFile <- T.useBox (Nothing :: Maybe DroppedFile)
......@@ -114,12 +110,12 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
-- tasks' <- T.read tasks
pure $ H.span (dropProps droppedFile droppedFile' isDragOver isDragOver')
$ reverseHanded handed
$ reverseHanded handed'
[ folderIcon { folderOpen, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf, nodeType } []
, nodeLink { frontends
, handed
, nodeLink { boxes
, folderOpen
, frontends
, id
, isSelected
, name: name' props
......@@ -187,9 +183,14 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
name' {name: n, nodeType: nt} = if nt == GT.NodeUser then show session else n
mNodePopupView props'@{ id: i, nodeType: nt, handed: h } opc =
nodePopupView { dispatch, errors, handed: h, id: i, name: name' props'
, nodeType: nt, onPopoverClose: opc, session }
mNodePopupView props'@{ boxes: b, id: i, nodeType: nt } opc =
nodePopupView { boxes: b
, dispatch
, id: i
, name: name' props'
, nodeType: nt
, onPopoverClose: opc
, session }
popOverIcon =
H.a { className: "settings fa fa-cog"
......@@ -234,7 +235,6 @@ type FolderIconProps = (
folderIcon :: R2.Component FolderIconProps
folderIcon = R.createElement folderIconCpt
folderIconCpt :: R.Component FolderIconProps
folderIconCpt = here.component "folderIcon" cpt
where
......@@ -245,27 +245,27 @@ folderIconCpt = here.component "folderIcon" cpt
type ChevronIconProps = (
folderOpen :: T.Box Boolean
, handed :: GT.Handed
, handed :: T.Box GT.Handed
, isLeaf :: Boolean
, nodeType :: GT.NodeType
)
chevronIcon :: R2.Component ChevronIconProps
chevronIcon = R.createElement chevronIconCpt
chevronIconCpt :: R.Component ChevronIconProps
chevronIconCpt = here.component "chevronIcon" cpt
where
cpt { folderOpen, handed, isLeaf: true, nodeType } _ = do
pure $ H.div {} []
cpt { folderOpen, handed, isLeaf: false, nodeType } _ = do
handed' <- T.useLive T.unequal handed
open <- T.useLive T.unequal folderOpen
pure $ H.a { className: "chevron-icon"
, on: { click: \_ -> T.modify_ not folderOpen }
}
[ H.i { className: if open
then "fa fa-chevron-down"
else if handed == GT.RightHanded
else if handed' == GT.RightHanded
then "fa fa-chevron-right"
else "fa fa-chevron-left"
} [] ]
......
......@@ -48,7 +48,7 @@ linkNode = R.createElement linkNodeCpt
linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = here.component "linkNode" cpt
where
cpt { dispatch, handed, id, nodeType, session, subTreeParams } _ = do
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing})
action' <- T.useLive T.unequal action
......@@ -60,8 +60,8 @@ linkNodeCpt = here.component "linkNode" cpt
pure $ panel [
subTreeView { action
, boxes
, dispatch
, handed
, id
, nodeType
, session
......
......@@ -31,7 +31,7 @@ mergeNode = R.createElement mergeNodeCpt
mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = here.component "mergeNode" cpt
where
cpt {dispatch, subTreeParams, id, nodeType, session, handed} _ = do
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (MergeNode { params: Nothing })
action' <- T.useLive T.unequal action
......@@ -46,8 +46,8 @@ mergeNodeCpt = here.component "mergeNode" cpt
pure $ panel
[ subTreeView { action
, boxes
, dispatch
, handed
, id
, nodeType
, session
......
......@@ -30,7 +30,7 @@ moveNode = R.createElement moveNodeCpt
moveNodeCpt :: R.Component SubTreeParamsIn
moveNodeCpt = here.component "moveNode" cpt
where
cpt { dispatch, handed, id, nodeType, session, subTreeParams } _ = do
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action :: T.Box Action <- T.useBox (MoveNode {params: Nothing})
action' <- T.useLive T.unequal action
......@@ -43,8 +43,8 @@ moveNodeCpt = here.component "moveNode" cpt
pure $
panel [ subTreeView { action
, boxes
, dispatch
, handed
, id
, nodeType
, session
......
......@@ -5,13 +5,14 @@ import Gargantext.Prelude
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
import Gargantext.Components.Lang (allLangs)
import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError, ID)
import Gargantext.Types (ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
......@@ -23,8 +24,8 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search"
type Props =
( dispatch :: Action -> Aff Unit
, errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, dispatch :: Action -> Aff Unit
, id :: Maybe ID
, nodePopup :: Maybe NodePopup
, session :: Session )
......@@ -35,7 +36,7 @@ actionSearch = R.createElement actionSearchCpt
actionSearchCpt :: R.Component Props
actionSearchCpt = here.component "actionSearch" cpt
where
cpt { dispatch, errors, id, nodePopup, session } _ = do
cpt { boxes: { errors }, dispatch, id, nodePopup, session } _ = do
search <- T.useBox $ defaultSearch { node_id = id }
pure $ R.fragment [ H.p { className: "action-search" }
[ H.text $ "Search and create a private "
......
......@@ -71,7 +71,7 @@ publishNode = R.createElement publishNodeCpt
publishNodeCpt :: R.Component SubTreeParamsIn
publishNodeCpt = here.component "publishNode" cpt
where
cpt { dispatch, handed, id, nodeType, session, subTreeParams } _ = do
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (Action.SharePublic { params: Nothing })
action' <- T.useLive T.unequal action
......@@ -83,8 +83,8 @@ publishNodeCpt = here.component "publishNode" cpt
pure $ Tools.panel
[ subTreeView { action
, boxes
, dispatch
, handed
, id
, nodeType
, session
......
......@@ -5,6 +5,7 @@ import Gargantext.Prelude
import Data.Array as A
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView)
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
......@@ -102,9 +103,16 @@ nodePopupCpt = here.component "nodePopupView" cpt where
else []
mPanelAction :: Record NodePopupS -> Record NodePopupProps -> R.Element
mPanelAction { action: Just action }
{ dispatch, errors, id, name, nodeType, session, handed } =
panelAction { action, dispatch, errors, id, name, nodeType, session
, handed, nodePopup: Just NodePopup }
{ boxes, dispatch, id, name, nodeType, session } =
panelAction { action
, boxes
, dispatch
, id
, name
, nodePopup: Just NodePopup
, nodeType
, session
}
mPanelAction { action: Nothing } _ =
H.div { className: "card-footer" }
[ H.div {className:"center fa-hand-pointer-o"}
......@@ -160,15 +168,14 @@ type NodeProps =
type PanelActionProps =
( id :: ID
, action :: NodeAction
( action :: NodeAction
, boxes :: Boxes
, id :: ID
, dispatch :: Action -> Aff Unit
, errors :: T.Box (Array FrontendError)
, name :: Name
, nodePopup :: Maybe NodePopup
, nodeType :: GT.NodeType
, session :: Session
, handed :: GT.Handed
)
panelAction :: R2.Leaf PanelActionProps
......@@ -186,16 +193,16 @@ panelActionCpt = here.component "panelAction" cpt
cpt {action: Config , dispatch, id, nodeType, session} _ =
pure $ fragmentPT $ "Config " <> show nodeType
-- Functions using SubTree
cpt {action: Merge {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ mergeNode {dispatch, id, nodeType, session, subTreeParams, handed} []
cpt {action: Move {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ moveNode { dispatch, id, nodeType, session, subTreeParams, handed } []
cpt {action: Link {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ linkNode {dispatch, id, nodeType, session, subTreeParams, handed} []
cpt { action: Merge {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ mergeNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ moveNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action : Share, dispatch, id, name } _ = pure $ Share.shareNode { dispatch, id } []
cpt {action : AddingContact, dispatch, id, name } _ = pure $ Contact.actionAddContact { dispatch, id } []
cpt {action : Publish {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ Share.publishNode { dispatch, handed, id, nodeType, session, subTreeParams } []
cpt props@{action: SearchBox, errors, id, session, dispatch, nodePopup} _ =
pure $ actionSearch { dispatch, errors, id: (Just id), nodePopup, session } []
cpt {action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ Share.publishNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt props@{action: SearchBox, boxes, id, session, dispatch, nodePopup} _ =
pure $ actionSearch { boxes, dispatch, id: (Just id), nodePopup, session } []
cpt _ _ = pure $ H.div {} []
......@@ -4,22 +4,21 @@ import DOM.Simple as DOM
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction)
import Gargantext.Prelude (Unit)
import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError, ID, Name)
import Gargantext.Types (ID, Name)
import Gargantext.Types as GT
import Toestand as T
type CommonProps =
( dispatch :: Action -> Aff Unit
, session :: Session
, handed :: GT.Handed
)
type NodePopupProps =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, id :: ID
, name :: Name
, nodeType :: GT.NodeType
......
module Gargantext.Components.Forest.Tree.Node.Tools where
import Gargantext.Prelude
( class Ord, class Read, class Show, Unit
, bind, const, discard, map, not, pure, read, show, when, mempty
, ($), (<), (<<<), (<>), (<$>), (<*>) )
import Data.Maybe (fromMaybe, Maybe(..))
import Data.Nullable (null)
import Data.Set (Set)
......@@ -12,19 +8,20 @@ import Data.String as S
import Data.String.CodeUnits as DSCU
import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action, icon, text)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Ends (Frontends, url)
import Gargantext.Prelude (class Ord, class Read, class Show, Unit, bind, const, discard, map, not, pure, read, show, when, mempty, ($), (<), (<<<), (<>), (<$>), (<*>))
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types as GT
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Glyphicon (glyphicon)
import Gargantext.Utils.ReactTooltip as ReactTooltip
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools"
......@@ -58,7 +55,6 @@ type TextInputBoxProps =
textInputBox :: R2.Component TextInputBoxProps
textInputBox = R.createElement textInputBoxCpt
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where
cpt { boxAction, boxName, dispatch, id, isOpen, text } _ =
......@@ -258,9 +254,9 @@ tooltipId id = "node-link-" <> show id
-- START node link
type NodeLinkProps = (
frontends :: Frontends
boxes :: Boxes
, folderOpen :: T.Box Boolean
, handed :: GT.Handed
, frontends :: Frontends
, id :: Int
, isSelected :: Boolean
, name :: GT.Name
......@@ -270,13 +266,12 @@ type NodeLinkProps = (
nodeLink :: R2.Component NodeLinkProps
nodeLink = R.createElement nodeLinkCpt
nodeLinkCpt :: R.Component NodeLinkProps
nodeLinkCpt = here.component "nodeLink" cpt
where
cpt { folderOpen
cpt { boxes: { handed }
, folderOpen
, frontends
, handed
, id
, isSelected
, name
......@@ -310,23 +305,23 @@ nodeLinkCpt = here.component "nodeLink" cpt
type NodeTextProps =
( isSelected :: Boolean
, handed :: GT.Handed
, handed :: T.Box GT.Handed
, name :: GT.Name
)
nodeText :: R2.Component NodeTextProps
nodeText = R.createElement nodeTextCpt
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = here.component "nodeText" cpt where
cpt { isSelected, handed, name } _ =
cpt { isSelected, handed, name } _ = do
handed' <- T.useLive T.unequal handed
pure $ if isSelected then
H.u { className }
[ H.b {}
[ H.text ("| " <> name15 name <> " | ") ]
]
else
GT.flipHanded l r handed where
GT.flipHanded l r handed' where
l = H.text "..."
r = H.text (name15 name)
name_ len n =
......
......@@ -6,12 +6,7 @@ import Data.Array as A
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action, subTreeOut, setTreeOut)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
......@@ -22,12 +17,17 @@ import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), get)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree"
type SubTreeParamsIn =
( handed :: GT.Handed
( boxes :: Boxes
, subTreeParams :: SubTreeParams
| Props
)
......@@ -44,8 +44,8 @@ subTreeViewCpt :: R.Component SubTreeParamsProps
subTreeViewCpt = here.component "subTreeView" cpt
where
cpt { action
, boxes
, dispatch
, handed
, id
, nodeType
, session
......@@ -61,8 +61,8 @@ subTreeViewCpt = here.component "subTreeView" cpt
, path: session
, render: \tree ->
subTreeViewLoaded { action
, boxes
, dispatch
, handed
, id
, nodeType
, session
......@@ -93,11 +93,12 @@ subTreeViewLoaded = R.createElement subTreeViewLoadedCpt
subTreeViewLoadedCpt :: R.Component CorpusTreeProps
subTreeViewLoadedCpt = here.component "subTreeViewLoaded" cpt
where
cpt p@{ handed } _ = do
cpt p@{ boxes: { handed } } _ = do
handed' <- T.useLive T.unequal handed
let pRender = Record.merge { render: subTreeTreeView } p
pure $ H.div {className:"tree"}
[ H.div { className: if handed == GT.RightHanded
[ H.div { className: if handed' == GT.RightHanded
then "righthanded"
else "lefthanded"
}
......@@ -113,12 +114,13 @@ subTreeTreeView = R2.ntCreateElement subTreeTreeViewCpt
subTreeTreeViewCpt :: R2.NTComponent CorpusTreeRenderProps
subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
cpt (CorpusTreeRenderProps p@{ action
, handed
, boxes: { handed }
, id
, render
, subTreeParams
, tree: NTree (LNode { id: targetId, name, nodeType }) ary }) _ = do
action' <- T.useLive T.unequal action
handed' <- T.useLive T.unequal handed
let click e = do
let action'' = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId }
......@@ -128,7 +130,7 @@ subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
children = (map (\ctree -> render (CorpusTreeRenderProps (p { tree = ctree })) []) sortedAry) :: Array R.Element
pure $ H.div {} $ GT.reverseHanded handed
pure $ H.div {} $ GT.reverseHanded handed'
[ H.div { className: nodeClass validNodeType }
[ H.span { className: "text"
, on: { click } }
......
......@@ -16,7 +16,9 @@ import Data.Set as Set
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.GraphExplorer.Legend as Legend
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.NgramsTable.Core as NTC
......@@ -43,20 +45,15 @@ here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
type Common = (
errors :: T.Box (Array FrontendError)
boxes :: Boxes
, graphId :: NodeID
, metaData :: GET.MetaData
, reloadForest :: T2.ReloadS
, removedNodeIds :: T.Box SigmaxT.NodeIds
, selectedNodeIds :: T.Box SigmaxT.NodeIds
, session :: Session
)
type Props = (
frontends :: Frontends
, graph :: SigmaxT.SGraph
, graphVersion :: T2.ReloadS
, sideTab :: T.Box GET.SideTab
| Common
)
......@@ -65,7 +62,8 @@ sidebar = R.createElement sidebarCpt
sidebarCpt :: R.Component Props
sidebarCpt = here.component "sidebar" cpt
where
cpt props@{ sideTab } _ = do
cpt props@{ boxes: { sidePanelGraph } } _ = do
{ sideTab } <- GEST.focusedSidePanel sidePanelGraph
sideTab' <- T.useLive T.unequal sideTab
pure $ RH.div { id: "sp-container" }
......@@ -77,7 +75,7 @@ sidebarCpt = here.component "sidebar" cpt
GET.SideTabCommunity -> sideTabCommunity sideTabProps []
]
where
sideTabProps = RX.pick props :: Record SideTabProps
sideTabProps = RX.pick props :: Record Props
type SideTabNavProps = (
sideTab :: T.Box GET.SideTab
......@@ -106,11 +104,9 @@ sideTabNavCpt = here.component "sideTabNav" cpt
, on: { click: \_ -> T.write_ tab sideTab }
} [ H.text $ show tab ]
type SideTabProps = Props
sideTabLegend :: R2.Component SideTabProps
sideTabLegend :: R2.Component Props
sideTabLegend = R.createElement sideTabLegendCpt
sideTabLegendCpt :: R.Component SideTabProps
sideTabLegendCpt :: R.Component Props
sideTabLegendCpt = here.component "sideTabLegend" cpt
where
cpt { metaData: GET.MetaData { legend } } _ = do
......@@ -119,13 +115,14 @@ sideTabLegendCpt = here.component "sideTabLegend" cpt
, documentation EN
]
sideTabData :: R2.Component SideTabProps
sideTabData :: R2.Component Props
sideTabData = R.createElement sideTabDataCpt
sideTabDataCpt :: R.Component SideTabProps
sideTabDataCpt :: R.Component Props
sideTabDataCpt = here.component "sideTabData" cpt
where
cpt props _ = do
selectedNodeIds' <- T.useLive T.unequal props.selectedNodeIds
cpt props@{ boxes: { sidePanelGraph } } _ = do
{ selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ RH.div {}
[ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
......@@ -142,18 +139,20 @@ sideTabDataCpt = here.component "sideTabData" cpt
]
sideTabCommunity :: R2.Component SideTabProps
sideTabCommunity :: R2.Component Props
sideTabCommunity = R.createElement sideTabCommunityCpt
sideTabCommunityCpt :: R.Component SideTabProps
sideTabCommunityCpt :: R.Component Props
sideTabCommunityCpt = here.component "sideTabCommunity" cpt
where
cpt props _ = do
selectedNodeIds' <- T.useLive T.unequal props.selectedNodeIds
cpt props@{ boxes: { sidePanelGraph }
, frontends } _ = do
{ selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ RH.div { className: "col-md-12", id: "query" }
[ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
, neighborhood props []
, query { frontends: props.frontends
, query { frontends
, metaData: props.metaData
, nodesMap: SigmaxT.nodesGraphMap props.graph
, searchType: SearchContact
......@@ -177,9 +176,10 @@ selectedNodes = R.createElement selectedNodesCpt
selectedNodesCpt :: R.Component SelectedNodesProps
selectedNodesCpt = here.component "selectedNodes" cpt
where
cpt props@{ graph
, nodesMap
, selectedNodeIds } _ = do
cpt props@{ boxes: { sidePanelGraph }
, graph
, nodesMap } _ = do
{ selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ R2.row
......@@ -219,8 +219,10 @@ neighborhood = R.createElement neighborhoodCpt
neighborhoodCpt :: R.Component Props
neighborhoodCpt = here.component "neighborhood" cpt
where
cpt { graph
, selectedNodeIds } _ = do
cpt { boxes: { sidePanelGraph }
, graph
} _ = do
{ selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ RH.div { className: "tab-content", id: "myTabContent" }
......@@ -248,27 +250,27 @@ updateTermButton = R.createElement updateTermButtonCpt
updateTermButtonCpt :: R.Component UpdateTermButtonProps
updateTermButtonCpt = here.component "updateTermButton" cpt
where
cpt { buttonType
, errors
cpt { boxes: { errors
, reloadForest
, sidePanelGraph }
, buttonType
, graphId
, metaData
, nodesMap
, reloadForest
, removedNodeIds
, rType
, selectedNodeIds
, session
, text } _ = do
{ removedNodeIds, sideTab, selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ if Set.isEmpty selectedNodeIds' then
RH.div {} []
else
RH.button { className: "btn btn-sm btn-" <> buttonType
, on: { click: onClickRemove selectedNodeIds' }
, on: { click: onClickRemove removedNodeIds selectedNodeIds selectedNodeIds' }
} [ RH.text text ]
where
onClickRemove selectedNodeIds' _ = do
onClickRemove removedNodeIds selectedNodeIds selectedNodeIds' _ = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap)
$ Set.toUnfoldable selectedNodeIds'
sendPatches { errors
......
......@@ -9,7 +9,7 @@ import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.FunctorWithIndex (mapWithIndex)
import Data.Lens (Lens', to, (%~), (.~), (^.), (^?), view)
import Data.Lens (to, view, (%~), (.~), (^.), (^?))
import Data.Lens.At (at)
import Data.Lens.Common (_Just)
import Data.Lens.Fold (folded)
......@@ -26,10 +26,10 @@ import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Version, Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncResetButtons, toVersioned)
import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, singletonNgramsTablePatch, syncResetButtons, toVersioned)
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as TT
......@@ -38,7 +38,7 @@ import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, FrontendError, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
......@@ -248,17 +248,14 @@ tableContainerCpt { dispatch
-- NEXT
type CommonProps = (
afterSync :: Unit -> Aff Unit
, errors :: T.Box (Array FrontendError)
, reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
type CommonProps =
( afterSync :: Unit -> Aff Unit
, boxes :: Boxes
, tabNgramType :: CTabNgramType
, tasks :: T.Box GAT.Storage
, withAutoUpdate :: Boolean
)
type Props =
type PropsNoReload =
( cacheState :: NT.CacheState
, mTotalRows :: Maybe Int
, path :: T.Box PageParams
......@@ -267,20 +264,23 @@ type Props =
| CommonProps
)
loadedNgramsTable :: R2.Component Props
type Props =
( reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
| PropsNoReload )
loadedNgramsTable :: R2.Component PropsNoReload
loadedNgramsTable = R.createElement loadedNgramsTableCpt
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt :: R.Component PropsNoReload
loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
cpt { afterSync
, boxes: { errors
, tasks }
, cacheState
, errors
, mTotalRows
, path
, reloadForest
, reloadRoot
, state
, tabNgramType
, tasks
, versioned: Versioned { data: initTable }
, withAutoUpdate } _ = do
state'@{ ngramsChildren, ngramsLocalPatch, ngramsParent, ngramsSelection } <- T.useLive T.unequal state
......@@ -424,11 +424,9 @@ mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
mkDispatch { filteredRows
, path
, state
, state': state'@{ ngramsChildren
, ngramsLocalPatch
, state': { ngramsChildren
, ngramsParent
, ngramsSelection
, ngramsVersion } } = performAction
, ngramsSelection } } = performAction
where
allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
......@@ -525,14 +523,11 @@ mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = here.component "mainNgramsTable" cpt
where
cpt { afterSync
, boxes
, cacheState
, defaultListId
, errors
, path
, reloadForest
, reloadRoot
, tabNgramType
, tasks
, withAutoUpdate } _ = do
cacheState' <- T.useLive T.unequal cacheState
path' <- T.useLive T.unequal path
......@@ -542,13 +537,10 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
case cacheState' of
NT.CacheOn -> do
let render versioned = mainNgramsTablePaint { afterSync
, boxes
, cacheState: cacheState'
, errors
, path
, reloadForest
, reloadRoot
, tabNgramType
, tasks
, versioned
, withAutoUpdate } []
useLoaderWithCacheAPI {
......@@ -562,13 +554,10 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
NT.CacheOff -> do
-- path <- R.useState' path
let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
, boxes
, cacheState: cacheState'
, errors
, path
, reloadForest
, reloadRoot
, tabNgramType
, tasks
, versionedWithCount
, withAutoUpdate } []
useLoader { errorHandler
......@@ -631,27 +620,21 @@ mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
where
cpt { afterSync
, boxes
, cacheState
, errors
, path
, reloadForest
, reloadRoot
, tabNgramType
, tasks
, versioned
, withAutoUpdate } _ = do
state <- T.useBox $ initialState versioned
pure $ loadedNgramsTable { afterSync
, boxes
, cacheState
, errors
, mTotalRows: Nothing
, path
, reloadForest
, reloadRoot
, state
, tabNgramType
, tasks
, versioned
, withAutoUpdate
} []
......@@ -665,38 +648,30 @@ type MainNgramsTablePaintNoCacheProps = (
mainNgramsTablePaintNoCache :: R2.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCache = R.createElement mainNgramsTablePaintNoCacheCpt
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cpt
where
cpt { afterSync
, boxes
, cacheState
, errors
, path
, reloadForest
, reloadRoot
, tabNgramType
, tasks
, versionedWithCount
, withAutoUpdate } _ = do
-- TODO This is lame, make versionedWithCount a proper box?
let count /\ versioned = toVersioned versionedWithCount
state <- T.useBox $ initialState versioned
pure $ loadedNgramsTable {
afterSync
pure $ loadedNgramsTable { afterSync
, boxes
, cacheState
, errors
, mTotalRows: Just count
, path: path
, reloadForest
, reloadRoot
, path
, state
, tabNgramType
, tasks
, versioned
, withAutoUpdate
} []
, withAutoUpdate } []
type NgramsOcc = { occurrences :: Additive Int, children :: Set NgramsTerm }
......
......@@ -186,7 +186,7 @@ pageCpt = here.component "page" cpt
rows pagePath' = (row pagePath') <$> Seq.fromFoldable docs
row { nodeId } contact = { row: contactCells { annuaireId: nodeId, frontends, contact, session }
, delete: false }
container = TT.defaultContainer { title: "Annuaire" } -- TODO
container = TT.defaultContainer -- TODO
colNames = TT.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Role"]
wrapColElts = const identity
......
......@@ -8,7 +8,7 @@ import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.DocsTable.Types (Year)
import Gargantext.Components.NgramsTable as NT
......@@ -19,9 +19,8 @@ import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), FrontendError, PTabNgramType(..), SidePanelState, TabSubType(..), TabType(..))
import Gargantext.Types (CTabNgramType(..), PTabNgramType(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Record as Record
import Record.Extra as RX
......@@ -51,22 +50,17 @@ modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors
type TabsProps =
( cacheState :: T.Box LTypes.CacheState
( boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState
, contactData :: ContactData
, errors :: T.Box (Array FrontendError)
, frontends :: Frontends
, nodeId :: Int
, reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, session :: Session
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
)
tabs :: R2.Leaf TabsProps
tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt where
cpt props _ = do
......@@ -74,7 +68,7 @@ tabsCpt = here.component "tabs" cpt where
yearFilter <- T.useBox (Nothing :: Maybe Year)
pure $ Tab.tabs { activeTab, tabs: tabs' yearFilter props }
tabs' yearFilter props@{ sidePanel, sidePanelState } =
tabs' yearFilter props@{ boxes, sidePanel } =
[ "Documents" /\ docs
, "Patents" /\ ngramsView (viewProps Patents)
, "Books" /\ ngramsView (viewProps Books)
......@@ -84,11 +78,10 @@ tabsCpt = here.component "tabs" cpt where
viewProps mode = Record.merge props { defaultListId: props.contactData.defaultListId
, mode }
totalRecords = 4736 -- TODO lol
docs = DT.docViewLayout (Record.merge { sidePanel, sidePanelState } $ Record.merge dtCommon dtExtra)
docs = DT.docViewLayout (Record.merge { boxes, sidePanel } $ Record.merge dtCommon dtExtra)
dtCommon = RX.pick props :: Record DTCommon
dtExtra =
{ chart: mempty
, errors: props.errors
, listId: props.contactData.defaultListId
, mCorpusId: Nothing
, showSearch: true
......@@ -115,7 +108,7 @@ ngramsView :: R2.Leaf NgramsViewTabsProps
ngramsView props = R.createElement ngramsViewCpt props []
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = here.component "ngramsView" cpt where
cpt props@{ defaultListId, errors, mode, nodeId, session } _ = do
cpt props@{ defaultListId, mode, nodeId, session } _ = do
path <- T.useBox $
NTC.initialPageParams session nodeId
[ defaultListId ] (TabDocument TabDocs)
......@@ -125,7 +118,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where
props' path =
(Record.merge most
{ afterSync
, errors
, path
, tabType: TabPairing (TabNgramType $ modeTabType mode)
, tabNgramType: modeTabType' mode
......@@ -135,10 +127,8 @@ ngramsViewCpt = here.component "ngramsView" cpt where
afterSync _ = pure unit
type NTCommon =
( cacheState :: T.Box LTypes.CacheState
( boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int
, reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, session :: Session
, tasks :: T.Box GAT.Storage
)
......@@ -12,22 +12,22 @@ import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Sessions (WithSession, WithSessionContext, Session, get, put, sessionId)
import Gargantext.Types (FrontendError, NodeType(..), SidePanelState)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
......@@ -37,7 +37,6 @@ type DisplayProps = ( title :: String )
display :: R2.Component DisplayProps
display = R.createElement displayCpt
displayCpt :: R.Component DisplayProps
displayCpt = here.component "display" cpt
where
......@@ -153,14 +152,9 @@ listElement = H.li { className: "list-group-item justify-content-between" }
-}
type LayoutNoSessionProps =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, frontends :: Frontends
, nodeId :: Int
, reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
)
type LayoutProps = WithSession LayoutNoSessionProps
......@@ -177,43 +171,20 @@ userLayout = R.createElement userLayoutCpt
userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = here.component "userLayout" cpt
where
cpt { errors
, frontends
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks } _ = do
cpt props@{ nodeId
, session } _ = do
let sid = sessionId session
pure $ userLayoutWithKey {
errors
, frontends
, key: show sid <> "-" <> show nodeId
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks
}
pure $ userLayoutWithKey $ Record.merge props { key: show sid <> "-" <> show nodeId }
userLayoutWithKey :: R2.Leaf KeyLayoutProps
userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
userLayoutWithKeyCpt :: R.Component KeyLayoutProps
userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
cpt { errors
cpt { boxes: boxes@{ sidePanelTexts }
, frontends
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks } _ = do
, session } _ = do
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
......@@ -227,17 +198,13 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
display { title: fromMaybe "no name" name }
(contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs {
cacheState
boxes
, cacheState
, contactData
, errors
, frontends
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks
, sidePanel: sidePanelTexts
}
]
}
......
......@@ -11,22 +11,22 @@ import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact'(..), ContactData', ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (FrontendError, NodeType(..), SidePanelState)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
......@@ -131,24 +131,20 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataContact
onUpdateHyperdata newHyperdata
type BasicProps =
( errors :: T.Box (Array FrontendError)
type ReloadProps =
( boxes :: Boxes
, frontends :: Frontends
, nodeId :: Int
, sidePanelState :: T.Box SidePanelState
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, tasks :: T.Box GAT.Storage
)
type ReloadProps =
( reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
| BasicProps
)
type LayoutProps = ( session :: Session | ReloadProps )
type LayoutProps =
( session :: Session
| ReloadProps )
type KeyLayoutProps = ( key :: String, session :: Session | ReloadProps )
type KeyLayoutProps =
( key :: String
, session :: Session
| ReloadProps )
saveContactHyperdata :: Session -> Int -> HyperdataContact -> Aff (Either RESTError Int)
saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "")
......@@ -161,46 +157,21 @@ contactLayout :: R2.Component AnnuaireLayoutProps
contactLayout = R.createElement contactLayoutCpt
contactLayoutCpt :: R.Component AnnuaireLayoutProps
contactLayoutCpt = here.component "contactLayout" cpt where
cpt { annuaireId
, errors
, frontends
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks } _ = do
cpt props@{ nodeId
, session } _ = do
let key = show (sessionId session) <> "-" <> show nodeId
pure $
contactLayoutWithKey
{ annuaireId
, errors
, frontends
, key
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel
, sidePanelState
, tasks
}
contactLayoutWithKey $ Record.merge props { key }
contactLayoutWithKey :: R2.Leaf AnnuaireKeyLayoutProps
contactLayoutWithKey props = R.createElement contactLayoutWithKeyCpt props []
contactLayoutWithKeyCpt :: R.Component AnnuaireKeyLayoutProps
contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where
cpt { annuaireId
, errors
, boxes: boxes@{ sidePanelTexts }
, frontends
, reloadForest
, reloadRoot
, nodeId
, session
, sidePanel
, sidePanelState
, tasks } _ = do
, session } _ = do
reload <- T.useBox T2.newReload
_ <- T.useLive T.unequal reload
cacheState <- T.useBox LT.CacheOn
......@@ -212,17 +183,14 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where
[ display { title: fromMaybe "no name" name }
(contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs
{ cacheState
{ boxes
, cacheState
, contactData
, errors
, frontends
, nodeId
, session
, sidePanel
, sidePanelState
, reloadForest
, reloadRoot
, tasks } ] }
, sidePanel: sidePanelTexts
} ] }
where
errorHandler err = here.log2 "[contactLayoutWithKey] RESTError" err
onUpdateHyperdata :: T2.ReloadS -> HyperdataContact -> Effect Unit
......
......@@ -8,6 +8,7 @@ import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.DocsTable.Types (Year)
import Gargantext.Components.NgramsTable as NT
......@@ -49,17 +50,13 @@ modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors
type TabsProps = (
cacheState :: T.Box LTypes.CacheState
boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState
, contactData :: ContactData'
, errors :: T.Box (Array FrontendError)
, frontends :: Frontends
, nodeId :: Int
, reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, session :: Session
, sidePanel :: T.Box (Maybe (Record TTypes.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
)
tabs :: R2.Leaf TabsProps
......@@ -67,17 +64,13 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt
where
cpt { cacheState
cpt { boxes
, cacheState
, contactData: {defaultListId}
, errors
, frontends
, nodeId
, reloadRoot
, reloadForest
, session
, sidePanel
, sidePanelState
, tasks
} _ = do
activeTab <- T.useBox 0
yearFilter <- T.useBox (Nothing :: Maybe Year)
......@@ -92,42 +85,33 @@ tabsCpt = here.component "tabs" cpt
, "Trash" /\ docs -- TODO pass-in trash mode
]
where
patentsView = { cacheState
patentsView = { boxes
, cacheState
, defaultListId
, errors
, mode: Patents
, nodeId
, reloadForest
, reloadRoot
, session
, tasks
}
booksView = { cacheState
booksView = { boxes
, cacheState
, defaultListId
, errors
, mode: Books
, nodeId
, reloadForest
, reloadRoot
, session
, tasks
}
commView = { cacheState
commView = { boxes
, cacheState
, defaultListId
, errors
, mode: Communication
, nodeId
, reloadForest
, reloadRoot
, session
, tasks
}
chart = mempty
totalRecords = 4736 -- TODO
docs = DT.docViewLayout
{ cacheState
{ boxes
, cacheState
, chart
, errors
, frontends
, listId: defaultListId
, mCorpusId: Nothing
......@@ -135,7 +119,6 @@ tabsCpt = here.component "tabs" cpt
, session
, showSearch: true
, sidePanel
, sidePanelState
, tabType: TabPairing TabDocs
, totalRecords
, yearFilter
......@@ -143,15 +126,12 @@ tabsCpt = here.component "tabs" cpt
type NgramsViewTabsProps = (
cacheState :: T.Box LTypes.CacheState
boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int
, errors :: T.Box (Array FrontendError)
, mode :: Mode
, nodeId :: Int
, reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, session :: Session
, tasks :: T.Box GAT.Storage
)
ngramsView :: R2.Component NgramsViewTabsProps
......@@ -160,29 +140,23 @@ ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = here.component "ngramsView" cpt
where
cpt { cacheState
cpt { boxes
, cacheState
, defaultListId
, errors
, reloadForest
, reloadRoot
, mode
, nodeId
, session
, tasks } _ = do
, session } _ = do
path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
pure $ NT.mainNgramsTable {
afterSync: \_ -> pure unit
, boxes
, cacheState
, defaultListId
, errors
, path
, reloadForest
, reloadRoot
, session
, tabNgramType
, tabType
, tasks
, withAutoUpdate: false
} []
where
......
module Gargantext.Components.Nodes.Corpus where
import DOM.Simple.Console (log2)
import Data.Array as A
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq)
......@@ -12,20 +11,20 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.FolderView as FV
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Components.Nodes.Types (FTField, FTFieldList(..), FTFieldWithIndex, FTFieldsWithIndex(..), Field(..), FieldType(..), Hash, Index, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython')
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.REST (RESTError(..))
import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (class Eq, class Show, Unit, bind, discard, pure, show, unit, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>))
import Gargantext.Routes (SessionRoute(Children, NodeAPI))
import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (AffETableResult, FrontendError, NodeType(..))
import Gargantext.Types (AffETableResult, NodeType(..))
import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
......@@ -38,28 +37,24 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus"
type Props =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, nodeId :: Int
, reloadForest :: T2.ReloadS
, session :: Session
, tasks :: T.Box GAT.Storage )
, session :: Session )
corpusLayout :: R2.Leaf Props
corpusLayout props = R.createElement corpusLayoutCpt props []
corpusLayoutCpt :: R.Component Props
corpusLayoutCpt = here.component "corpusLayout" cpt where
cpt { errors, nodeId, session, tasks, reloadForest } _ = do
pure $ corpusLayoutMain { errors, key, nodeId, session, tasks, reloadForest }
cpt { boxes, nodeId, session } _ = do
pure $ corpusLayoutMain { boxes, key, nodeId, session }
where
key = show (sessionId session) <> "-" <> show nodeId
type KeyProps =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, key :: String
, nodeId :: Int
, reloadForest :: T2.ReloadS
, session :: Session
, tasks :: T.Box GAT.Storage
)
corpusLayoutMain :: R2.Leaf KeyProps
......@@ -67,7 +62,7 @@ corpusLayoutMain props = R.createElement corpusLayoutMainCpt props []
corpusLayoutMainCpt :: R.Component KeyProps
corpusLayoutMainCpt = here.component "corpusLayoutMain" cpt
where
cpt { errors, nodeId, key, session, tasks, reloadForest } _ = do
cpt { boxes, key, nodeId, session } _ = do
viewType <- T.useBox Folders
pure $ H.div {} [
......@@ -77,32 +72,34 @@ corpusLayoutMainCpt = here.component "corpusLayoutMain" cpt
, H.div { className: "col-1" } [ FV.homeButton ]
]
]
, H.div {} [corpusLayoutSelection { errors, state: viewType, key, session, nodeId, tasks, reloadForest }]
, H.div {} [corpusLayoutSelection { boxes, key, session, state: viewType, nodeId }]
]
type SelectionProps =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, nodeId :: Int
, key :: String
, session :: Session
, state :: T.Box ViewType
, tasks :: T.Box GAT.Storage
, reloadForest :: T2.ReloadS
)
corpusLayoutSelection :: R2.Leaf SelectionProps
corpusLayoutSelection props = R.createElement corpusLayoutSelectionCpt props []
corpusLayoutSelectionCpt :: R.Component SelectionProps
corpusLayoutSelectionCpt = here.component "corpusLayoutSelection" cpt where
cpt { errors, nodeId, session, key, state, tasks, reloadForest} _ = do
cpt { boxes, key, nodeId, session, state } _ = do
state' <- T.useLive T.unequal state
viewType <- T.read state
pure $ renderContent viewType nodeId session key tasks reloadForest errors
pure $ renderContent viewType nodeId session key boxes
renderContent Folders nodeId session key tasks reloadForest errors =
FV.folderView { errors, nodeId, session, backFolder: true, tasks, reloadForest }
renderContent Code nodeId session key tasks _ _ = corpusLayoutWithKey { key, nodeId, session }
renderContent Folders nodeId session _ boxes =
FV.folderView { backFolder: true
, boxes
, nodeId
, session
}
renderContent Code nodeId session key _ = corpusLayoutWithKey { key, nodeId, session }
type CorpusKeyProps =
( nodeId :: Int
......@@ -184,7 +181,7 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
, session }
liftEffect $ do
_ <- case res of
Left err -> log2 "[corpusLayoutView] onClickSave RESTError" err
Left err -> here.log2 "[corpusLayoutView] onClickSave RESTError" err
_ -> pure unit
T2.reload reload
......@@ -357,7 +354,6 @@ type RenameableTextProps =
renameableText :: Record RenameableTextProps -> R.Element
renameableText props = R.createElement renameableTextCpt props []
renameableTextCpt :: R.Component RenameableTextProps
renameableTextCpt = here.component "renameableTextCpt" cpt
where
......@@ -400,7 +396,6 @@ renameableTextCpt = here.component "renameableTextCpt" cpt
fieldCodeEditor :: Record FieldCodeEditorProps -> R.Element
fieldCodeEditor props = R.createElement fieldCodeEditorCpt props []
fieldCodeEditorCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorCpt = here.component "fieldCodeEditorCpt" cpt
where
......@@ -447,12 +442,12 @@ changeCode onc (JSON j@{desc}) CE.Python c = onc $ Python $ defaultPython' { pyt
toCode = R2.stringify (JSON.writeImpl j) 2
changeCode onc _ CE.JSON c = do
case JSON.readJSON c of
Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
Left err -> here.log2 "[fieldCodeEditor'] cannot parse json" c
Right j' -> onc $ JSON j'
-- case jsonParser c of
-- Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
-- Left err -> here.log2 "[fieldCodeEditor'] cannot parse json" c
-- Right j' -> case decodeJson j' of
-- Left err -> log2 "[fieldCodeEditor'] cannot decode json" j'
-- Left err -> here.log2 "[fieldCodeEditor'] cannot decode json" j'
-- Right j'' -> onc $ JSON j''
changeCode onc (JSON j) CE.Markdown _ = onc $ Markdown $ defaultMarkdown' { text = text }
where
......@@ -500,7 +495,7 @@ loadCorpus {nodeId, session} = do
Just (NodePoly { id: defaultListId }) ->
pure $ Right { corpusId, corpusNode, defaultListId }
Nothing ->
throwError $ error "Missing default list"
pure $ Left $ CustomError "Missing default list"
-- (NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
-- corpusNode <- get session $ corpusNodeRoute corpusId ""
......@@ -570,7 +565,6 @@ type ViewTypeSelectorProps =
viewTypeSelector :: Record ViewTypeSelectorProps -> R.Element
viewTypeSelector p = R.createElement viewTypeSelectorCpt p []
viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
viewTypeSelectorCpt = here.component "viewTypeSelector" cpt
where
......
......@@ -35,13 +35,20 @@ metricsLoadView p = R.createElement metricsLoadViewCpt p []
metricsLoadViewCpt :: forall a. Eq a => R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = here.component "metricsLoadView" cpt
where
cpt { errors, getMetrics, loaded, onClick, onInit, path, reload, session } _ = do
cpt { boxes: boxes@{ errors }
, getMetrics
, loaded
, onClick
, onInit
, path
, reload
, session } _ = do
reload' <- T.useLive T.unequal reload
useLoader { errorHandler
, loader: getMetrics session
, path: reload' /\ path
, render: \l -> loaded { errors, path, reload, session, onClick, onInit } l }
, render: \l -> loaded { boxes, path, reload, session, onClick, onInit } l }
where
errorHandler error = do
T.modify_ (A.cons $ FRESTError { error }) errors
......@@ -64,7 +71,7 @@ metricsWithCacheLoadViewCpt :: forall res ret.
R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt
where
cpt { errors
cpt { boxes
, getMetricsHash
, handleResponse
, loaded
......@@ -76,9 +83,9 @@ metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt
, onInit } _ = do
reload' <- T.useLive T.unequal reload
useLoaderWithCacheAPI { cacheEndpoint: (getMetricsHash session)
, errors
useLoaderWithCacheAPI { boxes
, cacheEndpoint: (getMetricsHash session)
, handleResponse
, mkRequest
, path: (reload' /\ path)
, renderer: loaded { errors, path, reload, session, onClick, onInit } }
, renderer: loaded { boxes, path, reload, session, onClick, onInit } }
......@@ -98,11 +98,11 @@ histo props = R.createElement histoCpt props []
histoCpt :: R.Component Props
histoCpt = here.component "histo" cpt
where
cpt { errors, path, session, onClick, onInit } _ = do
cpt { boxes, path, session, onClick, onInit } _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView {
errors
pure $ metricsWithCacheLoadView
{ boxes
, getMetricsHash
, handleResponse
, loaded
......
......@@ -113,11 +113,11 @@ metrics props = R.createElement metricsCpt props []
metricsCpt :: R.Component Props
metricsCpt = here.component "etrics" cpt
where
cpt { errors, onClick, onInit, path, session } _ = do
cpt { boxes, onClick, onInit, path, session } _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView {
errors
boxes
, getMetricsHash
, handleResponse
, loaded
......
......@@ -106,11 +106,11 @@ pie props = R.createElement pieCpt props []
pieCpt :: R.Component Props
pieCpt = here.component "pie" cpt
where
cpt { errors, path, session, onClick, onInit } _ = do
cpt { boxes, path, session, onClick, onInit } _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView {
errors
pure $ metricsWithCacheLoadView
{ boxes
, getMetricsHash
, handleResponse
, loaded: loadedPie
......@@ -136,11 +136,11 @@ bar props = R.createElement barCpt props []
barCpt :: R.Component Props
barCpt = here.component "bar" cpt
where
cpt { errors, path, session, onClick, onInit} _ = do
cpt { boxes, path, session, onClick, onInit} _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView {
errors
boxes
, getMetricsHash
, handleResponse
, loaded: loadedBar
......
......@@ -7,17 +7,17 @@ import Data.Maybe (Maybe(..), fromMaybe)
import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow)
import Effect (Effect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Charts.Options.Type (EChartsInstance, MouseEvent)
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError, Mode(..), NodeID, TabSubType(..), TabType(..), modeTabType)
import Gargantext.Types (Mode(..), NodeID, TabSubType(..), TabType(..), modeTabType)
import Reactix as R
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Toestand as T
data PredefinedChart =
CDocsHistogram
......@@ -55,9 +55,9 @@ allPredefinedCharts =
type Params =
( corpusId :: NodeID
( boxes :: Boxes
, corpusId :: NodeID
-- optinal params
, errors :: T.Box (Array FrontendError)
, limit :: Maybe Int
, listId :: Maybe Int
, onClick :: Maybe (MouseEvent -> Effect Unit)
......@@ -66,40 +66,40 @@ type Params =
)
render :: PredefinedChart -> Record Params -> R.Element
render CDocsHistogram { corpusId, errors, listId, session, onClick, onInit } =
histo { errors, path, session, onClick, onInit }
render CDocsHistogram { boxes, corpusId, listId, session, onClick, onInit } =
histo { boxes, path, session, onClick, onInit }
where
path = { corpusId
, listId: fromMaybe 0 listId
, limit: Nothing
, tabType: TabCorpus TabDocs
}
render CAuthorsPie { corpusId, errors, listId, session, onClick, onInit } =
pie { errors, path, session, onClick, onInit }
render CAuthorsPie { boxes, corpusId, listId, session, onClick, onInit } =
pie { boxes, path, session, onClick, onInit }
where
path = { corpusId
, listId: fromMaybe 0 listId
, limit: Nothing
, tabType: TabCorpus (TabNgramType $ modeTabType Authors)
}
render CInstitutesTree { corpusId, errors, limit, listId, session, onClick, onInit } =
tree { errors, path, session, onClick, onInit }
render CInstitutesTree { boxes, corpusId, limit, listId, session, onClick, onInit } =
tree { boxes, path, session, onClick, onInit }
where
path = { corpusId
, limit
, listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Institutes)
}
render CTermsMetrics { corpusId, errors, limit, listId, session, onClick, onInit } =
metrics { errors, path, session, onClick, onInit }
render CTermsMetrics { boxes, corpusId, limit, listId, session, onClick, onInit } =
metrics { boxes, path, session, onClick, onInit }
where
path = { corpusId
, limit
, listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Terms)
}
render CSourcesBar { corpusId, errors, limit, listId, session, onClick, onInit } =
metrics { errors, path, session, onClick, onInit }
render CSourcesBar { boxes, corpusId, limit, listId, session, onClick, onInit } =
metrics { boxes, path, session, onClick, onInit }
where
path = { corpusId
, limit
......
......@@ -57,7 +57,7 @@ scatterOptions { onClick, onInit } nodes = Options
}
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
getMetricsHash session (_ /\ { corpusId, listId, tabType }) = do
get session $ ChartHash { chartType: ChartTree, listId: mListId, tabType } (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
......@@ -71,18 +71,18 @@ handleResponse :: HashedResponse Metrics -> Loaded
handleResponse (HashedResponse { value: Metrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGetRequest session $ chartUrl path
mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
tree :: Record Props -> R.Element
tree props = R.createElement treeCpt props []
treeCpt :: R.Component Props
treeCpt = here.component "tree" cpt
where
cpt { errors, path, session, onClick, onInit } _ = do
cpt { boxes, path, session, onClick, onInit } _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView {
errors
pure $ metricsWithCacheLoadView
{ boxes
, getMetricsHash
, handleResponse
, loaded
......@@ -95,7 +95,7 @@ treeCpt = here.component "tree" cpt
}
loaded :: Record MetricsProps -> Loaded -> R.Element
loaded p@{ path, reload, session } loaded' =
loaded p loaded' =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: ChartTree, path, reload, session }
......
......@@ -3,6 +3,7 @@ module Gargantext.Components.Nodes.Corpus.Chart.Types where
import Data.Maybe (Maybe)
import Data.Tuple (Tuple)
import Effect (Effect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Charts.Options.Type (EChartsInstance, MouseEvent)
import Gargantext.Prelude (Unit)
import Gargantext.Sessions (Session)
......@@ -18,7 +19,7 @@ type Path = (
)
type Props = (
errors :: T.Box (Array FrontendError)
boxes :: Boxes
, path :: Record Path
, session :: Session
, onClick :: Maybe (MouseEvent -> Effect Unit)
......
......@@ -7,6 +7,7 @@ import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Nodes.Corpus (fieldsCodeEditor)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Dashboard.Types as DT
......@@ -26,7 +27,7 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Dashboard"
type Props =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, nodeId :: NodeID
, session :: Session )
......@@ -49,7 +50,7 @@ dashboardLayoutWithKey = R.createElement dashboardLayoutWithKeyCpt
dashboardLayoutWithKeyCpt :: R.Component KeyProps
dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
where
cpt { errors, nodeId, session } _ = do
cpt { boxes, nodeId, session } _ = do
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
......@@ -58,10 +59,10 @@ dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
, path: { nodeId, reload: reload', session }
, render: \(DT.DashboardData { hyperdata: DT.Hyperdata h, parentId }) -> do
let { charts, fields } = h
dashboardLayoutLoaded { charts
dashboardLayoutLoaded { boxes
, charts
, corpusId: parentId
, defaultListId: 0
, errors
, fields
, nodeId
, onChange: onChange nodeId reload (DT.Hyperdata h)
......@@ -82,10 +83,10 @@ dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
T2.reload reload
type LoadedProps =
( charts :: Array P.PredefinedChart
( boxes :: Boxes
, charts :: Array P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, errors :: T.Box (Array FrontendError)
, fields :: FTFieldList
, onChange :: { charts :: Array P.PredefinedChart
, fields :: FTFieldList } -> Effect Unit
......@@ -98,7 +99,14 @@ dashboardLayoutLoaded = R.createElement dashboardLayoutLoadedCpt
dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
where
cpt { charts, corpusId, defaultListId, errors, fields, nodeId, onChange, session } _ = do
cpt { boxes
, charts
, corpusId
, defaultListId
, fields
, nodeId
, onChange
, session } _ = do
pure $ H.div {}
[ dashboardCodeEditor { fields
, nodeId
......@@ -122,10 +130,10 @@ dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
, fields }
chartsEls = A.mapWithIndex chartIdx charts
chartIdx idx chart =
renderChart { chart
renderChart { boxes
, chart
, corpusId
, defaultListId
, errors
, onChange: onChangeChart
, onRemove
, session } []
......@@ -199,10 +207,10 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
List.snoc fs $ { idx: List.length fs, ftField: defaultField }) fieldsS
type PredefinedChartProps =
( chart :: P.PredefinedChart
( boxes :: Boxes
, chart :: P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, errors :: T.Box (Array FrontendError)
, onChange :: P.PredefinedChart -> Effect Unit
, onRemove :: Unit -> Effect Unit
, session :: Session
......@@ -213,7 +221,13 @@ renderChart = R.createElement renderChartCpt
renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt = here.component "renderChart" cpt
where
cpt { chart, corpusId, defaultListId, errors, onChange, onRemove, session } _ = do
cpt { boxes
, chart
, corpusId
, defaultListId
, onChange
, onRemove
, session } _ = do
pure $ H.div { className: "row chart card" }
[ H.div { className: "card-header" }
[ H.div { className: "row" }
......@@ -243,13 +257,13 @@ renderChartCpt = here.component "renderChart" cpt
where
value = R.unsafeEventValue e
onRemoveClick _ = onRemove unit
params = { corpusId
, errors
params = { boxes
, corpusId
, limit: Just 1000
, listId: Just defaultListId
, session
, onClick: Nothing
, onInit: Nothing
, session
}
-- aSchool school = H.div {className: "col-md-4 content"} [ chart $ focus school ]
......
......@@ -45,4 +45,4 @@ tab frontends session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, lis
where
dvProps = {frontends, session, nodeId, listId, query, chart, totalRecords: 0, container}
chart = mempty
container = Table.graphContainer {title: corpusLabel}
container = Table.graphContainer
......@@ -2,11 +2,10 @@ module Gargantext.Components.Nodes.Home where
import Gargantext.Prelude
import Control.Bind ((=<<))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect (Effect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.FolderView as FV
import Gargantext.Components.Lang (LandingLang(..))
......@@ -19,9 +18,7 @@ import Gargantext.License (license)
import Gargantext.Sessions (Sessions)
import Gargantext.Sessions as Sessions
import Gargantext.Sessions.Types (Session(..))
import Gargantext.Types (FrontendError)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Routing.Hash (setHash)
......@@ -55,24 +52,20 @@ langLandingData LL_EN = En.landingData
------------------------------------------------------------------------
type HomeProps s l =
( backend :: T.Box (Maybe Backend)
, errors :: T.Box (Array FrontendError)
type HomeProps =
( boxes :: Boxes
, lang :: LandingLang
, sessions :: s
, showLogin :: l
, tasks :: T.Box GAT.Storage
, reloadForest :: T.Box T2.Reload
)
homeLayout :: forall s l. T.Read s Sessions => T.ReadWrite l Boolean
=> R2.Leaf (HomeProps s l)
homeLayout :: R2.Leaf HomeProps
homeLayout props = R.createElement homeLayoutCpt props []
homeLayoutCpt :: forall s l. T.Read s Sessions => T.ReadWrite l Boolean
=> R.Component (HomeProps s l)
homeLayoutCpt :: R.Component HomeProps
homeLayoutCpt = here.component "homeLayout" cpt
where
cpt { backend, errors, lang, sessions, showLogin, tasks, reloadForest} _ = do
cpt { boxes: boxes@{ backend
, sessions
, showLogin }
, lang } _ = do
backend' <- T.useLive T.unequal backend
sessions' <- T.useLive T.unequal sessions
let landingData = langLandingData lang
......@@ -81,7 +74,7 @@ homeLayoutCpt = here.component "homeLayout" cpt
[ H.div { className: "home-title container1" }
[ jumboTitle landingData ]
, H.div { className: "home-research-form container1" } [] -- TODO
, joinButtonOrTutorial errors tasks reloadForest sessions' (click backend')
, joinButtonOrTutorial boxes sessions' (click backend')
, H.div { className: "home-public container1" }
[ renderPublic { }
, H.div { className:"col-12 d-flex justify-content-center" }
......@@ -102,16 +95,14 @@ homeLayoutCpt = here.component "homeLayout" cpt
T.write_ true showLogin
Just _ -> T.write_ true showLogin
joinButtonOrTutorial :: forall e. T.Box (Array FrontendError)
-> T.Box GAT.Storage
-> T2.ReloadS
joinButtonOrTutorial :: forall e. Boxes
-> Sessions
-> (e -> Effect Unit)
-> R.Element
joinButtonOrTutorial errors tasks reloadForest sessions click =
joinButtonOrTutorial boxes sessions click =
if Sessions.null sessions
then joinButton click
else tutorial { errors, tasks, reloadForest, sessions: Sessions.unSessions sessions }
else tutorial { boxes, sessions: Sessions.unSessions sessions }
joinButton :: forall e. (e -> Effect Unit) -> R.Element
joinButton click =
......@@ -158,16 +149,15 @@ summary =
toSummary (Tuto x) = H.li {} [ H.a {href: "#" <> x.id} [ H.text x.title ]]
type TutorialProps =
( errors :: T.Box (Array FrontendError)
, sessions :: Array Session
, tasks :: T.Box GAT.Storage
, reloadForest :: T.Box T2.Reload )
( boxes :: Boxes
, sessions :: Array Session )
tutorial :: R2.Leaf TutorialProps
tutorial props = R.createElement tutorialCpt props []
tutorialCpt :: R.Component TutorialProps
tutorialCpt = here.component "tutorial" cpt where
cpt { errors, sessions, tasks, reloadForest } _ = do
cpt { boxes
, sessions } _ = do
let folders = makeFolders sessions
pure $ H.div { className: "mx-auto container" }
......@@ -193,7 +183,7 @@ tutorialCpt = here.component "tutorial" cpt where
sessionToFolder session@(Session {treeId, username, backend: (Backend {name})}) =
H.span { className: "folder" } [
H.div { className: "d-flex justify-content-center" } [ H.text (username <> "@" <> name) ]
, H.div {} [ FV.folderView { errors, session, tasks, reloadForest, nodeId: treeId, backFolder: false} ] ]
, H.div {} [ FV.folderView { backFolder: false, boxes, nodeId: treeId, session } ] ]
startTutos :: Array Tuto
startTutos =
......
......@@ -2,23 +2,20 @@ module Gargantext.Components.Nodes.Lists where
import Gargantext.Prelude
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..))
import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types (CacheState(..), SidePanel)
import Gargantext.Components.Nodes.Lists.Types (CacheState(..))
import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (WithSession, WithSessionContext, Session, sessionId, getCacheState, setCacheState)
import Gargantext.Types (FrontendError)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
......@@ -29,15 +26,9 @@ here = R2.here "Gargantext.Components.Nodes.Lists"
--------------------------------------------------------
type CommonPropsNoSession =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, nodeId :: Int
, reloadForest :: T2.ReloadS
, reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, sessionUpdate :: Session -> Effect Unit
, sidePanel :: T.Box (Maybe (Record SidePanel))
, sidePanelState :: T.Box GT.SidePanelState
, tasks :: T.Box GAT.Storage
)
type Props = WithSession CommonPropsNoSession
......@@ -48,27 +39,24 @@ type WithTreeProps = ( handed :: GT.Handed | Props )
listsLayout :: R2.Component Props
listsLayout = R.createElement listsLayoutCpt
listsLayoutCpt :: R.Component Props
listsLayoutCpt = here.component "listsLayout" cpt where
cpt props@{ nodeId, session } _ = do
let sid = sessionId session
pure $ listsLayoutWithKey (Record.merge props { key: show sid <> "-" <> show nodeId }) []
type KeyProps = ( key :: String | Props )
type KeyProps =
( key :: String
| Props )
listsLayoutWithKey :: R2.Component KeyProps
listsLayoutWithKey = R.createElement listsLayoutWithKeyCpt
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
cpt { errors
cpt { boxes: boxes@{ reloadMainPage }
, nodeId
, reloadForest
, reloadMainPage
, reloadRoot
, session
, sessionUpdate
, tasks } _ = do
, sessionUpdate } _ = do
activeTab <- T.useBox 0
_reloadMainPage' <- T.useLive T.unequal reloadMainPage
......@@ -98,15 +86,12 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
, user: authors } []
, Tabs.tabs {
activeTab
, boxes
, cacheState
, corpusData
, corpusId
, errors
, key: "listsLayoutWithKey-tabs-" <> (show cacheState')
, reloadForest
, reloadRoot
, session
, tasks
}
] }
where
......@@ -122,7 +107,6 @@ type SidePanelProps =
sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt
sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = here.component "sidePanel" cpt
where
......@@ -151,7 +135,6 @@ type SidePanelDocView = ( session :: Session )
sidePanelDocView :: R2.Component SidePanelDocView
sidePanelDocView = R.createElement sidePanelDocViewCpt
sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = here.component "sidePanelDocView" cpt where
cpt { } _ = do
......
module Gargantext.Components.Nodes.Lists.Tabs where
import Gargantext.Components.Nodes.Lists.Types
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\))
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
......@@ -12,7 +15,6 @@ import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
import Gargantext.Components.Nodes.Lists.Types
import Gargantext.Components.Tab as Tab
import Gargantext.Prelude (bind, pure, unit, ($), (<>))
import Gargantext.Sessions (Session)
......@@ -30,21 +32,17 @@ here = R2.here "Gargantext.Components.Nodes.Lists.Tabs"
type Props = (
activeTab :: T.Box Int
, boxes :: Boxes
, cacheState :: T.Box CacheState
, corpusData :: CorpusData
, corpusId :: Int
, errors :: T.Box (Array FrontendError)
, reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, session :: Session
, tasks :: T.Box GAT.Storage
)
type PropsWithKey = ( key :: String | Props )
tabs :: Record PropsWithKey -> R.Element
tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component PropsWithKey
tabsCpt = here.component "tabs" cpt where
cpt props@{ activeTab } _ = do
......@@ -64,15 +62,12 @@ ngramsView :: R2.Component NgramsViewProps
ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewProps
ngramsViewCpt = here.component "ngramsView" cpt where
cpt props@{ cacheState
cpt props@{ boxes
, cacheState
, corpusData: { defaultListId }
, corpusId
, errors
, reloadForest
, reloadRoot
, mode
, session
, tasks } _ = do
, session } _ = do
chartsReload <- T.useBox T2.newReload
path <- T.useBox $ NTC.initialPageParams props.session initialPath.corpusId [initialPath.listId] initialPath.tabType
......@@ -93,16 +88,13 @@ ngramsViewCpt = here.component "ngramsView" cpt where
pure $ R.fragment
( charts chartParams tabNgramType
<> [ NT.mainNgramsTable { afterSync: afterSync chartsReload
, boxes
, cacheState
, defaultListId
, errors
, path
, reloadForest
, reloadRoot
, session
, tabNgramType
, tabType
, tasks
, withAutoUpdate: false
} []
]
......@@ -160,7 +152,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
]
charts params _ = [ chart params mode ]
chart path Authors = pie { errors, path, session, onClick: Nothing, onInit: Nothing }
chart path Institutes = tree { errors, path, session, onClick: Nothing, onInit: Nothing }
chart path Sources = bar { errors, path, session, onClick: Nothing, onInit: Nothing }
chart path Terms = metrics { errors, path, session, onClick: Nothing, onInit: Nothing }
chart path Authors = pie { boxes, path, session, onClick: Nothing, onInit: Nothing }
chart path Institutes = tree { boxes, path, session, onClick: Nothing, onInit: Nothing }
chart path Sources = bar { boxes, path, session, onClick: Nothing, onInit: Nothing }
chart path Terms = metrics { boxes, path, session, onClick: Nothing, onInit: Nothing }
......@@ -7,6 +7,7 @@ import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Effect.Aff (launchAff_)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Charts.Options.ECharts (dispatchAction)
import Gargantext.Components.Charts.Options.Type (EChartsInstance, EChartActionData)
import Gargantext.Components.DocsTable as DT
......@@ -24,7 +25,7 @@ import Gargantext.Components.Table as Table
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (WithSession, Session, getCacheState)
import Gargantext.Types (CTabNgramType(..), FrontendError, ListId, NodeID, SidePanelState(..), TabSubType(..), TabType(..))
import Gargantext.Types (CTabNgramType(..), ListId, NodeID, SidePanelState(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -37,11 +38,9 @@ here = R2.here "Gargantext.Components.Nodes.Texts"
type CommonPropsNoSession =
( errors :: T.Box (Array FrontendError)
( boxes :: Boxes
, frontends :: Frontends
, nodeId :: NodeID
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, sidePanelState :: T.Box SidePanelState
)
type Props = WithSession CommonPropsNoSession
......@@ -51,14 +50,12 @@ textsLayout :: R2.Component Props
textsLayout = R.createElement textsLayoutCpt
textsLayoutCpt :: R.Component Props
textsLayoutCpt = here.component "textsLayout" cpt where
cpt { errors, frontends, nodeId, session, sidePanel, sidePanelState } children = do
cpt { boxes, frontends, nodeId, session } children = do
pure $ textsLayoutWithKey { key
, errors
, boxes
, frontends
, nodeId
, session
, sidePanel
, sidePanelState } children
, session } children
where
key = show nodeId
-- key = show sid <> "-" <> show nodeId
......@@ -67,12 +64,10 @@ textsLayoutCpt = here.component "textsLayout" cpt where
type KeyProps = (
key :: String
, errors :: T.Box (Array FrontendError)
, boxes :: Boxes
, frontends :: Frontends
, nodeId :: NodeID
, session :: Session
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, sidePanelState :: T.Box SidePanelState
)
textsLayoutWithKey :: R2.Component KeyProps
......@@ -80,12 +75,10 @@ textsLayoutWithKey = R.createElement textsLayoutWithKeyCpt
textsLayoutWithKeyCpt :: R.Component KeyProps
textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt
where
cpt { errors
cpt { boxes: boxes@{ sidePanelTexts }
, frontends
, nodeId
, session
, sidePanel
, sidePanelState } _children = do
, session } _children = do
cacheState <- T.useBox $ getCacheState LT.CacheOff session nodeId
cacheState' <- T.useLive T.unequal cacheState
......@@ -112,16 +105,15 @@ textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt
, title
, user: authors
, key: "textsLayoutWithKey-" <> (show cacheState') } []
, tabs { cacheState
, tabs { boxes
, cacheState
, corpusData
, corpusId
, errors
, eChartsInstance
, frontends
, session
, sidePanel
, sidePanelState
, sidePanel: sidePanelTexts
, yearFilter
, eChartsInstance
}
] }
where
......@@ -146,15 +138,14 @@ modeTabType MoreLikeFav = CTabAuthors -- TODO
modeTabType MoreLikeTrash = CTabSources -- TODO
type TabsProps =
( cacheState :: T.Box LT.CacheState
( boxes :: Boxes
, cacheState :: T.Box LT.CacheState
, corpusData :: CorpusData
, corpusId :: NodeID
, eChartsInstance :: T.Box (Maybe EChartsInstance)
, errors :: T.Box (Array FrontendError)
, frontends :: Frontends
, session :: Session
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, yearFilter :: T.Box (Maybe Year)
)
......@@ -163,15 +154,14 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt
where
cpt { cacheState
cpt { boxes
, cacheState
, corpusId
, corpusData
, eChartsInstance
, errors
, frontends
, session
, sidePanel
, sidePanelState
, yearFilter } _ = do
let
......@@ -206,7 +196,7 @@ tabsCpt = here.component "tabs" cpt
activeTab
, tabs: [
"Documents" /\ R.fragment [
histo { errors, path, session, onClick, onInit }
histo { boxes, path, session, onClick, onInit }
, docView' path TabDocs
]
, "Trash" /\ docView' path TabTrash
......@@ -220,32 +210,30 @@ tabsCpt = here.component "tabs" cpt
, listId: corpusData.defaultListId
, limit: Nothing
, tabType: TabCorpus TabDocs }
docView' path tabType = docView { cacheState
docView' path tabType = docView { boxes
, cacheState
, corpusData
, corpusId
, errors
, frontends
, listId: path.listId
-- , path
, session
, tabType
, sidePanel
, sidePanelState
, yearFilter
} []
type DocViewProps a = (
cacheState :: T.Box LT.CacheState
type DocViewProps a =
( boxes :: Boxes
, cacheState :: T.Box LT.CacheState
, corpusData :: CorpusData
, corpusId :: NodeID
, errors :: T.Box (Array FrontendError)
, frontends :: Frontends
, listId :: ListId
-- , path :: Record DT.Path
, session :: Session
, tabType :: TabSubType a
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, yearFilter :: T.Box (Maybe Year)
)
......@@ -258,20 +246,19 @@ docViewCpt = here.component "docView" cpt
pure $ DT.docViewLayout $ docViewLayoutRec props
-- docViewLayoutRec :: forall a. DocViewProps a -> Record DT.LayoutProps
docViewLayoutRec { cacheState
docViewLayoutRec { boxes
, cacheState
, corpusId
, errors
, frontends
, listId
, session
, tabType: TabDocs
, sidePanel
, sidePanelState
, yearFilter
} =
{ cacheState
{ boxes
, cacheState
, chart : H.div {} []
, errors
, frontends
, listId
, mCorpusId: Just corpusId
......@@ -280,25 +267,23 @@ docViewLayoutRec { cacheState
, session
, showSearch: true
, sidePanel
, sidePanelState
, tabType: TabCorpus TabDocs
, totalRecords: 4737
, yearFilter
}
docViewLayoutRec { cacheState
docViewLayoutRec { boxes
, cacheState
, corpusId
, errors
, frontends
, listId
, session
, tabType: TabMoreLikeFav
, sidePanel
, sidePanelState
, yearFilter
} =
{ cacheState
{ boxes
, cacheState
, chart : H.div {} []
, errors
, frontends
, listId
, mCorpusId: Just corpusId
......@@ -307,25 +292,23 @@ docViewLayoutRec { cacheState
, session
, showSearch: false
, sidePanel
, sidePanelState
, tabType: TabCorpus TabMoreLikeFav
, totalRecords: 4737
, yearFilter
}
docViewLayoutRec { cacheState
docViewLayoutRec { boxes
, cacheState
, corpusId
, errors
, frontends
, listId
, session
, tabType: TabMoreLikeTrash
, sidePanel
, sidePanelState
, yearFilter
} =
{ cacheState
{ boxes
, cacheState
, chart : H.div {} []
, errors
, frontends
, listId
, mCorpusId: Just corpusId
......@@ -334,25 +317,23 @@ docViewLayoutRec { cacheState
, session
, showSearch: false
, sidePanel
, sidePanelState
, tabType: TabCorpus TabMoreLikeTrash
, totalRecords: 4737
, yearFilter
}
docViewLayoutRec { cacheState
docViewLayoutRec { boxes
, cacheState
, corpusId
, errors
, frontends
, listId
, session
, tabType: TabTrash
, sidePanel
, sidePanelState
, yearFilter
} =
{ cacheState
{ boxes
, cacheState
, chart : H.div {} []
, errors
, frontends
, listId
, mCorpusId: Just corpusId
......@@ -361,26 +342,24 @@ docViewLayoutRec { cacheState
, session
, showSearch: true
, sidePanel
, sidePanelState
, tabType: TabCorpus TabTrash
, totalRecords: 4737
, yearFilter
}
-- DUMMY
docViewLayoutRec { cacheState
docViewLayoutRec { boxes
, cacheState
, corpusId
, errors
, frontends
, listId
, session
, sidePanel
, sidePanelState
, tabType
, yearFilter
} =
{ cacheState
{ boxes
, cacheState
, chart : H.div {} []
, errors
, frontends
, listId
, mCorpusId: Just corpusId
......@@ -389,7 +368,6 @@ docViewLayoutRec { cacheState
, session
, showSearch: true
, sidePanel
, sidePanelState
, tabType: TabCorpus TabTrash
, totalRecords: 4737
, yearFilter
......@@ -398,20 +376,19 @@ docViewLayoutRec { cacheState
--------------------------------------------------------
type SidePanelProps = (
session :: Session
boxes :: Boxes
, session :: Session
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, sidePanelState :: T.Box SidePanelState
)
sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt
sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = here.component "sidePanel" cpt
where
cpt { session
, sidePanel
, sidePanelState } _ = do
cpt { boxes: { sidePanelState }
, session
, sidePanel } _ = do
sidePanelState' <- T.useLive T.unequal sidePanelState
sidePanel' <- T.useLive T.unequal sidePanel
......
......@@ -90,16 +90,14 @@ topBar :: R2.Leaf Props
topBar p = R.createElement topBarCpt p []
topBarCpt :: R.Component Props
topBarCpt = here.component "topBar" cpt where
cpt { boxes: boxes@{ handed
, route
, showTree } } _ = do
cpt { boxes: boxes@{ route } } _ = do
route' <- T.useLive T.unequal route
let children = case route' of
GR.PGraphExplorer _s _g -> [ GETB.topBar { boxes } ]
_ -> []
pure $ TopBar.topBar { handed, showTree } children
pure $ TopBar.topBar { boxes } children
mainPage :: R2.Leaf Props
mainPage p = R.createElement mainPageCpt p []
......@@ -112,19 +110,7 @@ forest :: R2.Leaf Props
forest p = R.createElement forestCpt p []
forestCpt :: R.Component Props
forestCpt = here.component "forest" cpt where
cpt { boxes: { backend
, errors
, forestOpen
, handed
, reloadForest
, reloadMainPage
, reloadRoot
, route
, sessions
, showLogin
, showTree
, tasks } } _ = do
cpt { boxes: boxes@{ showTree } } _ = do
showTree' <- T.useLive T.unequal showTree
pure $
......@@ -132,18 +118,8 @@ forestCpt = here.component "forest" cpt where
if not showTree'
then mempty
else Forest.forestLayout
{ backend
, errors
, forestOpen
, frontends: defaultFrontends
, handed
, reloadForest
, reloadMainPage
, reloadRoot
, route
, sessions
, showLogin
, tasks } []
{ boxes
, frontends: defaultFrontends } []
sidePanel :: R2.Leaf Props
sidePanel p = R.createElement sidePanelCpt p []
......@@ -224,15 +200,12 @@ openedSidePanel :: R2.Component (WithSession Props)
openedSidePanel = R.createElement openedSidePanelCpt
openedSidePanelCpt :: R.Component (WithSession Props)
openedSidePanelCpt = here.component "openedSidePanel" cpt where
cpt { boxes: { errors
, graphVersion
, reloadForest
, route
cpt { boxes: boxes@{ route
, sidePanelGraph
, sidePanelState
, sidePanelTexts }
, session} _ = do
{ mGraph, mMetaData, removedNodeIds, selectedNodeIds, sideTab } <- GEST.focusedSidePanel sidePanelGraph
, session } _ = do
{ mGraph, mMetaData } <- GEST.focusedSidePanel sidePanelGraph
mGraph' <- T.useLive T.unequal mGraph
mGraphMetaData' <- T.useLive T.unequal mMetaData
route' <- T.useLive T.unequal route
......@@ -250,23 +223,18 @@ openedSidePanelCpt = here.component "openedSidePanel" cpt where
(_ /\ Nothing) -> pure $ wrapper []
(Just graph /\ Just metaData) -> do
pure $ wrapper
[ GES.sidebar { errors
[ GES.sidebar { boxes
, frontends: defaultFrontends
, graph
, graphId: g
, graphVersion
, metaData
, reloadForest
, removedNodeIds
, selectedNodeIds
, session
, sideTab
} [] ]
GR.Texts _s _n -> do
pure $ wrapper
[ Texts.sidePanel { session
, sidePanel: sidePanelTexts
, sidePanelState } [] ]
[ Texts.sidePanel { boxes
, session
, sidePanel: sidePanelTexts } [] ]
_ -> pure $ wrapper []
annuaire :: R2.Component SessionNodeProps
......@@ -287,11 +255,9 @@ corpusCpt = here.component "corpus" cpt where
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
corpusLayout { errors: boxes.errors
corpusLayout { boxes
, nodeId
, session
, tasks: boxes.tasks
, reloadForest: boxes.reloadForest } } sessionProps) []
, session } } sessionProps) []
type CorpusDocumentProps =
( corpusId :: CorpusId
......@@ -317,10 +283,10 @@ dashboard = R.createElement dashboardCpt
dashboardCpt :: R.Component SessionNodeProps
dashboardCpt = here.component "dashboard" cpt
where
cpt props@{ boxes: { errors }, nodeId } _ = do
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
dashboardLayout { errors, nodeId, session } [] } sessionProps) []
dashboardLayout { boxes, nodeId, session } [] } sessionProps) []
type DocumentProps = ( listId :: ListId | SessionNodeProps )
......@@ -363,33 +329,21 @@ home :: R2.Component Props
home = R.createElement homeCpt
homeCpt :: R.Component Props
homeCpt = here.component "home" cpt where
cpt { boxes: { backend, errors, sessions, showLogin, tasks, reloadForest} } _ = do
pure $ homeLayout { backend, errors, lang: LL_EN, sessions, showLogin, tasks, reloadForest }
cpt { boxes } _ = do
pure $ homeLayout { boxes, lang: LL_EN }
lists :: R2.Component SessionNodeProps
lists = R.createElement listsCpt
listsCpt :: R.Component SessionNodeProps
listsCpt = here.component "lists" cpt where
cpt props@{ boxes: { errors
, reloadForest
, reloadMainPage
, reloadRoot
, sidePanelState
, sidePanelLists
, tasks }
cpt props@{ boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
Lists.listsLayout { errors
Lists.listsLayout { boxes
, nodeId
, reloadForest
, reloadMainPage
, reloadRoot
, session
, sessionUpdate: \_ -> pure unit
, sidePanel: sidePanelLists
, sidePanelState
, tasks } [] } sessionProps) []
, sessionUpdate: \_ -> pure unit } [] } sessionProps) []
login' :: Boxes -> R.Element
login' { backend, sessions, showLogin: visible } =
......@@ -429,52 +383,36 @@ teamCpt = here.component "team" cpt where
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
corpusLayout { errors: boxes.errors
corpusLayout { boxes
, nodeId
, reloadForest: boxes.reloadForest
, session
, tasks: boxes.tasks } } sessionProps) []
, session } } sessionProps) []
texts :: R2.Component SessionNodeProps
texts = R.createElement textsCpt
textsCpt :: R.Component SessionNodeProps
textsCpt = here.component "texts" cpt
where
cpt props@{ boxes: { errors
, sidePanelState
, sidePanelTexts }
cpt props@{ boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
Texts.textsLayout { errors
Texts.textsLayout { boxes
, frontends: defaultFrontends
, nodeId
, session
, sidePanel: sidePanelTexts
, sidePanelState } [] } sessionProps) []
, session } [] } sessionProps) []
user :: R2.Component SessionNodeProps
user = R.createElement userCpt
userCpt :: R.Component SessionNodeProps
userCpt = here.component "user" cpt where
cpt props@{ boxes: { errors
, reloadForest
, reloadRoot
, sidePanelState
, sidePanelTexts
, tasks }
cpt props@{ boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
userLayout { errors
userLayout { boxes
, frontends: defaultFrontends
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel: sidePanelTexts
, sidePanelState
, tasks } [] } sessionProps) []
, session } [] } sessionProps) []
type ContactProps = ( annuaireId :: NodeID | SessionNodeProps )
......@@ -483,23 +421,13 @@ contact = R.createElement contactCpt
contactCpt :: R.Component ContactProps
contactCpt = here.component "contact" cpt where
cpt props@{ annuaireId
, boxes: { errors
, reloadForest
, reloadRoot
, sidePanelTexts
, sidePanelState
, tasks }
, boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
-- let forestedProps = RE.pick props :: Record Props
pure $ authed (Record.merge { content: \session ->
contactLayout { annuaireId
, errors
, boxes
, frontends: defaultFrontends
, nodeId
, reloadForest
, reloadRoot
, session
, sidePanel: sidePanelTexts
, sidePanelState
, tasks } [] } sessionProps) []
, session } [] } sessionProps) []
......@@ -21,27 +21,27 @@ type TabsProps = (
tabs :: R2.Leaf TabsProps
tabs props = R.createElement tabsCpt props []
-- this is actually just the list of tabs, not the tab contents itself
tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt where
cpt props@{ activeTab, tabs } _ = do
cpt { activeTab
, tabs: tabs' } _ = do
activeTab' <- T.useLive T.unequal activeTab
pure $ H.div {}
[ H.nav {}
[ H.br {}
, H.div { className: "nav nav-tabs", title: "Search result" }
(mapWithIndex (button activeTab activeTab') tabs)
(mapWithIndex (button activeTab activeTab') tabs')
]
, H.div { className: "tab-content" }
(mapWithIndex (item activeTab') tabs)
(mapWithIndex (item activeTab') tabs')
]
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 = T.write_ index activeTab
click _ = T.write_ index activeTab
item selected index (_ /\ cpt') = tab { selected, index } [ cpt' ]
-- TODO: document what these are (selection, item indices)
......
......@@ -164,8 +164,8 @@ filterRows { params: { limit, offset, orderBy } } rs = newRs
where
newRs = Seq.take limit $ Seq.drop offset $ rs
defaultContainer :: {title :: String} -> Record TableContainerProps -> R.Element
defaultContainer {title} props = R.fragment $ props.syncResetButton <> controls
defaultContainer :: Record TableContainerProps -> R.Element
defaultContainer props = R.fragment $ props.syncResetButton <> controls
where
controls = [ R2.row
[ H.div {className: "col-md-4"} [ props.pageSizeDescription ]
......@@ -181,8 +181,8 @@ defaultContainer {title} props = R.fragment $ props.syncResetButton <> controls
]
-- TODO: this needs to be in Gargantext.Pages.Corpus.Graph.Tabs
graphContainer :: {title :: String} -> Record TableContainerProps -> R.Element
graphContainer {title} props =
graphContainer :: Record TableContainerProps -> R.Element
graphContainer props =
-- TODO title in tabs name (above)
H.table {className: "table"}
[ H.thead {className: ""} [ props.tableHead ]
......
......@@ -3,28 +3,27 @@ module Gargantext.Components.TopBar where
import Gargantext.Prelude
import Data.Foldable (intercalate)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.Themes (themeSwitcher, defaultTheme, allThemes)
import Gargantext.Types (FrontendError(..), Handed(..), reverseHanded)
import Gargantext.Types (Handed(..), reverseHanded)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.TopBar"
type TopBarProps =
( handed :: T.Box Handed
, showTree :: T.Box Boolean )
( boxes :: Boxes )
topBar :: R2.Component TopBarProps
topBar = R.createElement topBarCpt
topBarCpt :: R.Component TopBarProps
topBarCpt = here.component "topBar" cpt
where
cpt { handed, showTree } children = do
cpt { boxes: { handed, showTree } } children = do
handed' <- T.useLive T.unequal handed
pure $ H.div { className: "navbar navbar-expand-lg navbar-dark bg-dark"
......
......@@ -28,6 +28,7 @@ type Token = String
data RESTError =
SendResponseError Affjax.Error
| ReadJSONError Foreign.MultipleErrors
| CustomError String
derive instance Generic RESTError _
instance Show RESTError where
......@@ -39,6 +40,7 @@ instance Show RESTError where
showError (RequestFailedError) = "(RequestFailedError)"
showError (XHROtherError e') = "(XHROtherError " <> show e' <> ")"
show (ReadJSONError e) = "ReadJSONError " <> show e
show (CustomError s) = "CustomError " <> s
instance Eq RESTError where
-- this is crude but we need it only because of useLoader
eq _ _ = false
......
......@@ -11,6 +11,7 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
......@@ -20,6 +21,7 @@ import Gargantext.Utils.Crypto (Hash)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Simple.JSON as JSON
import Toestand (Box)
import Toestand as T
here :: R2.Here
......@@ -97,9 +99,9 @@ derive instance Newtype (HashedResponse a) _
derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (HashedResponse a)
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (HashedResponse a)
type LoaderWithCacheAPIProps path res ret = (
cacheEndpoint :: path -> Aff (Either RESTError Hash)
, errors :: T.Box (Array FrontendError)
type LoaderWithCacheAPIProps path res ret =
( boxes :: Boxes
, cacheEndpoint :: path -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
......@@ -110,12 +112,17 @@ useLoaderWithCacheAPI :: forall path res ret.
Eq ret => Eq path => JSON.ReadForeign res =>
Record (LoaderWithCacheAPIProps path res ret)
-> R.Hooks R.Element
useLoaderWithCacheAPI { cacheEndpoint, errors, handleResponse, mkRequest, path, renderer } = do
useLoaderWithCacheAPI { boxes
, cacheEndpoint
, handleResponse
, mkRequest
, path
, renderer } = do
state <- T.useBox Nothing
state' <- T.useLive T.unequal state
useCachedAPILoaderEffect { cacheEndpoint
, errors
useCachedAPILoaderEffect { boxes
, cacheEndpoint
, handleResponse
, mkRequest
, path
......@@ -123,8 +130,8 @@ useLoaderWithCacheAPI { cacheEndpoint, errors, handleResponse, mkRequest, path,
pure $ maybe (loadingSpinner {}) renderer state'
type LoaderWithCacheAPIEffectProps path res ret = (
cacheEndpoint :: path -> Aff (Either RESTError Hash)
, errors :: T.Box (Array FrontendError)
boxes :: Boxes
, cacheEndpoint :: path -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
......@@ -135,8 +142,8 @@ useCachedAPILoaderEffect :: forall path res ret.
Eq ret => Eq path => JSON.ReadForeign res =>
Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint
, errors
useCachedAPILoaderEffect { boxes: { errors }
, cacheEndpoint
, handleResponse
, mkRequest
, path
......
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