Commit 5b3610a6 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/600-dev-wip-graphql-errors' into dev-merge

parents eb38e748 00e1f3f4
...@@ -47,6 +47,7 @@ type Store = ...@@ -47,6 +47,7 @@ type Store =
, graphVersion :: T2.ReloadS , graphVersion :: T2.ReloadS
, handed :: T.Box Handed , handed :: T.Box Handed
, lang :: T.Box Lang.LandingLang , lang :: T.Box Lang.LandingLang
, pinnedTreeId :: T.Box (Map String Int)
, reloadForest :: T2.ReloadS , reloadForest :: T2.ReloadS
, reloadMainPage :: T2.ReloadS , reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS , reloadRoot :: T2.ReloadS
...@@ -64,7 +65,6 @@ type Store = ...@@ -64,7 +65,6 @@ type Store =
, theme :: T.Box Themes.Theme , theme :: T.Box Themes.Theme
, tileAxisXList :: T.Box (Array (Record Tile)) , tileAxisXList :: T.Box (Array (Record Tile))
, tileAxisYList :: T.Box (Array (Record Tile)) , tileAxisYList :: T.Box (Array (Record Tile))
, pinnedTreeId :: T.Box (Map String Int)
) )
type State = type State =
...@@ -75,6 +75,7 @@ type State = ...@@ -75,6 +75,7 @@ type State =
, graphVersion :: T2.Reload , graphVersion :: T2.Reload
, handed :: Handed , handed :: Handed
, lang :: Lang.LandingLang , lang :: Lang.LandingLang
, pinnedTreeId :: Map String Int
, reloadForest :: T2.Reload , reloadForest :: T2.Reload
, reloadMainPage :: T2.Reload , reloadMainPage :: T2.Reload
, reloadRoot :: T2.Reload , reloadRoot :: T2.Reload
...@@ -92,7 +93,6 @@ type State = ...@@ -92,7 +93,6 @@ type State =
, theme :: Themes.Theme , theme :: Themes.Theme
, tileAxisXList :: Array (Record Tile) , tileAxisXList :: Array (Record Tile)
, tileAxisYList :: Array (Record Tile) , tileAxisYList :: Array (Record Tile)
, pinnedTreeId :: Map String Int
) )
options :: Record State options :: Record State
...@@ -104,6 +104,7 @@ options = ...@@ -104,6 +104,7 @@ options =
, graphVersion : T2.newReload , graphVersion : T2.newReload
, handed : RightHanded , handed : RightHanded
, lang : Lang.LL_EN , lang : Lang.LL_EN
, pinnedTreeId : Map.empty
, reloadForest : T2.newReload , reloadForest : T2.newReload
, reloadMainPage : T2.newReload , reloadMainPage : T2.newReload
, reloadRoot : T2.newReload , reloadRoot : T2.newReload
...@@ -121,7 +122,6 @@ options = ...@@ -121,7 +122,6 @@ options =
, theme : Themes.defaultTheme , theme : Themes.defaultTheme
, tileAxisXList : mempty , tileAxisXList : mempty
, tileAxisYList : mempty , tileAxisYList : mempty
, pinnedTreeId : Map.empty
} }
context :: R.Context (Record Store) context :: R.Context (Record Store)
......
...@@ -114,12 +114,13 @@ type RatingSimpleLoaderProps = ...@@ -114,12 +114,13 @@ type RatingSimpleLoaderProps =
ratingSimpleLoader :: R2.Component RatingSimpleLoaderProps ratingSimpleLoader :: R2.Component RatingSimpleLoaderProps
ratingSimpleLoader = R.createElement ratingSimpleLoaderCpt ratingSimpleLoader = R.createElement ratingSimpleLoaderCpt
ratingSimpleLoaderCpt :: R.Component RatingSimpleLoaderProps ratingSimpleLoaderCpt :: R.Component RatingSimpleLoaderProps
ratingSimpleLoaderCpt = here.component "ratingSimpleLoader" cpt where ratingSimpleLoaderCpt = R2.hereComponent here "ratingSimpleLoader" hCpt where
cpt { docId hCpt hp { docId
, corpusId , corpusId
, session , session
} _ = do } _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadDocumentContext session , loader: loadDocumentContext session
, path: { docId, corpusId } , path: { docId, corpusId }
, render: \{ nc_category } -> do , render: \{ nc_category } -> do
...@@ -128,12 +129,6 @@ ratingSimpleLoaderCpt = here.component "ratingSimpleLoader" cpt where ...@@ -128,12 +129,6 @@ ratingSimpleLoaderCpt = here.component "ratingSimpleLoader" cpt where
, corpusId , corpusId
, category , category
, session } [] } , session } [] }
where
errorHandler err = do
here.warn2 "[pageLayout] RESTError" err
case err of
ReadJSONError err' -> here.warn2 "[pageLayout] ReadJSONError" $ show err'
_ -> pure unit
type ContextParams = type ContextParams =
( docId :: NodeID ( docId :: NodeID
......
...@@ -30,9 +30,8 @@ here = R2.here "Gargantext.Components.Corpus.EditionBlock" ...@@ -30,9 +30,8 @@ here = R2.here "Gargantext.Components.Corpus.EditionBlock"
editionBlock :: R2.Leaf Props editionBlock :: R2.Leaf Props
editionBlock = R2.leaf editionBlockCpt editionBlock = R2.leaf editionBlockCpt
editionBlockCpt :: R.Component Props editionBlockCpt :: R.Component Props
editionBlockCpt = here.component "main" cpt where editionBlockCpt = R2.hereComponent here "editionBlock" hCpt where
cpt { nodeId hCpt hp { nodeId } _ = do
} _ = do
-- | States -- | States
-- | -- |
session <- useSession session <- useSession
...@@ -42,7 +41,7 @@ editionBlockCpt = here.component "main" cpt where ...@@ -42,7 +41,7 @@ editionBlockCpt = here.component "main" cpt where
-- | Computed -- | Computed
-- | -- |
let let
errorHandler = logRESTError here "[corpusLayout]" errorHandler = logRESTError hp
-- | Hooks -- | Hooks
-- | -- |
...@@ -94,7 +93,7 @@ type Props_ = ...@@ -94,7 +93,7 @@ type Props_ =
editionBlock_ :: R2.Leaf Props_ editionBlock_ :: R2.Leaf Props_
editionBlock_ = R2.leaf editionBlockCpt_ editionBlock_ = R2.leaf editionBlockCpt_
editionBlockCpt_ :: R.Component Props_ editionBlockCpt_ :: R.Component Props_
editionBlockCpt_ = here.component "main_" cpt where editionBlockCpt_ = here.component "editionBlock_" cpt where
cpt { nodeId cpt { nodeId
, hyperdata , hyperdata
} _ = do } _ = do
......
This diff is collapsed.
...@@ -26,7 +26,6 @@ import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData, ...@@ -26,7 +26,6 @@ import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData,
import Gargantext.Components.GraphQL.Endpoints (getContextNgrams) import Gargantext.Components.GraphQL.Endpoints (getContextNgrams)
import Gargantext.Components.NgramsTable.AutoSync (useAutoSync) import Gargantext.Components.NgramsTable.AutoSync (useAutoSync)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Config.REST (logRESTError)
import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA, computeCache) import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA, computeCache)
import Gargantext.Core.NgramsTable.Types (CoreAction(..), NgramsTable(..), NgramsTerm, State, Versioned(..), replace) import Gargantext.Core.NgramsTable.Types (CoreAction(..), NgramsTable(..), NgramsTerm, State, Versioned(..), replace)
import Gargantext.Hooks.FirstEffect (useFirstEffect') import Gargantext.Hooks.FirstEffect (useFirstEffect')
...@@ -66,20 +65,19 @@ options = ...@@ -66,20 +65,19 @@ options =
layout :: forall r. R2.OptLeaf Options Props r layout :: forall r. R2.OptLeaf Options Props r
layout = R2.optLeaf layoutCpt options layout = R2.optLeaf layoutCpt options
layoutCpt :: R.Component Props layoutCpt :: R.Component Props
layoutCpt = here.component "layout" cpt where layoutCpt = R2.hereComponent here "layout" hCpt where
cpt props@{ path: path@{ listIds hCpt hp props@{ path: path@{ listIds
, nodeId } , nodeId }
, session } _ = do , session } _ = do
case A.head listIds of case A.head listIds of
Nothing -> pure $ H.div {} [ H.text "No list supplied!" ] Nothing -> pure $ H.div {} [ H.text "No list supplied!" ]
Just listId -> Just listId ->
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: \p -> getContextNgrams session p.contextId p.listId , loader: \p -> getContextNgrams session p.contextId p.listId
, path: { contextId: nodeId, listId } , path: { contextId: nodeId, listId }
, render: \contextNgrams -> , render: \contextNgrams ->
layoutWithContextNgrams $ Record.merge props { contextNgrams } } layoutWithContextNgrams $ Record.merge props { contextNgrams } }
where
errorHandler = logRESTError here "[layout]"
type WithContextNgramsProps = type WithContextNgramsProps =
( contextNgrams :: Array NgramsTerm ( contextNgrams :: Array NgramsTerm
......
...@@ -23,8 +23,7 @@ componentCpt = here.component "main" cpt where ...@@ -23,8 +23,7 @@ componentCpt = here.component "main" cpt where
cpt _ _ = do cpt _ _ = do
-- | States -- | States
-- | -- |
{ errors { errors } <- AppStore.use
} <- AppStore.use
errors' <- R2.useLive' errors errors' <- R2.useLive' errors
......
...@@ -343,20 +343,15 @@ type PageProps = ( rowsLoaded :: Rows | PageLayoutProps ) ...@@ -343,20 +343,15 @@ type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
pageLayout :: R2.Component PageLayoutProps pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt pageLayoutCpt = R2.hereComponent here "pageLayout" hCpt where
where hCpt hp { container, deletions, frontends, path, session, totalRecords } _ = do
cpt { container, deletions, frontends, path, session, totalRecords } _ = do path' <- T.useLive T.unequal path
path' <- T.useLive T.unequal path
useLoader { errorHandler: Nothing
useLoader { errorHandler , herePrefix: hp
, loader: loadPage , loader: loadPage
, path: path' , path: path'
, render: \rowsLoaded -> page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] } , render: \rowsLoaded -> page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] }
errorHandler err = do
here.warn2 "[pageLayout] RESTError" err
case err of
ReadJSONError err' -> here.warn2 "[pageLayout] ReadJSONError" $ show err'
_ -> pure unit
page :: R2.Component PageProps page :: R2.Component PageProps
page = R.createElement pageCpt page = R.createElement pageCpt
......
...@@ -30,7 +30,7 @@ import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(.. ...@@ -30,7 +30,7 @@ import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..
import Gargantext.Components.GraphQL.Endpoints (getNode, getTreeFirstLevel) import Gargantext.Components.GraphQL.Endpoints (getNode, getTreeFirstLevel)
import Gargantext.Components.GraphQL.Node (Node) import Gargantext.Components.GraphQL.Node (Node)
import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, TreeNode) import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, TreeNode)
import Gargantext.Config.REST (AffRESTError, logRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Config.Utils (handleRESTError) import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Hooks.LinkHandler (useLinkHandler) import Gargantext.Hooks.LinkHandler (useLinkHandler)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
...@@ -57,11 +57,12 @@ data FolderStyle = FolderUp | FolderChild ...@@ -57,11 +57,12 @@ data FolderStyle = FolderUp | FolderChild
folderView :: R2.Leaf Props folderView :: R2.Leaf Props
folderView = R2.leaf folderViewCpt folderView = R2.leaf folderViewCpt
folderViewCpt :: R.Component Props folderViewCpt :: R.Component Props
folderViewCpt = here.component "folderViewCpt" cpt where folderViewCpt = R2.hereComponent here "folderViewCpt" hCpt where
cpt { nodeId, session } _ = do hCpt hp { nodeId, session } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload reload' <- T.useLive T.unequal reload
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadFolders , loader: loadFolders
, path: { nodeId, session, reload: reload'} , path: { nodeId, session, reload: reload'}
, render: \folders -> folderViewMain { folders , render: \folders -> folderViewMain { folders
...@@ -69,8 +70,6 @@ folderViewCpt = here.component "folderViewCpt" cpt where ...@@ -69,8 +70,6 @@ folderViewCpt = here.component "folderViewCpt" cpt where
, reload , reload
, session , session
} [] } } [] }
where
errorHandler = logRESTError here "[folderView]"
type FolderViewProps = type FolderViewProps =
( folders :: TreeFirstLevel ( folders :: TreeFirstLevel
...@@ -264,19 +263,17 @@ backButtonCpt = here.component "backButton" cpt where ...@@ -264,19 +263,17 @@ backButtonCpt = here.component "backButton" cpt where
backButtonSmart :: R2.Component (nodeId :: Int, session :: Session) backButtonSmart :: R2.Component (nodeId :: Int, session :: Session)
backButtonSmart = R.createElement backButtonSmartCpt backButtonSmart = R.createElement backButtonSmartCpt
backButtonSmartCpt :: R.Component (nodeId :: Int, session :: Session) backButtonSmartCpt :: R.Component (nodeId :: Int, session :: Session)
backButtonSmartCpt = here.component "backButtonSmart" cpt where backButtonSmartCpt = R2.hereComponent here "backButtonSmart" hCpt where
cpt {nodeId, session} _ = do hCpt hp { nodeId, session } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload reload' <- T.useLive T.unequal reload
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadNode , loader: loadNode
, path: { nodeId, session, reload: reload' } , path: { nodeId, session, reload: reload' }
, render: \node -> backButtonSmartMain { node, session } [] , render: \node -> backButtonSmartMain { node, session } []
} }
where
errorHandler = logRESTError here "[folderView]"
backButtonSmartMain :: R2.Component (node :: Node, session :: Session) backButtonSmartMain :: R2.Component (node :: Node, session :: Session)
backButtonSmartMain = R.createElement backButtonSmartMainCpt backButtonSmartMain = R.createElement backButtonSmartMainCpt
...@@ -380,14 +377,13 @@ performAction = performAction' where ...@@ -380,14 +377,13 @@ performAction = performAction' where
updateNode params { boxes: { errors, tasks }, nodeId: id, session } = do updateNode params { boxes: { errors, tasks }, nodeId: id, session } = do
eTask <- updateRequest params session id eTask <- updateRequest params session id
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[updateNode]") errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UpdateNode task:" task
sharePublic params p@{ boxes: { errors }, session } = traverse_ f params where sharePublic params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out } eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[sharePublic]") errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
addContact params { nodeId: id, session } = addContact params { nodeId: id, session } =
...@@ -395,40 +391,38 @@ performAction = performAction' where ...@@ -395,40 +391,38 @@ performAction = performAction' where
uploadFile' nodeType fileType fileFormat lang mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do uploadFile' nodeType fileType fileFormat lang mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do
eTask <- uploadFile { contents, fileType, fileFormat, lang, id, nodeType, mName, selection, session } eTask <- uploadFile { contents, fileType, fileFormat, lang, id, nodeType, mName, selection, session }
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[uploadFile']") errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' fileFormat mName blob { boxes: { errors, tasks }, nodeId: id, session } selection = do uploadArbitraryFile' fileFormat mName blob { boxes: { errors, tasks }, nodeId: id, session } selection = do
eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[uploadArbitraryFile']") errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ boxes: { errors }, session } = traverse_ f params where moveNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- moveNodeReq session in' out eTask <- moveNodeReq session in' out
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[moveNode]") errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- mergeNodeReq session in' out eTask <- mergeNodeReq session in' out
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[mergeNode]") errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- linkNodeReq session nodeType in' out eTask <- linkNodeReq session nodeType in' out
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[linkNode]") errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
renameNode name p@{ boxes: { errors }, nodeId: id, session } = do renameNode name p@{ boxes: { errors }, nodeId: id, session } = do
eTask <- rename session id $ RenameValue { text: name } eTask <- rename session id $ RenameValue { text: name }
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[renameNode]") errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
addNode' name nodeType p@{ boxes: { errors }, nodeId: id, session } = do addNode' name nodeType p@{ boxes: { errors }, nodeId: id, session } = do
eTask <- addNode session id $ AddNodeValue {name, nodeType} eTask <- addNode session id $ AddNodeValue {name, nodeType}
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[addNode']") errors eTask $ \_task -> pure unit
refreshFolders p refreshFolders p
...@@ -9,7 +9,7 @@ import Data.Array as A ...@@ -9,7 +9,7 @@ import Data.Array as A
import Data.Map (empty) import Data.Map (empty)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Position(..), TooltipPosition(..), Variant(..)) import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Position(..), TooltipPosition(..), Variant(..))
import Gargantext.Components.Forest.Tree (treeLoader) import Gargantext.Components.Forest.Tree (treeLoader)
...@@ -27,20 +27,16 @@ here = R2.here "Gargantext.Components.Forest" ...@@ -27,20 +27,16 @@ here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree -- Shared by components here with Tree
type Props = type Props =
( boxes :: Boxes ( frontends :: Frontends
, frontends :: Frontends
) )
forestLayout :: R2.Leaf Props forestLayout :: R2.Leaf Props
forestLayout = R2.leaf forestLayoutCpt forestLayout = R2.leaf forestLayoutCpt
forestLayoutCpt :: R.Component Props forestLayoutCpt :: R.Component Props
forestLayoutCpt = here.component "forest" cpt where forestLayoutCpt = here.component "forest" cpt where
cpt { boxes: boxes@{ handed cpt { frontends } _ = do
, reloadForest { handed, reloadForest, sessions, pinnedTreeId } <- Store.use
, sessions
, pinnedTreeId }
, frontends } _ = do
-- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor -- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor
-- tasks' <- GAT.useTasks reloadRoot reloadForest -- tasks' <- GAT.useTasks reloadRoot reloadForest
-- R.useEffect' $ do -- R.useEffect' $ do
...@@ -58,16 +54,16 @@ forestLayoutCpt = here.component "forest" cpt where ...@@ -58,16 +54,16 @@ forestLayoutCpt = here.component "forest" cpt where
H.div H.div
{ className: "forest-layout bg-light" } { className: "forest-layout bg-light" }
(A.cons (plus { boxes }) (trees handed' pinnedTreeId' sessions')) (A.cons (plus {}) (trees handed' pinnedTreeId' sessions' reloadForest))
where where
trees handed' pinnedTreeId' sessions' = (tree handed' pinnedTreeId') <$> unSessions sessions' trees handed' pinnedTreeId' sessions' reloadForest =
tree handed' pinnedTreeId' s@(Session { treeId }) = (tree handed' pinnedTreeId' reloadForest) <$> unSessions sessions'
tree handed' pinnedTreeId' reloadForest s@(Session { treeId }) =
H.div H.div
{ className: "forest-layout__tree" } { className: "forest-layout__tree" }
[ [
treeLoader treeLoader
{ boxes { frontends
, frontends
, handed: handed' , handed: handed'
, reload: reloadForest , reload: reloadForest
, root: r , root: r
...@@ -78,13 +74,15 @@ forestLayoutCpt = here.component "forest" cpt where ...@@ -78,13 +74,15 @@ forestLayoutCpt = here.component "forest" cpt where
where where
r = fromMaybe treeId (Map.lookup (show s) pinnedTreeId') r = fromMaybe treeId (Map.lookup (show s) pinnedTreeId')
type Plus = ( boxes :: Boxes ) type Plus = ( )
plus :: R2.Leaf Plus plus :: R2.Leaf Plus
plus = R2.leaf plusCpt plus = R2.leaf plusCpt
plusCpt :: R.Component Plus plusCpt :: R.Component Plus
plusCpt = here.component "plus" cpt where plusCpt = here.component "plus" cpt where
cpt { boxes: { backend, showLogin, showSearch, pinnedTreeId} } _ = do cpt { } _ = do
{ backend, pinnedTreeId, showLogin, showSearch } <- Store.use
-- Hooks -- Hooks
{ goToRoute } <- useLinkHandler { goToRoute } <- useLinkHandler
......
...@@ -37,7 +37,7 @@ import URI.Fragment as Fragment ...@@ -37,7 +37,7 @@ import URI.Fragment as Fragment
import Effect (Effect) import Effect (Effect)
import Effect.Console (log) import Effect.Console (log)
import Toestand as T import Toestand as T
import Gargantext.Config.REST (AffRESTError, logRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
...@@ -165,14 +165,15 @@ componentCpt = here.component "breadcrumb" cpt where ...@@ -165,14 +165,15 @@ componentCpt = here.component "breadcrumb" cpt where
breadcrumbView :: R2.Leaf Props breadcrumbView :: R2.Leaf Props
breadcrumbView = R2.leaf breadcrumbViewCpt breadcrumbView = R2.leaf breadcrumbViewCpt
breadcrumbViewCpt :: R.Component Props breadcrumbViewCpt :: R.Component Props
breadcrumbViewCpt = here.component "breadcrumbViewCpt" cpt where breadcrumbViewCpt = R2.hereComponent here "breadcrumbViewCpt" hCpt where
cpt { nodeId, session } _ = do hCpt hp { nodeId, session } _ = do
let session' = session let session' = session
case session' of case session' of
Nothing -> pure $ H.div {} [] Nothing -> pure $ H.div {} []
Just (session') -> do Just (session') -> do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadBreadcrumbData , loader: loadBreadcrumbData
, path: { nodeId: nodeId , path: { nodeId: nodeId
, session: session' , session: session'
...@@ -184,8 +185,6 @@ breadcrumbViewCpt = here.component "breadcrumbViewCpt" cpt where ...@@ -184,8 +185,6 @@ breadcrumbViewCpt = here.component "breadcrumbViewCpt" cpt where
-- , reload: reload -- , reload: reload
} [] } []
} }
where
errorHandler = logRESTError here "[breadcrumbView]"
type BreadcrumbViewProps = type BreadcrumbViewProps =
( items :: BreadcrumbInfo ( items :: BreadcrumbInfo
......
...@@ -10,7 +10,7 @@ import Data.Tuple.Nested ((/\)) ...@@ -10,7 +10,7 @@ import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Forest.Tree.Node (blankNodeSpan, nodeSpan) import Gargantext.Components.Forest.Tree.Node (blankNodeSpan, nodeSpan)
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode) import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
...@@ -50,8 +50,7 @@ here = R2.here "Gargantext.Components.Forest.Tree" ...@@ -50,8 +50,7 @@ here = R2.here "Gargantext.Components.Forest.Tree"
-- Shared by every component here -- Shared by every component here
type Common = type Common =
( boxes :: Boxes ( frontends :: Frontends
, frontends :: Frontends
, handed :: Handed , handed :: Handed
, reload :: T2.ReloadS , reload :: T2.ReloadS
) )
...@@ -79,8 +78,7 @@ type ChildrenTreeProps = ...@@ -79,8 +78,7 @@ type ChildrenTreeProps =
--- The properties tree shares in common with performAction --- The properties tree shares in common with performAction
type PACommon = type PACommon =
( boxes :: Boxes ( reloadTree :: T2.ReloadS
, reloadTree :: T2.ReloadS
, session :: Session , session :: Session
, tree :: FTree , tree :: FTree
) )
...@@ -102,7 +100,8 @@ type ChildLoaderProps = ...@@ -102,7 +100,8 @@ type ChildLoaderProps =
) )
type PerformActionProps = type PerformActionProps =
( isBoxVisible :: T.Box Boolean ( boxes :: Store.Boxes
, isBoxVisible :: T.Box Boolean
| PACommon | PACommon
) )
...@@ -111,11 +110,11 @@ treeLoader :: R2.Leaf ( key :: String | LoaderProps ) ...@@ -111,11 +110,11 @@ treeLoader :: R2.Leaf ( key :: String | LoaderProps )
treeLoader = R2.leaf treeLoaderCpt treeLoader = R2.leaf treeLoaderCpt
treeLoaderCpt :: R.Component ( key :: String | LoaderProps ) treeLoaderCpt :: R.Component ( key :: String | LoaderProps )
treeLoaderCpt = here.component "treeLoader" cpt where treeLoaderCpt = R2.hereComponent here "treeLoader" hCpt where
-- treeLoaderCpt :: R.Memo LoaderProps -- treeLoaderCpt :: R.Memo LoaderProps
-- treeLoaderCpt = R.memo (here.component "treeLoader" cpt) memoCmp where -- treeLoaderCpt = R.memo (here.component "treeLoader" cpt) memoCmp where
-- memoCmp ({ root: t1 }) ({ root: t2 }) = t1 == t2 -- memoCmp ({ root: t1 }) ({ root: t2 }) = t1 == t2
cpt p@{ root, session } _ = do hCpt hp p@{ root, session } _ = do
-- States -- States
-- app <- T.useLive T.unequal p.reloadRoot -- app <- T.useLive T.unequal p.reloadRoot
state /\ stateBox <- R2.useBox' Nothing state /\ stateBox <- R2.useBox' Nothing
...@@ -145,7 +144,7 @@ treeLoaderCpt = here.component "treeLoader" cpt where ...@@ -145,7 +144,7 @@ treeLoaderCpt = here.component "treeLoader" cpt where
props = Record.merge common extra where props = Record.merge common extra where
common = RecordE.pick p :: Record Common common = RecordE.pick p :: Record Common
extra = { reloadTree: p.reload, root, session, tree: tree' } extra = { reloadTree: p.reload, root, session, tree: tree' }
errorHandler = logRESTError here "[treeLoader]" errorHandler = logRESTError hp
getNodeTree :: Session -> ID -> AffRESTError FTree getNodeTree :: Session -> ID -> AffRESTError FTree
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) "" getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
...@@ -157,12 +156,12 @@ tree :: R2.Leaf TreeProps ...@@ -157,12 +156,12 @@ tree :: R2.Leaf TreeProps
tree props = R.createElement treeCpt props [] tree props = R.createElement treeCpt props []
treeCpt :: R.Component TreeProps treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where treeCpt = here.component "tree" cpt where
cpt p@{ boxes: boxes@{ forestOpen } cpt p@{ frontends
, frontends
, reload , reload
, root , root
, session , session
, tree: NTree (LNode { id, name, nodeType }) children } _ = do , tree: NTree (LNode { id, name, nodeType }) children } _ = do
boxes@{ forestOpen } <- Store.use
isBoxVisible <- T.useBox false isBoxVisible <- T.useBox false
folderOpen <- useOpenNodesMemberBox nodeId forestOpen folderOpen <- useOpenNodesMemberBox nodeId forestOpen
...@@ -183,18 +182,17 @@ treeCpt = here.component "tree" cpt where ...@@ -183,18 +182,17 @@ treeCpt = here.component "tree" cpt where
{ className: "maintree__node" } { className: "maintree__node" }
[ [
nodeSpan nodeSpan
{ boxes { dispatch: dispatch' boxes isBoxVisible
, dispatch: dispatch' isBoxVisible
, folderOpen , folderOpen
, frontends , frontends
, id , id
, isBoxVisible
, isLeaf , isLeaf
, name , name
, nodeType , nodeType
, reload , reload
, root , root
, session , session
, isBoxVisible
} }
<> <>
R2.when (folderOpen') R2.when (folderOpen')
...@@ -214,9 +212,9 @@ treeCpt = here.component "tree" cpt where ...@@ -214,9 +212,9 @@ treeCpt = here.component "tree" cpt where
nodeId = mkNodeId session id nodeId = mkNodeId session id
children' = A.sortWith fTreeID pubChildren children' = A.sortWith fTreeID pubChildren
pubChildren = if isPublic nodeType then map (map pub) children else children pubChildren = if isPublic nodeType then map (map pub) children else children
dispatch' isBoxVisible a = performAction a (Record.merge common' extra) where dispatch' boxes isBoxVisible a = performAction a (Record.merge common' extra) where
common' = RecordE.pick p :: Record PACommon common' = RecordE.pick p :: Record PACommon
extra = { isBoxVisible } extra = { boxes, isBoxVisible }
pub (LNode n@{ nodeType: t }) = LNode (n { nodeType = publicize t }) pub (LNode n@{ nodeType: t }) = LNode (n { nodeType = publicize t })
...@@ -257,12 +255,12 @@ renderTreeChildrenCpt = here.component "renderTreeChildren" cpt where ...@@ -257,12 +255,12 @@ renderTreeChildrenCpt = here.component "renderTreeChildren" cpt where
childLoader :: R2.Component ChildLoaderProps childLoader :: R2.Component ChildLoaderProps
childLoader = R.createElement childLoaderCpt childLoader = R.createElement childLoaderCpt
childLoaderCpt :: R.Component ChildLoaderProps childLoaderCpt :: R.Component ChildLoaderProps
childLoaderCpt = here.component "childLoader" cpt where childLoaderCpt = R2.hereComponent here "childLoader" hCpt where
cpt p@{ boxes: { reloadRoot } hCpt hp p@{ reloadTree
, reloadTree , render
, render , root } _ = do
, root } _ = do
-- States -- States
{ reloadRoot } <- Store.use
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
state /\ stateBox <- R2.useBox' Nothing state /\ stateBox <- R2.useBox' Nothing
let reloads = [ reload, reloadRoot, reloadTree ] let reloads = [ reload, reloadRoot, reloadTree ]
...@@ -289,7 +287,7 @@ childLoaderCpt = here.component "childLoader" cpt where ...@@ -289,7 +287,7 @@ childLoaderCpt = here.component "childLoader" cpt where
} }
where where
errorHandler = logRESTError here "[childLoader]" errorHandler = logRESTError hp
fetch _ = getNodeTreeFirstLevel p.session p.id fetch _ = getNodeTreeFirstLevel p.session p.id
paint reload tree' = render (Record.merge base extra) where paint reload tree' = render (Record.merge base extra) where
base = nodeProps { reload = reload } base = nodeProps { reload = reload }
...@@ -311,78 +309,74 @@ deleteNode' nt p@{ boxes: { forestOpen }, session, tree: (NTree (LNode {id, pare ...@@ -311,78 +309,74 @@ deleteNode' nt p@{ boxes: { forestOpen }, session, tree: (NTree (LNode {id, pare
doSearch task { boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do doSearch task { boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[doSearch] DoSearch task:" task
updateNode params p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do updateNode params p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- updateRequest params session id eTask <- updateRequest params session id
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[updateNode]") errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[updateNode] UpdateNode task:" task
closeBox p closeBox p
renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- rename session id $ RenameValue { text: name } eTask <- rename session id $ RenameValue { text: name }
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[renameNode]") errors eTask $ \_task -> pure unit
refreshTree p refreshTree p
sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out } eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
handleRESTError here errors eTask $ \_task -> do handleRESTError (R2.herePrefix here "[sharePublic]") errors eTask $ \_task -> do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
refreshTree p refreshTree p
addContact params { boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do addContact params { boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- Contact.contactReq session id params eTask <- Contact.contactReq session id params
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[addContact]") errors eTask $ \_task -> pure unit
addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree (LNode { id }) _) } = do addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree (LNode { id }) _) } = do
eId <- addNode session id $ AddNodeValue { name, nodeType } eId <- addNode session id $ AddNodeValue { name, nodeType }
handleRESTError here errors eId $ \_id -> liftEffect $ do handleRESTError (R2.herePrefix here "[addNode']") errors eId $ \_id -> liftEffect $ do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen
refreshTree p refreshTree p
uploadFile' nodeType fileType fileFormat lang mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do uploadFile' nodeType fileType fileFormat lang mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadFile { contents, fileFormat, fileType, id, lang, mName, nodeType, selection, session } eTask <- uploadFile { contents, fileFormat, fileType, id, lang, mName, nodeType, selection, session }
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[uploadFile']") errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[uploadFile'] UploadFile, uploaded, task:" task here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
closeBox p closeBox p
uploadArbitraryFile' fileFormat mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do uploadArbitraryFile' fileFormat mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[uploadArbitraryFile']") errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task
uploadFrameCalc' lang p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do uploadFrameCalc' lang p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadFrameCalc session id lang selection eTask <- uploadFrameCalc session id lang selection
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[uploadFrameCalc']") errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UploadFrameCalc, uploaded, task:" task
moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- moveNodeReq session in' out eTask <- moveNodeReq session in' out
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[moveNode]") errors eTask $ \_task -> pure unit
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen
refreshTree p refreshTree p
mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- mergeNodeReq session in' out eTask <- mergeNodeReq session in' out
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[mergeNode]") errors eTask $ \_task -> pure unit
refreshTree p refreshTree p
linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
eTask <- linkNodeReq session nodeType in' out eTask <- linkNodeReq session nodeType in' out
handleRESTError here errors eTask $ \_task -> pure unit handleRESTError (R2.herePrefix here "[linkNode]") errors eTask $ \_task -> pure unit
refreshTree p refreshTree p
documentsFromWriteNodes params p@{ boxes: { errors, tasks }, session, tree: NTree (LNode { id }) _ } = do documentsFromWriteNodes params p@{ boxes: { errors, tasks }, session, tree: NTree (LNode { id }) _ } = do
eTask <- documentsFromWriteNodesReq session params eTask <- documentsFromWriteNodesReq session params
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[documentsFromWriteNodes]") errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
pure unit pure unit
refreshTree p refreshTree p
......
...@@ -29,10 +29,10 @@ import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), setting ...@@ -29,10 +29,10 @@ import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), setting
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList) import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
import Gargantext.Components.GraphExplorer.API as GraphAPI import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN)) import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Config.REST (logRESTError) import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
import Gargantext.Context.Progress (asyncContext, asyncProgress) import Gargantext.Context.Progress (asyncContext, asyncProgress)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoaderEffect) import Gargantext.Hooks.Loader (useLoader, useLoaderEffect)
import Gargantext.Hooks.Version (Version, useVersion) import Gargantext.Hooks.Version (Version, useVersion)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
...@@ -56,18 +56,17 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node" ...@@ -56,18 +56,17 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node"
-- Main Node -- Main Node
type NodeSpanProps = type NodeSpanProps =
( boxes :: Boxes ( dispatch :: Action -> Aff Unit
, dispatch :: Action -> Aff Unit
, folderOpen :: T.Box Boolean , folderOpen :: T.Box Boolean
, frontends :: Frontends , frontends :: Frontends
, id :: ID , id :: ID
, isBoxVisible :: T.Box Boolean
, isLeaf :: IsLeaf , isLeaf :: IsLeaf
, name :: Name , name :: Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, reload :: T2.ReloadS , reload :: T2.ReloadS
, root :: ID , root :: ID
, session :: Session , session :: Session
, isBoxVisible :: T.Box Boolean
) )
type IsLeaf = Boolean type IsLeaf = Boolean
...@@ -78,8 +77,7 @@ nodeSpan = R2.leaf nodeSpanCpt ...@@ -78,8 +77,7 @@ nodeSpan = R2.leaf nodeSpanCpt
nodeSpanCpt :: R.Component NodeSpanProps nodeSpanCpt :: R.Component NodeSpanProps
nodeSpanCpt = here.component "nodeSpan" cpt nodeSpanCpt = here.component "nodeSpan" cpt
where where
cpt props@{ boxes cpt props@{ dispatch
, dispatch
, folderOpen , folderOpen
, frontends , frontends
, id , id
...@@ -90,6 +88,7 @@ nodeSpanCpt = here.component "nodeSpan" cpt ...@@ -90,6 +88,7 @@ nodeSpanCpt = here.component "nodeSpan" cpt
, isBoxVisible , isBoxVisible
} _ = do } _ = do
-- States -- States
boxes <- AppStore.use
route' <- T.useLive T.unequal boxes.route route' <- T.useLive T.unequal boxes.route
-- only 1 popup at a time is allowed to be opened -- only 1 popup at a time is allowed to be opened
...@@ -331,7 +330,6 @@ nodeSpanCpt = here.component "nodeSpan" cpt ...@@ -331,7 +330,6 @@ nodeSpanCpt = here.component "nodeSpan" cpt
asyncProgress asyncProgress
{ asyncTask: task { asyncTask: task
, errors: boxes.errors
, nodeId: id , nodeId: id
, onFinish: onTaskFinish id task , onFinish: onTaskFinish id task
, session , session
...@@ -605,59 +603,66 @@ nodeActionsCpt = here.component "nodeActions" cpt where ...@@ -605,59 +603,66 @@ nodeActionsCpt = here.component "nodeActions" cpt where
graphNodeActions :: R2.Leaf NodeActionsCommon graphNodeActions :: R2.Leaf NodeActionsCommon
graphNodeActions = R2.leaf graphNodeActionsCpt graphNodeActions = R2.leaf graphNodeActionsCpt
graphNodeActionsCpt :: R.Component NodeActionsCommon graphNodeActionsCpt :: R.Component NodeActionsCommon
graphNodeActionsCpt = here.component "graphNodeActions" cpt where graphNodeActionsCpt = R2.hereComponent here "graphNodeActions" hCpt where
cpt { id, session, refresh } _ = do hCpt hp { id, refresh, session } _ = do
-- States
state /\ stateBox <- R2.useBox' Nothing
-- Hooks -- Hooks
useLoaderEffect useLoader
{ errorHandler { errorHandler: Nothing
, herePrefix: hp
, loader: graphVersions session , loader: graphVersions session
, path: id , path: id
, state: stateBox , render: \gv -> graphNodeActionsLoaded { gv, id, refresh, session }
} }
where
graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
-- Render type NodeActionsGraphLoaded =
pure $ R2.fromMaybe state \gv -> ( gv :: Record GraphAPI.GraphVersions
| NodeActionsCommon )
nodeActionsGraph
{ graphVersions: gv, session, id, refresh }
[]
graphVersions session graphId = GraphAPI.graphVersions { graphId, session } graphNodeActionsLoaded :: R2.Leaf NodeActionsGraphLoaded
errorHandler = logRESTError here "[graphNodeActions]" graphNodeActionsLoaded = R2.leaf graphNodeActionsLoadedCpt
graphNodeActionsLoadedCpt :: R.Component NodeActionsGraphLoaded
graphNodeActionsLoadedCpt = here.component "graphNodeActionsLoaded" cpt where
cpt { gv, id, refresh, session } _ = do
-- Render
pure $ nodeActionsGraph { graphVersions: gv
, id
, refresh
, session } []
listNodeActions :: R2.Leaf NodeActionsCommon listNodeActions :: R2.Leaf NodeActionsCommon
listNodeActions = R2.leaf listNodeActionsCpt listNodeActions = R2.leaf listNodeActionsCpt
listNodeActionsCpt :: R.Component NodeActionsCommon listNodeActionsCpt :: R.Component NodeActionsCommon
listNodeActionsCpt = here.component "listNodeActions" cpt where listNodeActionsCpt = R2.hereComponent here "listNodeActions" hCpt where
cpt { id, session, refresh } _ = do hCpt hp { id, refresh, session } _ = do
-- States
state /\ stateBox <- R2.useBox' Nothing
-- Hooks -- Hooks
useLoaderEffect useLoader
{ errorHandler { errorHandler: Nothing
, herePrefix: hp
, loader: loadCorpusWithChild , loader: loadCorpusWithChild
, path: { nodeId: id, session } , path: { nodeId: id, session }
, state: stateBox , render: \corpusData -> listNodeActionsLoaded { corpusData, id, refresh, session }
} }
-- Render type NodeActionsListLoaded =
pure $ R2.fromMaybe state \{ corpusId } -> ( corpusData :: CorpusData
| NodeActionsCommon )
nodeActionsNodeList
{ listId: id
, nodeId: corpusId
, session
, refresh: refresh
, nodeType: GT.TabNgramType GT.CTabTerms
}
where listNodeActionsLoaded :: R2.Leaf NodeActionsListLoaded
errorHandler = logRESTError here "[listNodeActions]" listNodeActionsLoaded = R2.leaf listNodeActionsLoadedCpt
listNodeActionsLoadedCpt :: R.Component NodeActionsListLoaded
listNodeActionsLoadedCpt = here.component "listNodeActionsLoaded" cpt where
cpt { corpusData: { corpusId }, id, refresh, session } _ = do
-- Render
pure $ nodeActionsNodeList { listId: id
, nodeId: corpusId
, nodeType: GT.TabNgramType GT.CTabTerms
, refresh
, session
}
----------------------------------------------- -----------------------------------------------
......
...@@ -37,12 +37,11 @@ linkNode = R.createElement linkNodeCpt ...@@ -37,12 +37,11 @@ linkNode = R.createElement linkNodeCpt
linkNodeCpt :: R.Component SubTreeParamsIn linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = here.component "linkNode" cpt linkNodeCpt = here.component "linkNode" cpt
where where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do cpt { dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing}) action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing})
pure $ pure $
linkNode' { action linkNode' { action
, boxes
, dispatch , dispatch
, id , id
, nodeType , nodeType
...@@ -61,7 +60,7 @@ linkNode' = R.createElement linkNodeCpt' ...@@ -61,7 +60,7 @@ linkNode' = R.createElement linkNodeCpt'
linkNodeCpt' :: R.Component Props linkNodeCpt' :: R.Component Props
linkNodeCpt' = here.component "__clone__" cpt linkNodeCpt' = here.component "__clone__" cpt
where where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams, action } _ = do cpt { dispatch, id, nodeType, session, subTreeParams, action } _ = do
action' <- T.useLive T.unequal action action' <- T.useLive T.unequal action
...@@ -78,7 +77,6 @@ linkNodeCpt' = here.component "__clone__" cpt ...@@ -78,7 +77,6 @@ linkNodeCpt' = here.component "__clone__" cpt
pure $ pure $
Tools.panel { mError: Nothing } Tools.panel { mError: Nothing }
[ subTreeView { action [ subTreeView { action
, boxes
, dispatch , dispatch
, id , id
, nodeType , nodeType
......
...@@ -7,11 +7,10 @@ import Data.Either (Either(..)) ...@@ -7,11 +7,10 @@ import Data.Either (Either(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (runAff_) import Effect.Aff (runAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.Forest.Tree.Node.Tools as Tools import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.GraphQL.Endpoints (deleteTeamMembership, getTeam) import Gargantext.Components.GraphQL.Endpoints (deleteTeamMembership, getTeam)
import Gargantext.Components.GraphQL.Team (Team, TeamMember) import Gargantext.Components.GraphQL.Team (Team, TeamMember)
import Gargantext.Config.REST (AffRESTError, logRESTError, FrontendError(EC_403__user_not_authorized)) import Gargantext.Config.REST (AffRESTError, FrontendError(EC_403__user_not_authorized))
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (ID, FrontendError(FRESTError), NodeType) import Gargantext.Types (ID, FrontendError(FRESTError), NodeType)
...@@ -24,8 +23,7 @@ here :: R2.Here ...@@ -24,8 +23,7 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.ManageTeam" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.ManageTeam"
type ActionManageTeam = ( type ActionManageTeam = (
boxes :: Boxes id :: ID
, id :: ID
, nodeType :: NodeType , nodeType :: NodeType
, session :: Session , session :: Session
) )
...@@ -33,9 +31,10 @@ type ActionManageTeam = ( ...@@ -33,9 +31,10 @@ type ActionManageTeam = (
actionManageTeam :: R2.Component ActionManageTeam actionManageTeam :: R2.Component ActionManageTeam
actionManageTeam = R.createElement actionManageTeamCpt actionManageTeam = R.createElement actionManageTeamCpt
actionManageTeamCpt :: R.Component ActionManageTeam actionManageTeamCpt :: R.Component ActionManageTeam
actionManageTeamCpt = here.component "actionManageTeam" cpt where actionManageTeamCpt = R2.hereComponent here "actionManageTeam" hCpt where
cpt { boxes: { errors }, id, session } _ = do hCpt hp { id, session } _ = do
useLoader { errorHandler: errorHandler errors useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadTeam , loader: loadTeam
, path: { nodeId: id, session } , path: { nodeId: id, session }
, render: \team -> teamLayoutWrapper { team , render: \team -> teamLayoutWrapper { team
...@@ -43,12 +42,6 @@ actionManageTeamCpt = here.component "actionManageTeam" cpt where ...@@ -43,12 +42,6 @@ actionManageTeamCpt = here.component "actionManageTeam" cpt where
, session , session
} [] } []
} }
where
errorHandler errors error = do
logRESTError here "teamLayout" error
T.modify_ (cons $ FRESTError { error }) errors
-- T.write_ (Just $ show error) errorS
type TeamProps = type TeamProps =
( nodeId :: ID ( nodeId :: ID
......
...@@ -28,7 +28,7 @@ mergeNode = R.createElement mergeNodeCpt ...@@ -28,7 +28,7 @@ mergeNode = R.createElement mergeNodeCpt
mergeNodeCpt :: R.Component SubTreeParamsIn mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = here.component "mergeNode" cpt mergeNodeCpt = here.component "mergeNode" cpt
where where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do cpt { dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (MergeNode { params: Nothing }) action <- T.useBox (MergeNode { params: Nothing })
action' <- T.useLive T.unequal action action' <- T.useLive T.unequal action
...@@ -44,7 +44,6 @@ mergeNodeCpt = here.component "mergeNode" cpt ...@@ -44,7 +44,6 @@ mergeNodeCpt = here.component "mergeNode" cpt
pure $ Tools.panel { mError: Nothing } pure $ Tools.panel { mError: Nothing }
[ subTreeView { action [ subTreeView { action
, boxes
, dispatch , dispatch
, id , id
, nodeType , nodeType
......
...@@ -30,19 +30,18 @@ moveNode = R.createElement moveNodeCpt ...@@ -30,19 +30,18 @@ moveNode = R.createElement moveNodeCpt
moveNodeCpt :: R.Component SubTreeParamsIn moveNodeCpt :: R.Component SubTreeParamsIn
moveNodeCpt = here.component "moveNode" cpt moveNodeCpt = here.component "moveNode" cpt
where where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do cpt { dispatch, id, nodeType, session, subTreeParams } _ = do
action :: T.Box Action <- T.useBox (MoveNode {params: Nothing}) action :: T.Box Action <- T.useBox (MoveNode {params: Nothing})
pure $ pure $
moveNode' { action moveNode' { action
, boxes , dispatch
, dispatch , id
, id , nodeType
, nodeType , session
, session , subTreeParams
, subTreeParams } []
} []
type Props = type Props =
( action :: T.Box Action ( action :: T.Box Action
...@@ -54,7 +53,7 @@ moveNode' :: R2.Component Props ...@@ -54,7 +53,7 @@ moveNode' :: R2.Component Props
moveNode' = R.createElement moveNodeCpt' moveNode' = R.createElement moveNodeCpt'
moveNodeCpt' :: R.Component Props moveNodeCpt' :: R.Component Props
moveNodeCpt' = here.component "__clone__" cpt where moveNodeCpt' = here.component "__clone__" cpt where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams, action } _ = do cpt { dispatch, id, nodeType, session, subTreeParams, action } _ = do
action' <- T.useLive T.unequal action action' <- T.useLive T.unequal action
...@@ -69,7 +68,6 @@ moveNodeCpt' = here.component "__clone__" cpt where ...@@ -69,7 +68,6 @@ moveNodeCpt' = here.component "__clone__" cpt where
Tools.panel { mError: Nothing } Tools.panel { mError: Nothing }
[ subTreeView { action [ subTreeView { action
, boxes
, dispatch , dispatch
, id , id
, nodeType , nodeType
......
...@@ -3,10 +3,11 @@ module Gargantext.Components.Forest.Tree.Node.Action.Search where ...@@ -3,10 +3,11 @@ module Gargantext.Components.Forest.Tree.Node.Action.Search where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe) import Data.Maybe (Maybe(..))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.App.Store as Store
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar) import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch) import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
...@@ -28,8 +29,7 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search" ...@@ -28,8 +29,7 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search"
type Props = type Props =
( boxes :: Boxes ( dispatch :: Action -> Aff Unit
, dispatch :: Action -> Aff Unit
, id :: Maybe ID , id :: Maybe ID
, session :: Session ) , session :: Session )
...@@ -37,17 +37,15 @@ type Props = ...@@ -37,17 +37,15 @@ type Props =
actionSearch :: R2.Component Props actionSearch :: R2.Component Props
actionSearch = R.createElement actionSearchCpt actionSearch = R.createElement actionSearchCpt
actionSearchCpt :: R.Component Props actionSearchCpt :: R.Component Props
actionSearchCpt = here.component "actionSearch" cpt where actionSearchCpt = R2.hereComponent here "actionSearch" hCpt where
cpt props@({ session }) _ = do hCpt hp props@({ session }) _ = do
useLoader { errorHandler { errors } <- Store.use
useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadLanguages , loader: loadLanguages
, path: { session } , path: { session }
, render: \langs -> , render: \langs ->
actionSearchWithLangs (Record.merge props { langs }) [] } actionSearchWithLangs (Record.merge props { langs }) [] }
where
errorHandler err = case err of
ReadJSONError err' -> here.warn2 "[actionSearch] ReadJSONError" $ show err'
_ -> here.warn2 "[actionSearch] RESTError" err
type PropsWithLangs = type PropsWithLangs =
( langs :: Array Lang ( langs :: Array Lang
...@@ -59,7 +57,8 @@ actionSearchWithLangs = R.createElement actionSearchWithLangsCpt ...@@ -59,7 +57,8 @@ actionSearchWithLangs = R.createElement actionSearchWithLangsCpt
actionSearchWithLangsCpt :: R.Component PropsWithLangs actionSearchWithLangsCpt :: R.Component PropsWithLangs
actionSearchWithLangsCpt = here.component "actionSearchWithLangs" cpt actionSearchWithLangsCpt = here.component "actionSearchWithLangs" cpt
where where
cpt { boxes: { errors }, dispatch, id, langs, session } _ = do cpt { dispatch, id, langs, session } _ = do
{ errors } <- Store.use
search <- T.useBox $ defaultSearch { node_id = id } search <- T.useBox $ defaultSearch { node_id = id }
pure $ R.fragment pure $ R.fragment
[ H.p { className: "action-search mx-2" } [ H.p { className: "action-search mx-2" }
......
...@@ -24,7 +24,6 @@ import Gargantext.Components.InputWithEnter (inputWithEnter) ...@@ -24,7 +24,6 @@ import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Lang (Lang(..)) import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.ListSelection as ListSelection import Gargantext.Components.ListSelection as ListSelection
import Gargantext.Components.ListSelection.Types as ListSelection import Gargantext.Components.ListSelection.Types as ListSelection
import Gargantext.Config.REST (logRESTError)
import Gargantext.Config.Utils (handleRESTError) import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session(..)) import Gargantext.Sessions (Session(..))
...@@ -129,14 +128,13 @@ type ComponentIMTProps = ...@@ -129,14 +128,13 @@ type ComponentIMTProps =
componentIMT :: R2.Component ComponentIMTProps componentIMT :: R2.Component ComponentIMTProps
componentIMT = R.createElement componentIMTCpt componentIMT = R.createElement componentIMTCpt
componentIMTCpt :: R.Component ComponentIMTProps componentIMTCpt :: R.Component ComponentIMTProps
componentIMTCpt = here.component "componentIMT" cpt where componentIMTCpt = R2.hereComponent here "componentIMT" hCpt where
cpt { search, session } _ = do hCpt hp { search, session } _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: \_ -> getIMTSchools session , loader: \_ -> getIMTSchools session
, path: unit , path: unit
, render: \schools -> componentWithIMTOrgs { schools, search } [] } , render: \schools -> componentWithIMTOrgs { schools, search } [] }
where
errorHandler = logRESTError here "[componentIMT]"
type ComponentWithIMTOrgsProps = type ComponentWithIMTOrgsProps =
( schools :: Array GQLIMT.School ( schools :: Array GQLIMT.School
...@@ -394,15 +392,14 @@ type PubmedInputProps = ( ...@@ -394,15 +392,14 @@ type PubmedInputProps = (
pubmedInput :: R2.Component PubmedInputProps pubmedInput :: R2.Component PubmedInputProps
pubmedInput = R.createElement pubmedInputCpt pubmedInput = R.createElement pubmedInputCpt
pubmedInputCpt :: R.Component PubmedInputProps pubmedInputCpt :: R.Component PubmedInputProps
pubmedInputCpt = here.component "pubmedInput" cpt where pubmedInputCpt = R2.hereComponent here "pubmedInput" hCpt where
cpt { search, session: session@(Session { treeId }) } _ = do hCpt hp { search, session: session@(Session { treeId }) } _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: \_ -> getUser session treeId , loader: \_ -> getUser session treeId
, path: unit , path: unit
, render: \user -> pubmedInputLoaded { pubmedAPIKey: user.u_hyperdata.pubmed_api_key , render: \user -> pubmedInputLoaded { pubmedAPIKey: user.u_hyperdata.pubmed_api_key
, search } [] } , search } [] }
where
errorHandler = logRESTError here "[pubmedInput]"
type PubmedInputLoadedProps = ( type PubmedInputLoadedProps = (
...@@ -447,16 +444,15 @@ type EPOInputProps = ( ...@@ -447,16 +444,15 @@ type EPOInputProps = (
epoInput :: R2.Component EPOInputProps epoInput :: R2.Component EPOInputProps
epoInput = R.createElement epoInputCpt epoInput = R.createElement epoInputCpt
epoInputCpt :: R.Component EPOInputProps epoInputCpt :: R.Component EPOInputProps
epoInputCpt = here.component "epoInput" cpt where epoInputCpt = R2.hereComponent here "epoInput" hCpt where
cpt { search, session: session@(Session { treeId }) } _ = do hCpt hp { search, session: session@(Session { treeId }) } _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: \_ -> getUser session treeId , loader: \_ -> getUser session treeId
, path: unit , path: unit
, render: \user -> epoInputLoaded { epoAPIUser: user.u_hyperdata.epo_api_user , render: \user -> epoInputLoaded { epoAPIUser: user.u_hyperdata.epo_api_user
, epoAPIToken: user.u_hyperdata.epo_api_token , epoAPIToken: user.u_hyperdata.epo_api_token
, search } [] } , search } [] }
where
errorHandler = logRESTError here "[epoInput]"
type EPOInputLoadedProps = ( type EPOInputLoadedProps = (
...@@ -713,9 +709,10 @@ triggerSearch { onSearch, errors, session, selection, search } = ...@@ -713,9 +709,10 @@ triggerSearch { onSearch, errors, session, selection, search } =
Just id -> do Just id -> do
-- liftEffect $ here.log2 "[triggerSearch] searchQuery" $ searchQuery selection search -- liftEffect $ here.log2 "[triggerSearch] searchQuery" $ searchQuery selection search
eTask <- performSearch session id $ searchQuery selection search eTask <- performSearch session id $ searchQuery selection search
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[triggerSearch]") errors eTask $
-- here.log2 "[triggerSearch] task" task \task -> liftEffect $ do
onSearch task -- here.log2 "[triggerSearch] task" task
onSearch task
--liftEffect $ do --liftEffect $ do
-- log2 "Return:" r -- log2 "Return:" r
......
...@@ -18,7 +18,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Types as Action ...@@ -18,7 +18,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Types as Action
import Gargantext.Components.Forest.Tree.Node.Tools as Tools import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Components.InputWithAutocomplete (inputWithAutocomplete) import Gargantext.Components.InputWithAutocomplete (inputWithAutocomplete)
import Gargantext.Config.REST (AffRESTError, logRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, post) import Gargantext.Sessions (Session, get, post)
...@@ -65,17 +65,14 @@ type ShareNode = ...@@ -65,17 +65,14 @@ type ShareNode =
shareNode :: R2.Component ShareNode shareNode :: R2.Component ShareNode
shareNode = R.createElement shareNodeCpt shareNode = R.createElement shareNodeCpt
shareNodeCpt :: R.Component ShareNode shareNodeCpt :: R.Component ShareNode
shareNodeCpt = here.component "shareNode" cpt shareNodeCpt = R2.hereComponent here "shareNode" hCpt where
where hCpt hp { id, session } _ = do
cpt { id, session } _ = do useLoader { errorHandler: Nothing
useLoader { , herePrefix: hp
loader: getCompletionsReq , loader: getCompletionsReq
, path: { session } , path: { session }
, render: \completions -> shareNodeInner { completions, id, session } [] , render: \completions -> shareNodeInner { completions, id, session } []
, errorHandler }
}
where
errorHandler = logRESTError here "[shareNode]"
type ShareNodeInner = type ShareNodeInner =
( completions :: Array String ( completions :: Array String
...@@ -129,7 +126,7 @@ publishNode = R.createElement publishNodeCpt ...@@ -129,7 +126,7 @@ publishNode = R.createElement publishNodeCpt
publishNodeCpt :: R.Component SubTreeParamsIn publishNodeCpt :: R.Component SubTreeParamsIn
publishNodeCpt = here.component "publishNode" cpt publishNodeCpt = here.component "publishNode" cpt
where where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do cpt { dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (Action.SharePublic { params: Nothing }) action <- T.useBox (Action.SharePublic { params: Nothing })
action' <- T.useLive T.unequal action action' <- T.useLive T.unequal action
...@@ -142,7 +139,6 @@ publishNodeCpt = here.component "publishNode" cpt ...@@ -142,7 +139,6 @@ publishNodeCpt = here.component "publishNode" cpt
pure $ Tools.panel { mError: Nothing } pure $ Tools.panel { mError: Nothing }
[ subTreeView { action [ subTreeView { action
, boxes
, dispatch , dispatch
, id , id
, nodeType , nodeType
......
...@@ -106,17 +106,14 @@ type UploadFile = ...@@ -106,17 +106,14 @@ type UploadFile =
uploadFileView :: R2.Leaf Props uploadFileView :: R2.Leaf Props
uploadFileView = R2.leaf uploadFileViewCpt uploadFileView = R2.leaf uploadFileViewCpt
uploadFileViewCpt :: R.Component Props uploadFileViewCpt :: R.Component Props
uploadFileViewCpt = here.component "uploadFileView" cpt where uploadFileViewCpt = R2.hereComponent here "uploadFileView" hCpt where
cpt props@({ session }) _ = do hCpt hp props@({ session }) _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadLanguages , loader: loadLanguages
, path: { session } , path: { session }
, render: \langs -> , render: \langs ->
uploadFileViewWithLangs (Record.merge props { langs }) } uploadFileViewWithLangs (Record.merge props { langs }) }
where
errorHandler err = case err of
ReadJSONError err' -> here.warn2 "[uploadFileView] ReadJSONError" $ show err'
_ -> here.warn2 "[uploadFileView] RESTError" err
type PropsWithLangs = type PropsWithLangs =
( langs :: Array Lang ( langs :: Array Lang
...@@ -734,17 +731,14 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt ...@@ -734,17 +731,14 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt
uploadFrameCalcView :: R2.Component Props uploadFrameCalcView :: R2.Component Props
uploadFrameCalcView = R.createElement uploadFrameCalcViewCpt uploadFrameCalcView = R.createElement uploadFrameCalcViewCpt
uploadFrameCalcViewCpt :: R.Component Props uploadFrameCalcViewCpt :: R.Component Props
uploadFrameCalcViewCpt = here.component "uploadFrameCalcView" cpt where uploadFrameCalcViewCpt = R2.hereComponent here "uploadFrameCalcView" hCpt where
cpt props@({ session }) _ = do hCpt hp props@({ session }) _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadLanguages , loader: loadLanguages
, path: { session } , path: { session }
, render: \langs -> , render: \langs ->
uploadFileViewWithLangs (Record.merge props { langs }) } uploadFileViewWithLangs (Record.merge props { langs }) }
where
errorHandler err = case err of
ReadJSONError err' -> here.warn2 "[uploadFileView] ReadJSONError" $ show err'
_ -> here.warn2 "[uploadFileView] RESTError" err
uploadFrameCalcViewWithLangs :: R2.Component PropsWithLangs uploadFrameCalcViewWithLangs :: R2.Component PropsWithLangs
uploadFrameCalcViewWithLangs = R.createElement uploadFrameCalcViewWithLangsCpt uploadFrameCalcViewWithLangs = R.createElement uploadFrameCalcViewWithLangsCpt
......
...@@ -7,7 +7,7 @@ import Data.Either (Either) ...@@ -7,7 +7,7 @@ import Data.Either (Either)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Utils (loadLanguages) import Gargantext.Components.Forest.Tree.Node.Action.Utils (loadLanguages)
...@@ -32,25 +32,22 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocument ...@@ -32,25 +32,22 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocument
-- | Action : WriteNodesDocuments -- | Action : WriteNodesDocuments
type ActionWriteNodesDocuments = type ActionWriteNodesDocuments =
( boxes :: Boxes ( dispatch :: Action -> Aff Unit
, dispatch :: Action -> Aff Unit
, id :: GT.ID , id :: GT.ID
, session :: Session ) , session :: Session )
actionWriteNodesDocuments :: R2.Component ActionWriteNodesDocuments actionWriteNodesDocuments :: R2.Component ActionWriteNodesDocuments
actionWriteNodesDocuments = R.createElement actionWriteNodesDocumentsCpt actionWriteNodesDocuments = R.createElement actionWriteNodesDocumentsCpt
actionWriteNodesDocumentsCpt :: R.Component ActionWriteNodesDocuments actionWriteNodesDocumentsCpt :: R.Component ActionWriteNodesDocuments
actionWriteNodesDocumentsCpt = here.component "actionWriteNodesDocuments" cpt where actionWriteNodesDocumentsCpt = R2.hereComponent here "actionWriteNodesDocuments" hCpt where
cpt props@({ session }) _ = do hCpt hp props@({ session }) _ = do
useLoader { errorHandler { errors } <- Store.use
useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadLanguages , loader: loadLanguages
, path: { session } , path: { session }
, render: \langs -> , render: \langs ->
actionWriteNodesDocumentsWithLangs (Record.merge props { langs }) [] } actionWriteNodesDocumentsWithLangs (Record.merge props { langs }) [] }
where
errorHandler err = case err of
ReadJSONError err' -> here.warn2 "[actionSearch] ReadJSONError" $ show err'
_ -> here.warn2 "[actionSearch] RESTError" err
type ActionWriteNodesDocumentsWithLangs = type ActionWriteNodesDocumentsWithLangs =
( langs :: Array Lang ( langs :: Array Lang
......
...@@ -344,27 +344,27 @@ panelActionCpt = here.component "panelAction" cpt ...@@ -344,27 +344,27 @@ panelActionCpt = here.component "panelAction" cpt
pure $ actionDoc { nodeType } [] pure $ actionDoc { nodeType } []
cpt { action: Download, id, nodeType, session} _ = cpt { action: Download, id, nodeType, session} _ =
pure $ actionDownload { id, nodeType, session } [] pure $ actionDownload { id, nodeType, session } []
cpt { action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ = cpt { action: Link {subTreeParams}, dispatch, id, nodeType, session } _ =
pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } [] pure $ linkNode { dispatch, id, nodeType, session, subTreeParams } []
cpt { action: ManageTeam, boxes, nodeType, id, session} _ = cpt { action: ManageTeam, nodeType, id, session} _ =
pure $ actionManageTeam { boxes, id, nodeType, session } [] pure $ actionManageTeam { id, nodeType, session } []
cpt { action: Merge {subTreeParams}, boxes, dispatch, id, nodeType, session } _ = cpt { action: Merge {subTreeParams}, dispatch, id, nodeType, session } _ =
pure $ mergeNode { boxes, dispatch, id, nodeType, session, subTreeParams } [] pure $ mergeNode { dispatch, id, nodeType, session, subTreeParams } []
cpt { action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ = cpt { action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ moveNode { boxes, dispatch, id, nodeType, session, subTreeParams } [] pure $ moveNode { dispatch, id, nodeType, session, subTreeParams } []
cpt { action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ = cpt { action : Publish {subTreeParams}, dispatch, id, nodeType, session } _ =
pure $ Share.publishNode { boxes, dispatch, id, nodeType, session, subTreeParams } [] pure $ Share.publishNode { dispatch, id, nodeType, session, subTreeParams } []
cpt { action: Reconstruct , dispatch, nodeType } _ = cpt { action: Reconstruct , dispatch, nodeType } _ =
pure $ update { dispatch, nodeType } [] pure $ update { dispatch, nodeType } []
cpt { action: Refresh , dispatch, nodeType } _ = cpt { action: Refresh , dispatch, nodeType } _ =
pure $ update { dispatch, nodeType } [] pure $ update { dispatch, nodeType } []
cpt { action: ReloadWithSettings , dispatch, nodeType } _ = cpt { action: ReloadWithSettings , dispatch, nodeType } _ =
pure $ update { dispatch, nodeType } [] pure $ update { dispatch, nodeType } []
cpt { action: SearchBox, boxes, dispatch, id, session } _ = cpt { action: SearchBox, dispatch, id, session } _ =
pure $ actionSearch { boxes, dispatch, id: Just id, session } [] pure $ actionSearch { dispatch, id: Just id, session } []
cpt { action : Share, id, session } _ = pure $ Share.shareNode { id, session } [] cpt { action : Share, id, session } _ = pure $ Share.shareNode { id, session } []
cpt { action: Upload, dispatch, id, nodeType, session} _ = cpt { action: Upload, dispatch, id, nodeType, session} _ =
pure $ actionUpload { dispatch, id, nodeType, session } [] pure $ actionUpload { dispatch, id, nodeType, session } []
cpt { action: WriteNodesDocuments, boxes, dispatch, id, session } _ = cpt { action: WriteNodesDocuments, dispatch, id, session } _ =
pure $ actionWriteNodesDocuments { boxes, dispatch, id, session } [] pure $ actionWriteNodesDocuments { dispatch, id, session } []
cpt _ _ = pure $ H.div {} [] cpt _ _ = pure $ H.div {} []
...@@ -8,6 +8,7 @@ import Effect (Effect) ...@@ -8,6 +8,7 @@ import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Timer (clearInterval, setInterval) import Effect.Timer (clearInterval, setInterval)
import Gargantext.Components.App.Store as AppStore
import Gargantext.Config.REST (AffRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError) import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
...@@ -29,7 +30,6 @@ data BarType = Bar | Pie ...@@ -29,7 +30,6 @@ data BarType = Bar | Pie
type Props = ( type Props = (
asyncTask :: GT.AsyncTaskWithType asyncTask :: GT.AsyncTaskWithType
, barType :: BarType , barType :: BarType
, errors :: T.Box (Array FrontendError)
, nodeId :: GT.ID , nodeId :: GT.ID
, onFinish :: Unit -> Effect Unit , onFinish :: Unit -> Effect Unit
, session :: Session , session :: Session
...@@ -39,22 +39,23 @@ type Props = ( ...@@ -39,22 +39,23 @@ type Props = (
asyncProgressBar :: R2.Component Props asyncProgressBar :: R2.Component Props
asyncProgressBar = R.createElement asyncProgressBarCpt asyncProgressBar = R.createElement asyncProgressBarCpt
asyncProgressBarCpt :: R.Component Props asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = here.component "asyncProgressBar" cpt asyncProgressBarCpt = R2.hereComponent here "asyncProgressBar" hCpt where
where hCpt hp props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
cpt props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}}) , barType
, barType , onFinish
, errors } _ = do
, onFinish { errors } <- AppStore.use
} _ = do
progress <- T.useBox 0.0 progress <- T.useBox 0.0
intervalIdRef <- R.useRef Nothing intervalIdRef <- R.useRef Nothing
R.useEffectOnce' $ do R.useEffectOnce' $ do
intervalId <- setInterval 1000 $ do intervalId <- setInterval 1000 $ do
launchAff_ $ do launchAff_ $ do
let rdata = (RX.pick props :: Record QueryProgressData) let rdata = (RX.pick props :: Record QueryProgressData)
eAsyncProgress <- queryProgress rdata eAsyncProgress <- queryProgress rdata
handleRESTError here errors eAsyncProgress $ \asyncProgress -> liftEffect $ do handleRESTError hp errors eAsyncProgress $
\asyncProgress -> liftEffect $ do
let GT.AsyncProgress { status } = asyncProgress let GT.AsyncProgress { status } = asyncProgress
T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
...@@ -66,12 +67,12 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt ...@@ -66,12 +67,12 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt
else else
pure unit pure unit
R.setRef intervalIdRef $ Just intervalId R.setRef intervalIdRef $ Just intervalId
pure unit pure unit
pure $ progressIndicator { barType, label: id, progress } pure $ progressIndicator { barType, label: id, progress }
-------------------------------------------------------------- --------------------------------------------------------------
......
...@@ -7,12 +7,12 @@ import Data.Array as A ...@@ -7,12 +7,12 @@ import Data.Array as A
import Data.Foldable (intercalate) import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.Forest.Tree.Node.Action (Props, subTreeOut, setTreeOut) import Gargantext.Components.Forest.Tree.Node.Action (Props, subTreeOut, setTreeOut)
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action) import Gargantext.Components.Forest.Tree.Node.Action.Types (Action)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..)) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
import Gargantext.Config.REST (AffRESTError, logRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), get) import Gargantext.Sessions (Session(..), get)
...@@ -28,8 +28,7 @@ here :: R2.Here ...@@ -28,8 +28,7 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree" here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree"
type SubTreeParamsIn = type SubTreeParamsIn =
( boxes :: Boxes ( subTreeParams :: SubTreeParams
, subTreeParams :: SubTreeParams
| Props | Props
) )
...@@ -42,36 +41,32 @@ type SubTreeParamsProps = ...@@ -42,36 +41,32 @@ type SubTreeParamsProps =
subTreeView :: R2.Component SubTreeParamsProps subTreeView :: R2.Component SubTreeParamsProps
subTreeView = R.createElement $ R.memo' subTreeViewCpt subTreeView = R.createElement $ R.memo' subTreeViewCpt
subTreeViewCpt :: R.Component SubTreeParamsProps subTreeViewCpt :: R.Component SubTreeParamsProps
subTreeViewCpt = here.component "subTreeView" cpt subTreeViewCpt = R2.hereComponent here "subTreeView" hCpt where
where hCpt hp { action
cpt { action , dispatch
, boxes , id
, dispatch , nodeType
, id , session
, nodeType , subTreeParams
, session } _ = do
, subTreeParams let
} _ = do SubTreeParams {showtypes} = subTreeParams
let -- (valAction /\ setAction) = action
SubTreeParams {showtypes} = subTreeParams -- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
-- (valAction /\ setAction) = action
-- _ <- pure $ setAction (const $ setTreeOut valAction Nothing) useLoader { errorHandler: Nothing
, herePrefix: hp
useLoader { errorHandler , loader: loadSubTree showtypes
, loader: loadSubTree showtypes , path: session
, path: session , render: \tree ->
, render: \tree -> subTreeViewLoaded { action
subTreeViewLoaded { action , dispatch
, boxes , id
, dispatch , nodeType
, id , session
, nodeType , subTreeParams
, session , tree
, subTreeParams } [] }
, tree
} [] }
where
errorHandler = logRESTError here "[subTreeView]"
loadSubTree :: Array GT.NodeType -> Session -> AffRESTError FTree loadSubTree :: Array GT.NodeType -> Session -> AffRESTError FTree
loadSubTree nodetypes session = getSubTree session treeId nodetypes loadSubTree nodetypes session = getSubTree session treeId nodetypes
......
...@@ -3,7 +3,7 @@ module Gargantext.Components.ForgotPassword where ...@@ -3,7 +3,7 @@ module Gargantext.Components.ForgotPassword where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.Config.REST (AffRESTError, logRESTError, get) import Gargantext.Config.REST (AffRESTError, get)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
...@@ -16,11 +16,11 @@ type ForgotPasswordProps = ( server :: String, uuid :: String ) ...@@ -16,11 +16,11 @@ type ForgotPasswordProps = ( server :: String, uuid :: String )
forgotPasswordLayout :: R2.Component ForgotPasswordProps forgotPasswordLayout :: R2.Component ForgotPasswordProps
forgotPasswordLayout = R.createElement forgotPasswordLayoutCpt forgotPasswordLayout = R.createElement forgotPasswordLayoutCpt
forgotPasswordLayoutCpt :: R.Component ForgotPasswordProps forgotPasswordLayoutCpt :: R.Component ForgotPasswordProps
forgotPasswordLayoutCpt = here.component "forgotPasswordLayout" cpt where forgotPasswordLayoutCpt = R2.hereComponent here "forgotPasswordLayout" hCpt where
cpt { server, uuid } _ = do hCpt hp { server, uuid } _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadPassword , loader: loadPassword
, path: { server, uuid } , path: { server, uuid }
, render: \{ password } -> , render: \{ password } ->
...@@ -28,8 +28,6 @@ forgotPasswordLayoutCpt = here.component "forgotPasswordLayout" cpt where ...@@ -28,8 +28,6 @@ forgotPasswordLayoutCpt = here.component "forgotPasswordLayout" cpt where
H.div {className: "row"} [ H.div {className: "mx-auto"} [ H.img { src: "images/logo.png" } ] ] H.div {className: "row"} [ H.div {className: "mx-auto"} [ H.img { src: "images/logo.png" } ] ]
, H.div {className: "row"} [ H.div {className: "col"} [ H.text ("Your new password is: " <> password) ] ] , H.div {className: "row"} [ H.div {className: "col"} [ H.text ("Your new password is: " <> password) ] ]
]} ]}
where
errorHandler = logRESTError here "[forgotPasswordLayout]"
------------------------------------ ------------------------------------
......
...@@ -36,11 +36,11 @@ type Props = ...@@ -36,11 +36,11 @@ type Props =
docFocus :: R2.Leaf ( key :: String | Props ) docFocus :: R2.Leaf ( key :: String | Props )
docFocus = R2.leaf docFocusCpt docFocus = R2.leaf docFocusCpt
docFocusCpt :: R.Component ( key :: String | Props ) docFocusCpt :: R.Component ( key :: String | Props )
docFocusCpt = here.component "main" cpt where docFocusCpt = R2.hereComponent here "main" hCpt where
cpt { graphSideDoc: GraphSideDoc { docId, listId, corpusId } hCpt hp { graphSideDoc: GraphSideDoc { docId, listId, corpusId }
, session , session
, closeCallback , closeCallback
} _ = do } _ = do
-- | States -- | States
-- | -- |
state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData) state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
...@@ -64,7 +64,7 @@ docFocusCpt = here.component "main" cpt where ...@@ -64,7 +64,7 @@ docFocusCpt = here.component "main" cpt where
-- | Hooks -- | Hooks
-- | -- |
useLoaderEffect useLoaderEffect
{ errorHandler: logRESTError here "[docFocus]" { errorHandler: logRESTError hp
, loader: loadData , loader: loadData
, path , path
, state , state
......
...@@ -62,8 +62,7 @@ layoutCpt = here.component "layout" cpt where ...@@ -62,8 +62,7 @@ layoutCpt = here.component "layout" cpt where
} _ = do } _ = do
-- | States -- | States
-- | -- |
{ reloadForest { reloadForest } <- AppStore.use
} <- AppStore.use
{ showSidebar { showSidebar
, showDoc , showDoc
......
...@@ -63,7 +63,7 @@ drawGraphCpt = here.component "drawGraph" cpt where ...@@ -63,7 +63,7 @@ drawGraphCpt = here.component "drawGraph" cpt where
, forceAtlas2Settings: fa2Settings , forceAtlas2Settings: fa2Settings
} _ = do } _ = do
boxes <- AppStore.use { theme } <- AppStore.use
{ edgeConfluence { edgeConfluence
, edgeWeight , edgeWeight
...@@ -116,12 +116,12 @@ drawGraphCpt = here.component "drawGraph" cpt where ...@@ -116,12 +116,12 @@ drawGraphCpt = here.component "drawGraph" cpt where
case Sigmax.readSigma rSigma of case Sigmax.readSigma rSigma of
Nothing -> do Nothing -> do
theme <- T.read boxes.theme theme' <- T.read theme
eSigma <- case R.readNullableRef elRef of eSigma <- case R.readNullableRef elRef of
Nothing -> do Nothing -> do
_ <- ECC.error "elRef is empty" _ <- ECC.error "elRef is empty"
pure $ Left "elRef is empty" pure $ Left "elRef is empty"
Just el -> Sigma.sigma el { settings: sigmaSettings theme } Just el -> Sigma.sigma el { settings: sigmaSettings theme' }
case eSigma of case eSigma of
Left err -> here.warn2 "[drawGraph] error creating sigma" err Left err -> here.warn2 "[drawGraph] error creating sigma" err
Right sig -> do Right sig -> do
......
...@@ -637,7 +637,6 @@ type UpdateTermButtonProps = ...@@ -637,7 +637,6 @@ type UpdateTermButtonProps =
updateTermButton :: R2.Component UpdateTermButtonProps updateTermButton :: R2.Component UpdateTermButtonProps
updateTermButton = R2.component updateTermButtonCpt updateTermButton = R2.component updateTermButtonCpt
updateTermButtonCpt :: R.Component UpdateTermButtonProps updateTermButtonCpt :: R.Component UpdateTermButtonProps
updateTermButtonCpt = here.component "updateTermButton" cpt where updateTermButtonCpt = here.component "updateTermButton" cpt where
cpt { variant cpt { variant
......
...@@ -104,8 +104,13 @@ parseGQLJson json = ...@@ -104,8 +104,13 @@ parseGQLJson json =
Nothing -> REST.CustomError "[gqlQuery] empty 'graphQLErrors'" Nothing -> REST.CustomError "[gqlQuery] empty 'graphQLErrors'"
Just gqlErr -> case gqlErr .? "extensions" of Just gqlErr -> case gqlErr .? "extensions" of
Nothing -> REST.CustomError "[gqlQuery] graphQLError no 'extensions'" Nothing -> REST.CustomError "[gqlQuery] graphQLError no 'extensions'"
Just ext -> case (Foreign.unsafeToForeign >>> JSON.read >>> lmap toJsonError $ ext) of Just ext -> case (Foreign.unsafeToForeign >>> JSON.read $ ext) of
Left err' -> REST.CustomError $ "[gqlQuery] error reading 'extensions': " <> show err' Left _err -> do
-- OK so maybe we don't have "type" in error, try to parse the message only
case (Foreign.unsafeToForeign >>> JSON.read $ gqlErr :: Either Foreign.MultipleErrors { message :: String }) of
Left err' ->
REST.CustomError $ "[gqlQuery] don't know how to parse error: " <> show err'
Right { message } -> REST.CustomError message
Right err' -> REST.FE err' Right err' -> REST.FE err'
where where
decodeFn = Foreign.unsafeToForeign >>> JSON.read >>> lmap toJsonError decodeFn = Foreign.unsafeToForeign >>> JSON.read >>> lmap toJsonError
......
...@@ -20,7 +20,7 @@ import Gargantext.Components.GraphQL.Team (Team, teamQuery) ...@@ -20,7 +20,7 @@ import Gargantext.Components.GraphQL.Team (Team, teamQuery)
import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, treeFirstLevelQuery, BreadcrumbInfo, breadcrumbQuery) import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, treeFirstLevelQuery, BreadcrumbInfo, breadcrumbQuery)
import Gargantext.Components.GraphQL.User (UserInfo, userInfoQuery, User, userQuery) import Gargantext.Components.GraphQL.User (UserInfo, userInfoQuery, User, userQuery)
import Gargantext.Components.Lang (Lang) import Gargantext.Components.Lang (Lang)
import Gargantext.Config.REST (RESTError(..), AffRESTError, logRESTError) import Gargantext.Config.REST (RESTError(..), AffRESTError)
import Gargantext.Core.NgramsTable.Types (NgramsTerm(..)) import Gargantext.Core.NgramsTable.Types (NgramsTerm(..))
import Gargantext.Sessions (Session(..)) import Gargantext.Sessions (Session(..))
import Gargantext.Types (CorpusId, NodeType) import Gargantext.Types (CorpusId, NodeType)
...@@ -215,7 +215,7 @@ getLanguages session = do ...@@ -215,7 +215,7 @@ getLanguages session = do
Right { languages } -> do Right { languages } -> do
liftEffect $ here.log2 "[getLanguages] languages" languages liftEffect $ here.log2 "[getLanguages] languages" languages
pure $ Right $ Map.fromFoldable $ (\{ key, value } -> Tuple key value) <$> languages pure $ Right $ Map.fromFoldable $ (\{ lt_lang, lt_server } -> Tuple lt_lang lt_server) <$> languages
getContextNgrams :: Session -> Int -> Int -> AffRESTError (Array NgramsTerm) getContextNgrams :: Session -> Int -> Int -> AffRESTError (Array NgramsTerm)
getContextNgrams session context_id list_id = do getContextNgrams session context_id list_id = do
......
...@@ -14,13 +14,13 @@ type LanguageProperties ...@@ -14,13 +14,13 @@ type LanguageProperties
} }
type Language type Language
= { key :: Lang = { lt_lang :: Lang
, value :: LanguageProperties } , lt_server :: LanguageProperties }
type NLPQuery = type NLPQuery =
{ languages :: { languages ::
{ key :: Unit { lt_lang :: Unit
, value :: { , lt_server :: {
url :: Unit url :: Unit
, server :: Unit } , server :: Unit }
} }
...@@ -28,8 +28,8 @@ type NLPQuery = ...@@ -28,8 +28,8 @@ type NLPQuery =
nlpQuery :: NLPQuery nlpQuery :: NLPQuery
nlpQuery = { languages: nlpQuery = { languages:
{ key : unit { lt_lang : unit
, value : { , lt_server : {
url : unit url : unit
, server: unit } , server: unit }
} }
......
...@@ -114,22 +114,21 @@ type LangSwitcherProps = ( ...@@ -114,22 +114,21 @@ type LangSwitcherProps = (
langSwitcher :: R2.Component LangSwitcherProps langSwitcher :: R2.Component LangSwitcherProps
langSwitcher = R.createElement langSwitcherCpt langSwitcher = R.createElement langSwitcherCpt
langSwitcherCpt :: R.Component LangSwitcherProps langSwitcherCpt :: R.Component LangSwitcherProps
langSwitcherCpt = here.component "langSwitcher" cpt langSwitcherCpt = here.component "langSwitcher" cpt where
where cpt { lang, langs} _ = do
cpt { lang, langs} _ = do currentLang <- T.useLive T.unequal lang
currentLang <- T.useLive T.unequal lang let option l = H.option { value: show l} [ H.text $ show l]
let option l = H.option { value: show l} [ H.text $ show l] let options = map option langs
let options = map option langs
pure $ R2.select { className: "form-control"
pure $ R2.select { className: "form-control" , defaultValue: show currentLang
, defaultValue: show currentLang , on: {change: onChange lang } } options
, on: {change: onChange lang } } options where
where onChange box e = do
onChange box e = do let value = R.unsafeEventValue e
let value = R.unsafeEventValue e let mLang = A.head $ A.filter (\l -> value == show l) langs
let mLang = A.head $ A.filter (\l -> value == show l) langs
case mLang of
case mLang of Nothing -> pure unit
Nothing -> pure unit Just l -> do
Just l -> do T.write_ l box
T.write_ l box
...@@ -117,9 +117,10 @@ type ListTreeChildrenProps = ...@@ -117,9 +117,10 @@ type ListTreeChildrenProps =
listTreeChildren :: R2.Component ListTreeChildrenProps listTreeChildren :: R2.Component ListTreeChildrenProps
listTreeChildren = R.createElement listTreeChildrenCpt listTreeChildren = R.createElement listTreeChildrenCpt
listTreeChildrenCpt :: R.Component ListTreeChildrenProps listTreeChildrenCpt :: R.Component ListTreeChildrenProps
listTreeChildrenCpt = here.component "listTreeChildren" cpt where listTreeChildrenCpt = R2.hereComponent here "listTreeChildren" hCpt where
cpt { render, root, selection, session } _ = do hCpt hp { render, root, selection, session } _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadTreeChildren , loader: loadTreeChildren
, path: { root, session } , path: { root, session }
, render: \loaded -> , render: \loaded ->
...@@ -128,10 +129,6 @@ listTreeChildrenCpt = here.component "listTreeChildren" cpt where ...@@ -128,10 +129,6 @@ listTreeChildrenCpt = here.component "listTreeChildren" cpt where
, root , root
, selection , selection
, session } [] } , session } [] }
where
errorHandler err = case err of
ReadJSONError err' -> here.warn2 "[listTreeChildren] ReadJSONError" $ show err'
_ -> here.warn2 "[listTreeChildren] RESTError" err
type ListTreeChildrenLoadedProps = type ListTreeChildrenLoadedProps =
( loaded :: Array NodeSimple ( loaded :: Array NodeSimple
......
...@@ -17,15 +17,13 @@ type Props = ...@@ -17,15 +17,13 @@ type Props =
loadingSpinner :: Record Props -> R.Element loadingSpinner :: Record Props -> R.Element
loadingSpinner props = R.createElement loadingSpinnerCpt props [] loadingSpinner props = R.createElement loadingSpinnerCpt props []
loadingSpinnerCpt :: R.Component Props loadingSpinnerCpt :: R.Component Props
loadingSpinnerCpt = here.component "LoadingSpinner" cpt loadingSpinnerCpt = here.component "LoadingSpinner" cpt where
where -- cpt _ _ = H.i {className: "spinner fa fa-smile-o fa-spin fa-3x fa-fw"} [H.text ""]
-- cpt _ _ = H.i {className: "spinner fa fa-smile-o fa-spin fa-3x fa-fw"} [H.text ""] -- cpt _ _ = H.i {className: "fa fa-globe fa-spin fa-3x fa-fw"} [H.text ""]
-- cpt _ _ = H.i {className: "fa fa-globe fa-spin fa-3x fa-fw"} [H.text ""]
-- cpt _ _ = H.i {className: "fa fa-circle-o-notch fa-spin fa-3x fa-fw"} [H.text ""]
-- cpt _ _ = H.i {className: "fa fa-circle-o-notch fa-spin fa-3x fa-fw"} [H.text ""] cpt { additionalClass } _ = do
cpt { additionalClass } _ = do pure $ H.i { className: "fa fa-spinner fa-pulse fa-3x fa-fw " <> c } [H.text ""]
pure $ H.i { className: "fa fa-spinner fa-pulse fa-3x fa-fw " <> c } [H.text ""] where
where c = fromMaybe "" additionalClass
c = fromMaybe "" additionalClass
...@@ -23,20 +23,18 @@ type Props = ( setVisible :: R.Setter Boolean ) ...@@ -23,20 +23,18 @@ type Props = ( setVisible :: R.Setter Boolean )
modal :: R2.Component Props modal :: R2.Component Props
modal = R.createElement modalCpt modal = R.createElement modalCpt
modalCpt :: R.Component Props modalCpt :: R.Component Props
modalCpt = here.component "modal" cpt modalCpt = R2.hereComponent here "modal" hCpt where
where hCpt _hp {setVisible} children = do
cpt {setVisible} children = do host <- R2.getPortalHost
host <- R2.getPortalHost root <- R.useRef null -- used to close when user clicks outside
root <- R.useRef null -- used to close when user clicks outside R2.useLayoutEffectOnce $ modalEffect root setVisible
R2.useLayoutEffectOnce $ modalEffect root setVisible pure $ R.createPortal
pure $ R.createPortal [ H.div { ref: root, className: "modal", data: {toggle: "popover", placement: "right"}}
[ H.div { ref: root, className: "modal", data: {toggle: "popover", placement: "right"}} [ H.div { className: "popover-content" }
[ H.div { className: "popover-content" } [ H.div { className: "card" }
[ H.div { className: "card" } [ H.ul { className: "list-group" } children ]]]]
[ H.ul { className: "list-group" } children ]]]] host
host
modalEffect modalEffect
:: R.Ref (Nullable DOM.Element) :: R.Ref (Nullable DOM.Element)
......
...@@ -33,7 +33,7 @@ import Data.Tuple (Tuple(..)) ...@@ -33,7 +33,7 @@ import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Sizing(..), Variant(..)) import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Sizing(..), Variant(..))
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI) import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
...@@ -407,7 +407,6 @@ tableContainerCpt { addCallback ...@@ -407,7 +407,6 @@ tableContainerCpt { addCallback
type CommonProps = type CommonProps =
( afterSync :: Unit -> Aff Unit ( afterSync :: Unit -> Aff Unit
, boxes :: Boxes
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, withAutoUpdate :: Boolean -- (?) not used , withAutoUpdate :: Boolean -- (?) not used
) )
...@@ -417,7 +416,6 @@ type PropsNoReload = ...@@ -417,7 +416,6 @@ type PropsNoReload =
, mTotalRows :: Maybe Int , mTotalRows :: Maybe Int
, path :: T.Box PageParams , path :: T.Box PageParams
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record SidePanel))
, state :: T.Box State , state :: T.Box State
, treeEdit :: Record NgramsTreeEditProps , treeEdit :: Record NgramsTreeEditProps
, versioned :: VersionedNgramsTable , versioned :: VersionedNgramsTable
...@@ -489,18 +487,17 @@ loadedNgramsTableBody = R.createElement loadedNgramsTableBodyCpt ...@@ -489,18 +487,17 @@ loadedNgramsTableBody = R.createElement loadedNgramsTableBodyCpt
loadedNgramsTableBodyCpt :: R.Component PropsNoReload loadedNgramsTableBodyCpt :: R.Component PropsNoReload
loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
cpt { afterSync cpt { afterSync
, boxes: boxes@{ errors
, tasks }
, cacheState , cacheState
, mTotalRows , mTotalRows
, path , path
, session , session
, sidePanel
, state , state
, tabNgramType , tabNgramType
, treeEdit: treeEdit@{ getNgramsChildrenAff, getNgramsChildren } , treeEdit: treeEdit@{ getNgramsChildrenAff, getNgramsChildren }
, versioned: Versioned { data: initTable } , versioned: Versioned { data: initTable }
} _ = do } _ = do
{ errors, tasks } <- Store.use
treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit.box treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit.box
state'@{ ngramsLocalPatch, ngramsSelection } <- T.useLive T.unequal state state'@{ ngramsLocalPatch, ngramsSelection } <- T.useLive T.unequal state
path'@{ scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path path'@{ scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path
...@@ -562,8 +559,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -562,8 +559,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
filteredConvertedRows = convertRow <$> filteredRows filteredConvertedRows = convertRow <$> filteredRows
convertRow ngramsElement = convertRow ngramsElement =
{ row: renderNgramsItem { boxes { row: renderNgramsItem { corpusId: path'.nodeId
, corpusId: path'.nodeId
, dispatch: performAction , dispatch: performAction
, getNgramsChildrenAff , getNgramsChildrenAff
, getNgramsChildren , getNgramsChildren
...@@ -574,8 +570,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -574,8 +570,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
, ngramsLocalPatch , ngramsLocalPatch
, ngramsSelection , ngramsSelection
, ngramsTable , ngramsTable
, session: path'.session , session: path'.session } []
, sidePanel } []
, delete: false , delete: false
} }
...@@ -787,7 +782,6 @@ type MainNgramsTableProps = ( ...@@ -787,7 +782,6 @@ type MainNgramsTableProps = (
-- ^ This node can be a corpus or contact. -- ^ This node can be a corpus or contact.
, path :: T.Box PageParams , path :: T.Box PageParams
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record SidePanel))
, tabType :: TabType , tabType :: TabType
, treeEdit :: Record NgramsTreeEditProps , treeEdit :: Record NgramsTreeEditProps
| CommonProps | CommonProps
...@@ -1027,27 +1021,23 @@ type MainNgramsTableCacheProps = ...@@ -1027,27 +1021,23 @@ type MainNgramsTableCacheProps =
mainNgramsTableCacheOn :: R2.Leaf MainNgramsTableCacheProps mainNgramsTableCacheOn :: R2.Leaf MainNgramsTableCacheProps
mainNgramsTableCacheOn = R2.leaf mainNgramsTableCacheOnCpt mainNgramsTableCacheOn = R2.leaf mainNgramsTableCacheOnCpt
mainNgramsTableCacheOnCpt :: R.Component MainNgramsTableCacheProps mainNgramsTableCacheOnCpt :: R.Component MainNgramsTableCacheProps
mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where mainNgramsTableCacheOnCpt = R2.hereComponent here "mainNgramsTableCacheOn" hCpt where
cpt { afterSync hCpt hp { afterSync
, boxes , defaultListId
, defaultListId , path
, path , session
, session , state
, sidePanel , tabNgramType
, state , treeEdit
, tabNgramType , withAutoUpdate } _ = do
, treeEdit
, withAutoUpdate } _ = do
-- let path = initialPageParams session nodeId [defaultListId] tabType -- let path = initialPageParams session nodeId [defaultListId] tabType
path' <- T.useLive T.unequal path path' <- T.useLive T.unequal path
let render versioned = mainNgramsTablePaint { afterSync let render versioned = mainNgramsTablePaint { afterSync
, boxes
, cacheState: NT.CacheOn , cacheState: NT.CacheOn
, path , path
, session , session
, sidePanel
, state , state
, tabNgramType , tabNgramType
, treeEdit , treeEdit
...@@ -1062,8 +1052,9 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where ...@@ -1062,8 +1052,9 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
, renderer: render , renderer: render
, spinnerClass: Nothing , spinnerClass: Nothing
} }
where
errorHandler = logRESTError hp
versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ Routes.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId) versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ Routes.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
errorHandler = logRESTError here "[mainNgramsTableCacheOn]"
mkRequest :: PageParams -> GUC.Request mkRequest :: PageParams -> GUC.Request
mkRequest path@{ session } = GUC.makeGetRequest session $ url path mkRequest path@{ session } = GUC.makeGetRequest session $ url path
where where
...@@ -1078,34 +1069,29 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where ...@@ -1078,34 +1069,29 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
mainNgramsTableCacheOff :: R2.Leaf MainNgramsTableCacheProps mainNgramsTableCacheOff :: R2.Leaf MainNgramsTableCacheProps
mainNgramsTableCacheOff = R2.leaf mainNgramsTableCacheOffCpt mainNgramsTableCacheOff = R2.leaf mainNgramsTableCacheOffCpt
mainNgramsTableCacheOffCpt :: R.Component MainNgramsTableCacheProps mainNgramsTableCacheOffCpt :: R.Component MainNgramsTableCacheProps
mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where mainNgramsTableCacheOffCpt = R2.hereComponent here "mainNgramsTableCacheOff" hCpt where
cpt { afterSync hCpt hp { afterSync
, boxes , path
, path , session
, session , state
, sidePanel , tabNgramType
, state , treeEdit
, tabNgramType , withAutoUpdate } _ = do
, treeEdit
, withAutoUpdate } _ = do
let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
, boxes
, cacheState: NT.CacheOff , cacheState: NT.CacheOff
, path , path
, session , session
, sidePanel
, state , state
, tabNgramType , tabNgramType
, treeEdit , treeEdit
, versionedWithCount , versionedWithCount
, withAutoUpdate } [] , withAutoUpdate } []
useLoaderBox { errorHandler useLoaderBox { errorHandler: Nothing
, herePrefix: hp
, loader , loader
, path , path
, render } , render }
errorHandler = logRESTError here "[mainNgramsTableCacheOff]"
-- NOTE With cache off -- NOTE With cache off
loader :: PageParams -> AffRESTError VersionedWithCountNgramsTable loader :: PageParams -> AffRESTError VersionedWithCountNgramsTable
loader { listIds loader { listIds
...@@ -1133,7 +1119,6 @@ type MainNgramsTablePaintProps = ( ...@@ -1133,7 +1119,6 @@ type MainNgramsTablePaintProps = (
cacheState :: NT.CacheState cacheState :: NT.CacheState
, path :: T.Box PageParams , path :: T.Box PageParams
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record SidePanel))
, state :: T.Box State , state :: T.Box State
, treeEdit :: Record NgramsTreeEditProps , treeEdit :: Record NgramsTreeEditProps
, versioned :: VersionedNgramsTable , versioned :: VersionedNgramsTable
...@@ -1146,11 +1131,9 @@ mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps ...@@ -1146,11 +1131,9 @@ mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
where where
cpt { afterSync cpt { afterSync
, boxes
, cacheState , cacheState
, path , path
, session , session
, sidePanel
, state , state
, tabNgramType , tabNgramType
, treeEdit , treeEdit
...@@ -1163,12 +1146,10 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt ...@@ -1163,12 +1146,10 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
pure $ pure $
loadedNgramsTableBody loadedNgramsTableBody
{ afterSync { afterSync
, boxes
, cacheState , cacheState
, mTotalRows: Nothing , mTotalRows: Nothing
, path , path
, session , session
, sidePanel
, state , state
, tabNgramType , tabNgramType
, treeEdit , treeEdit
...@@ -1180,7 +1161,6 @@ type MainNgramsTablePaintNoCacheProps = ( ...@@ -1180,7 +1161,6 @@ type MainNgramsTablePaintNoCacheProps = (
cacheState :: NT.CacheState cacheState :: NT.CacheState
, path :: T.Box PageParams , path :: T.Box PageParams
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record SidePanel))
, state :: T.Box State , state :: T.Box State
, treeEdit :: Record NgramsTreeEditProps , treeEdit :: Record NgramsTreeEditProps
, versionedWithCount :: VersionedWithCountNgramsTable , versionedWithCount :: VersionedWithCountNgramsTable
...@@ -1193,11 +1173,9 @@ mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps ...@@ -1193,11 +1173,9 @@ mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cpt mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cpt
where where
cpt { afterSync cpt { afterSync
, boxes
, cacheState , cacheState
, path , path
, session , session
, sidePanel
, state , state
, tabNgramType , tabNgramType
, treeEdit , treeEdit
...@@ -1213,12 +1191,10 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp ...@@ -1213,12 +1191,10 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
pure $ pure $
loadedNgramsTableBody loadedNgramsTableBody
{ afterSync { afterSync
, boxes
, cacheState , cacheState
, mTotalRows: Just count , mTotalRows: Just count
, path , path
, session , session
, sidePanel
, state , state
, tabNgramType , tabNgramType
, treeEdit , treeEdit
......
...@@ -17,10 +17,9 @@ import Data.Tuple.Nested ((/\)) ...@@ -17,10 +17,9 @@ import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (Variant(..)) import Gargantext.Components.Bootstrap.Types (Variant(..))
import Gargantext.Components.Nodes.Lists.SidePanel (SidePanel)
import Gargantext.Components.Table as Tbl import Gargantext.Components.Table as Tbl
import Gargantext.Core.NgramsTable.Functions (applyNgramsPatches, setTermListA, tablePatchHasNgrams) import Gargantext.Core.NgramsTable.Functions (applyNgramsPatches, setTermListA, tablePatchHasNgrams)
import Gargantext.Core.NgramsTable.Types (Action(..), CoreAction, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _children, _list, _ngrams, _occurrences, ngramsTermText, replace) import Gargantext.Core.NgramsTable.Types (Action(..), CoreAction, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _children, _list, _ngrams, _occurrences, ngramsTermText, replace)
...@@ -229,8 +228,7 @@ treeLoadedCpt = here.component "treeLoaded" cpt where ...@@ -229,8 +228,7 @@ treeLoadedCpt = here.component "treeLoaded" cpt where
H.ul {} <<< map (\ngrams -> tree ((Record.delete (Proxy :: Proxy "ngramsChildren") params) { ngramsDepth = {depth, ngrams, parent: Just ngramsDepth.ngrams} })) <<< L.toUnfoldable H.ul {} <<< map (\ngrams -> tree ((Record.delete (Proxy :: Proxy "ngramsChildren") params) { ngramsDepth = {depth, ngrams, parent: Just ngramsDepth.ngrams} })) <<< L.toUnfoldable
type RenderNgramsItem = type RenderNgramsItem =
( boxes :: Boxes ( corpusId :: GT.CorpusId
, corpusId :: GT.CorpusId
, dispatch :: Action -> Effect Unit , dispatch :: Action -> Effect Unit
, getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm)) , getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
, getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm) , getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
...@@ -242,7 +240,6 @@ type RenderNgramsItem = ...@@ -242,7 +240,6 @@ type RenderNgramsItem =
, ngramsSelection :: Set NgramsTerm , ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable , ngramsTable :: NgramsTable
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record SidePanel))
) )
renderNgramsItem :: R2.Component RenderNgramsItem renderNgramsItem :: R2.Component RenderNgramsItem
...@@ -250,8 +247,7 @@ renderNgramsItem = R.createElement renderNgramsItemCpt ...@@ -250,8 +247,7 @@ renderNgramsItem = R.createElement renderNgramsItemCpt
renderNgramsItemCpt :: R.Component RenderNgramsItem renderNgramsItemCpt :: R.Component RenderNgramsItem
renderNgramsItemCpt = here.component "renderNgramsItem" cpt renderNgramsItemCpt = here.component "renderNgramsItem" cpt
where where
cpt { boxes cpt { corpusId
, corpusId
, dispatch , dispatch
--, getNgramsChildren --, getNgramsChildren
, isEditing , isEditing
...@@ -262,14 +258,14 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -262,14 +258,14 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
, ngramsSelection , ngramsSelection
, ngramsTable , ngramsTable
, session , session
, sidePanel
} _ = do } _ = do
{ sidePanelLists } <- Store.use
isEditing' <- T.useLive T.unequal isEditing isEditing' <- T.useLive T.unequal isEditing
mCurrentNgrams <- mCurrentNgrams <-
T.useFocused T.useFocused
(maybe Nothing _.mCurrentNgrams) (maybe Nothing _.mCurrentNgrams)
(\val -> maybe Nothing (\sp -> Just $ sp { mCurrentNgrams = val })) sidePanel (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentNgrams = val })) sidePanelLists
mCurrentNgrams' <- T.useLive T.unequal mCurrentNgrams mCurrentNgrams' <- T.useLive T.unequal mCurrentNgrams
let currentRowSelected = mCurrentNgrams' == Just ngrams let currentRowSelected = mCurrentNgrams' == Just ngrams
...@@ -278,12 +274,10 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -278,12 +274,10 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
pure $ Tbl.makeRow' { className } pure $ Tbl.makeRow' { className }
[ selected [ selected
, ,
ngramsContext { boxes ngramsContext { corpusId
, corpusId
, mListId , mListId
, ngrams , ngrams
, session , session } []
, sidePanel } []
, ,
B.wad' B.wad'
[ "col-score" ] $ [ "col-score" ] $
...@@ -450,27 +444,25 @@ nextTermList GT.CandidateTerm = GT.MapTerm ...@@ -450,27 +444,25 @@ nextTermList GT.CandidateTerm = GT.MapTerm
type NgramsContextProps = type NgramsContextProps =
( boxes :: Boxes ( corpusId :: GT.CorpusId
, corpusId :: GT.CorpusId
, mListId :: Maybe GT.ListId , mListId :: Maybe GT.ListId
, ngrams :: NgramsTerm , ngrams :: NgramsTerm
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record SidePanel))) )
ngramsContext :: R2.Component NgramsContextProps ngramsContext :: R2.Component NgramsContextProps
ngramsContext = R.createElement ngramsContextCpt ngramsContext = R.createElement ngramsContextCpt
ngramsContextCpt :: R.Component NgramsContextProps ngramsContextCpt :: R.Component NgramsContextProps
ngramsContextCpt = here.component "ngramsContext" cpt where ngramsContextCpt = here.component "ngramsContext" cpt where
cpt { ngrams cpt { ngrams
, boxes: { sidePanelState }
, corpusId , corpusId
, mListId , mListId
, session , session } _ = do
, sidePanel } _ = do { sidePanelLists, sidePanelState } <- Store.use
mCurrentNgrams <- mCurrentNgrams <-
T.useFocused T.useFocused
(maybe Nothing _.mCurrentNgrams) (maybe Nothing _.mCurrentNgrams)
(\val -> maybe Nothing (\sp -> Just $ sp { mCurrentNgrams = val })) sidePanel (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentNgrams = val })) sidePanelLists
mCurrentNgrams' <- T.useLive T.unequal mCurrentNgrams mCurrentNgrams' <- T.useLive T.unequal mCurrentNgrams
let selected = mCurrentNgrams' == Just ngrams let selected = mCurrentNgrams' == Just ngrams
...@@ -484,12 +476,12 @@ ngramsContextCpt = here.component "ngramsContext" cpt where ...@@ -484,12 +476,12 @@ ngramsContextCpt = here.component "ngramsContext" cpt where
-- R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId } -- R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId }
-- T2.reload tableReload -- T2.reload tableReload
if selected then do if selected then do
T.write_ Nothing sidePanel T.write_ Nothing sidePanelLists
T.write_ GT.Closed sidePanelState T.write_ GT.Closed sidePanelState
else do else do
T.write_ (Just { mCorpusId: Just corpusId T.write_ (Just { mCorpusId: Just corpusId
, mListId , mListId
, mCurrentNgrams: Just ngrams }) sidePanel , mCurrentNgrams: Just ngrams }) sidePanelLists
T.write_ GT.Opened sidePanelState T.write_ GT.Opened sidePanelState
pure $ H.div { className: "doc-chooser text-center" } pure $ H.div { className: "doc-chooser text-center" }
......
...@@ -16,7 +16,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT ...@@ -16,7 +16,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table (defaultContainer, initialParams, makeRow, table, tableHeaderLayout) as TT import Gargantext.Components.Table (defaultContainer, initialParams, makeRow, table, tableHeaderLayout) as TT
import Gargantext.Components.Table.Types (ColumnName(..), Params) as TT import Gargantext.Components.Table.Types (ColumnName(..), Params) as TT
import Gargantext.Config.REST (AffRESTError, logRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Ends (url, Frontends) import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
...@@ -69,19 +69,17 @@ type KeyLayoutProps = ...@@ -69,19 +69,17 @@ type KeyLayoutProps =
annuaireLayoutWithKey :: R2.Leaf KeyLayoutProps annuaireLayoutWithKey :: R2.Leaf KeyLayoutProps
annuaireLayoutWithKey = R2.leaf annuaireLayoutWithKeyCpt annuaireLayoutWithKey = R2.leaf annuaireLayoutWithKeyCpt
annuaireLayoutWithKeyCpt :: R.Component KeyLayoutProps annuaireLayoutWithKeyCpt :: R.Component KeyLayoutProps
annuaireLayoutWithKeyCpt = here.component "annuaireLayoutWithKey" cpt where annuaireLayoutWithKeyCpt = R2.hereComponent here "annuaireLayoutWithKey" hCpt where
cpt { frontends, nodeId, session } _ = do hCpt hp { frontends, nodeId, session } _ = do
path <- T.useBox nodeId path <- T.useBox nodeId
path' <- T.useLive T.unequal path path' <- T.useLive T.unequal path
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: getAnnuaireInfo session , loader: getAnnuaireInfo session
, path: path' , path: path'
, render: \info -> annuaire { frontends, info, path, session } } , render: \info -> annuaire { frontends, info, path, session } }
where
errorHandler = logRESTError here "[annuaireLayoutWithKey]"
type AnnuaireProps = type AnnuaireProps =
( session :: Session ( session :: Session
...@@ -136,19 +134,16 @@ type PageLayoutProps = ...@@ -136,19 +134,16 @@ type PageLayoutProps =
pageLayout :: Record PageLayoutProps -> R.Element pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props [] pageLayout props = R.createElement pageLayoutCpt props []
pageLayoutCpt :: R.Component PageLayoutProps pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt pageLayoutCpt = R2.hereComponent here "pageLayout" hCpt where
where hCpt hp { frontends, pagePath, session } _ = do
cpt { frontends, pagePath, session } _ = do pagePath' <- T.useLive T.unequal pagePath
pagePath' <- T.useLive T.unequal pagePath
useLoader { errorHandler: Nothing
useLoader { errorHandler , herePrefix: hp
, loader: loadPage session , loader: loadPage session
, path: pagePath' , path: pagePath'
, render: \table -> page { session, table, frontends, pagePath } } , render: \table -> page { session, table, frontends, pagePath } }
where
errorHandler = logRESTError here "[pageLayout]"
type PageProps = type PageProps =
( frontends :: Frontends ( frontends :: Frontends
......
...@@ -8,7 +8,7 @@ import Data.Maybe (Maybe(..)) ...@@ -8,7 +8,7 @@ import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.DocsTable.Types (Year) import Gargantext.Components.DocsTable.Types (Year)
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
...@@ -51,14 +51,11 @@ modeTabType' Books = CTabAuthors ...@@ -51,14 +51,11 @@ modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors modeTabType' Communication = CTabAuthors
type TabsProps = type TabsProps =
( boxes :: Boxes ( cacheState :: T.Box LTypes.CacheState
, cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int , defaultListId :: Int
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanelList :: T.Box (Maybe (Record LSidePanel.SidePanel))
) )
tabs :: R2.Leaf TabsProps tabs :: R2.Leaf TabsProps
...@@ -76,24 +73,21 @@ tabsCpt = here.component "tabs" cpt where ...@@ -76,24 +73,21 @@ tabsCpt = here.component "tabs" cpt where
, tabs: tabs' yearFilter chartReload props , tabs: tabs' yearFilter chartReload props
, className: "nodes-annuaire-layout-tabs" , className: "nodes-annuaire-layout-tabs"
} }
tabs' yearFilter chartReload props@{ boxes, defaultListId, sidePanel } = tabs' yearFilter chartReload props@{ defaultListId } =
[ "Documents" /\ docs [ "Documents" /\ docs
, "Patents" /\ ngramsView (viewProps Patents) , "Patents" /\ ngramsView (viewProps Patents)
, "Books" /\ ngramsView (viewProps Books) , "Books" /\ ngramsView (viewProps Books)
, "Communication" /\ ngramsView (viewProps Communication) , "Communication" /\ ngramsView (viewProps Communication)
, "Trash" /\ docs -- TODO pass-in trash mode , "Trash" /\ docs -- TODO pass-in trash mode
] where ] where
viewProps mode = { boxes : props.boxes viewProps mode = { cacheState : props.cacheState
, cacheState : props.cacheState
, defaultListId : props.defaultListId , defaultListId : props.defaultListId
, frontends : props.frontends , frontends : props.frontends
, mode , mode
, nodeId : props.nodeId , nodeId : props.nodeId
, session : props.session , session : props.session }
, sidePanel : props.sidePanel
, sidePanelList : props.sidePanelList }
totalRecords = 4736 -- TODO lol totalRecords = 4736 -- TODO lol
docs = DT.docViewLayout (Record.merge { boxes, chartReload, sidePanel } $ Record.merge dtCommon dtExtra) docs = DT.docViewLayout (Record.merge { chartReload } $ Record.merge dtCommon dtExtra)
dtCommon = RX.pick props :: Record DTCommon dtCommon = RX.pick props :: Record DTCommon
dtExtra = dtExtra =
{ chart: mempty { chart: mempty
...@@ -125,8 +119,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -125,8 +119,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
cpt props@{ defaultListId cpt props@{ defaultListId
, mode , mode
, nodeId , nodeId
, session , session } _ = do
, sidePanelList } _ = do
path <- T.useBox $ path <- T.useBox $
NTC.initialPageParams session nodeId NTC.initialPageParams session nodeId
[ defaultListId ] (TabDocument TabDocs) [ defaultListId ] (TabDocument TabDocs)
...@@ -141,7 +134,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -141,7 +134,6 @@ ngramsViewCpt = here.component "ngramsView" cpt where
(Record.merge most (Record.merge most
{ afterSync { afterSync
, path , path
, sidePanel: sidePanelList
, tabType: TabPairing (TabNgramType $ modeTabType mode) , tabType: TabPairing (TabNgramType $ modeTabType mode)
, tabNgramType: modeTabType' mode , tabNgramType: modeTabType' mode
, treeEdit: { box: treeEditBox , treeEdit: { box: treeEditBox
...@@ -158,8 +150,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -158,8 +150,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
pure $ NT.mainNgramsTable props' [] pure $ NT.mainNgramsTable props' []
type NTCommon = type NTCommon =
( boxes :: Boxes ( cacheState :: T.Box LTypes.CacheState
, cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int , defaultListId :: Int
, session :: Session , session :: Session
) )
...@@ -6,11 +6,11 @@ module Gargantext.Components.Nodes.Annuaire.User.Contact ...@@ -6,11 +6,11 @@ module Gargantext.Components.Nodes.Annuaire.User.Contact
import Gargantext.Prelude import Gargantext.Prelude
import Data.Lens (view) import Data.Lens (view)
import Data.Maybe (Maybe(..))
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..)) import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
import Gargantext.Components.GraphQL.Endpoints (getAnnuaireContact) import Gargantext.Components.GraphQL.Endpoints (getAnnuaireContact)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData', HyperdataContact(..)) import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData', HyperdataContact(..))
import Gargantext.Config.REST (logRESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Session (useSession) import Gargantext.Hooks.Session (useSession)
import Gargantext.Types (NodeID) import Gargantext.Types (NodeID)
...@@ -30,22 +30,18 @@ type Props = ...@@ -30,22 +30,18 @@ type Props =
contactLayout :: R2.Leaf ( key :: String | Props ) contactLayout :: R2.Leaf ( key :: String | Props )
contactLayout = R2.leaf contactLayoutCpt contactLayout = R2.leaf contactLayoutCpt
contactLayoutCpt :: R.Component ( key :: String | Props ) contactLayoutCpt :: R.Component ( key :: String | Props )
contactLayoutCpt = here.component "layout" cpt where contactLayoutCpt = R2.hereComponent here "layout" hCpt where
-- Helpers
errorHandler = logRESTError here "[contactLayoutWithKey]"
-- Component -- Component
cpt { nodeId hCpt hp { nodeId } _ = do
} _ = do
session <- useSession session <- useSession
-- _ /\ reload <- R2.useBox' T2.newReload -- _ /\ reload <- R2.useBox' T2.newReload
useLoader useLoader
{ errorHandler { errorHandler: Nothing
, herePrefix: hp
, loader: getAnnuaireContact session , loader: getAnnuaireContact session
, path: nodeId , path: nodeId
, render: , render:
......
...@@ -7,7 +7,7 @@ import Data.Generic.Rep (class Generic) ...@@ -7,7 +7,7 @@ import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.DocsTable.Types (Year) import Gargantext.Components.DocsTable.Types (Year)
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
...@@ -49,14 +49,12 @@ modeTabType' Books = CTabAuthors ...@@ -49,14 +49,12 @@ modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors modeTabType' Communication = CTabAuthors
type TabsProps = type TabsProps =
( boxes :: Boxes ( cacheState :: T.Box LTypes.CacheState
, cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int , defaultListId :: Int
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record TTypes.SidePanel)) , sidePanel :: T.Box (Maybe (Record TTypes.SidePanel))
, sidePanelList :: T.Box (Maybe (Record LSidePanel.SidePanel))
) )
tabs :: R2.Leaf TabsProps tabs :: R2.Leaf TabsProps
...@@ -64,14 +62,12 @@ tabs = R2.leaf tabsCpt ...@@ -64,14 +62,12 @@ tabs = R2.leaf tabsCpt
tabsCpt :: R.Component TabsProps tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt tabsCpt = here.component "tabs" cpt
where where
cpt { boxes cpt { cacheState
, cacheState
, defaultListId , defaultListId
, frontends , frontends
, nodeId , nodeId
, session , session
, sidePanel , sidePanel
, sidePanelList
} _ = do } _ = do
activeTab <- T.useBox 0 activeTab <- T.useBox 0
yearFilter <- T.useBox (Nothing :: Maybe Year) yearFilter <- T.useBox (Nothing :: Maybe Year)
...@@ -87,35 +83,28 @@ tabsCpt = here.component "tabs" cpt ...@@ -87,35 +83,28 @@ tabsCpt = here.component "tabs" cpt
, "Trash" /\ docs -- TODO pass-in trash mode , "Trash" /\ docs -- TODO pass-in trash mode
] ]
where where
patentsView = { boxes patentsView = { cacheState
, cacheState
, defaultListId , defaultListId
, mode: Patents , mode: Patents
, nodeId , nodeId
, session , session
, sidePanel: sidePanelList
} }
booksView = { boxes booksView = { cacheState
, cacheState
, defaultListId , defaultListId
, mode: Books , mode: Books
, nodeId , nodeId
, session , session
, sidePanel: sidePanelList
} }
commView = { boxes commView = { cacheState
, cacheState
, defaultListId , defaultListId
, mode: Communication , mode: Communication
, nodeId , nodeId
, session , session
, sidePanel: sidePanelList
} }
chart = mempty chart = mempty
totalRecords = 4736 -- TODO totalRecords = 4736 -- TODO
docs = DT.docViewLayout docs = DT.docViewLayout
{ boxes { cacheState
, cacheState
, chart , chart
, chartReload , chartReload
, frontends , frontends
...@@ -124,7 +113,6 @@ tabsCpt = here.component "tabs" cpt ...@@ -124,7 +113,6 @@ tabsCpt = here.component "tabs" cpt
, nodeId , nodeId
, session , session
, showSearch: true , showSearch: true
, sidePanel
, tabType: TabPairing TabDocs , tabType: TabPairing TabDocs
, totalRecords , totalRecords
, yearFilter , yearFilter
...@@ -132,13 +120,11 @@ tabsCpt = here.component "tabs" cpt ...@@ -132,13 +120,11 @@ tabsCpt = here.component "tabs" cpt
type NgramsViewTabsProps = ( type NgramsViewTabsProps = (
boxes :: Boxes cacheState :: T.Box LTypes.CacheState
, cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int , defaultListId :: Int
, mode :: Mode , mode :: Mode
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record LSidePanel.SidePanel))
) )
ngramsView :: R2.Component NgramsViewTabsProps ngramsView :: R2.Component NgramsViewTabsProps
...@@ -146,13 +132,11 @@ ngramsView = R.createElement ngramsViewCpt ...@@ -146,13 +132,11 @@ ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewTabsProps ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = here.component "ngramsView" cpt ngramsViewCpt = here.component "ngramsView" cpt
where where
cpt { boxes cpt { cacheState
, cacheState
, defaultListId , defaultListId
, mode , mode
, nodeId , nodeId
, session , session } _ = do
, sidePanel } _ = do
path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs) path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
onCancelRef <- R.useRef Nothing onCancelRef <- R.useRef Nothing
onNgramsClickRef <- R.useRef Nothing onNgramsClickRef <- R.useRef Nothing
...@@ -161,12 +145,10 @@ ngramsViewCpt = here.component "ngramsView" cpt ...@@ -161,12 +145,10 @@ ngramsViewCpt = here.component "ngramsView" cpt
pure $ NT.mainNgramsTable { pure $ NT.mainNgramsTable {
afterSync: \_ -> pure unit afterSync: \_ -> pure unit
, boxes
, cacheState , cacheState
, defaultListId , defaultListId
, path , path
, session , session
, sidePanel
, tabNgramType , tabNgramType
, tabType , tabType
, treeEdit: { box: treeEditBox , treeEdit: { box: treeEditBox
......
...@@ -35,7 +35,7 @@ nodeCpt = here.component "node" cpt where ...@@ -35,7 +35,7 @@ nodeCpt = here.component "node" cpt where
-- | Computed -- | Computed
-- | -- |
let let
errorHandler = logRESTError here "[corpusLayout]" errorHandler = logRESTError (R2.herePrefix here "[corpusLayout]")
loader { nodeId: nodeId_, session: session_ } = getNode session_ nodeId_ loader { nodeId: nodeId_, session: session_ } = getNode session_ nodeId_
......
...@@ -5,6 +5,7 @@ import Gargantext.Prelude ...@@ -5,6 +5,7 @@ import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Gargantext.Components.App.Store as Store
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, ReloadPath) import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, ReloadPath)
import Gargantext.Config.REST (AffRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCacheAPI) import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCacheAPI)
...@@ -32,26 +33,22 @@ cacheName = "metrics" ...@@ -32,26 +33,22 @@ cacheName = "metrics"
metricsLoadView :: forall a. Eq a => Record (MetricsLoadViewProps a) -> R.Element metricsLoadView :: forall a. Eq a => Record (MetricsLoadViewProps a) -> R.Element
metricsLoadView p = R.createElement metricsLoadViewCpt p [] metricsLoadView p = R.createElement metricsLoadViewCpt p []
metricsLoadViewCpt :: forall a. Eq a => R.Component (MetricsLoadViewProps a) metricsLoadViewCpt :: forall a. Eq a => R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = here.component "metricsLoadView" cpt metricsLoadViewCpt = R2.hereComponent here "metricsLoadView" hCpt where
where hCpt hp { getMetrics
cpt { boxes: boxes@{ errors } , loaded
, getMetrics , onClick
, loaded , onInit
, onClick , path
, onInit , reload
, path , session } _ = do
, reload { errors } <- Store.use
, session } _ = do reload' <- T.useLive T.unequal reload
reload' <- T.useLive T.unequal reload
useLoader { errorHandler useLoader { errorHandler: Nothing
, loader: getMetrics session , herePrefix: hp
, path: reload' /\ path , loader: getMetrics session
, render: \l -> loaded { boxes, path, reload, session, onClick, onInit } l } , path: reload' /\ path
where , render: \l -> loaded { path, reload, session, onClick, onInit } l }
errorHandler error = do
T.modify_ (A.cons $ FRESTError { error }) errors
here.warn2 "RESTError" error
type MetricsWithCacheLoadViewProps res ret = type MetricsWithCacheLoadViewProps res ret =
( getMetricsHash :: Session -> ReloadPath -> AffRESTError Hash ( getMetricsHash :: Session -> ReloadPath -> AffRESTError Hash
...@@ -71,8 +68,7 @@ metricsWithCacheLoadViewCpt :: forall res ret. ...@@ -71,8 +68,7 @@ metricsWithCacheLoadViewCpt :: forall res ret.
R.Component (MetricsWithCacheLoadViewProps res ret) R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt
where where
cpt { boxes cpt { getMetricsHash
, getMetricsHash
, handleResponse , handleResponse
, loaded , loaded
, mkRequest , mkRequest
...@@ -83,10 +79,9 @@ metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt ...@@ -83,10 +79,9 @@ metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt
, onInit } _ = do , onInit } _ = do
reload' <- T.useLive T.unequal reload reload' <- T.useLive T.unequal reload
useLoaderWithCacheAPI { boxes useLoaderWithCacheAPI { cacheEndpoint: (getMetricsHash session)
, cacheEndpoint: (getMetricsHash session)
, handleResponse , handleResponse
, mkRequest , mkRequest
, path: (reload' /\ path) , path: (reload' /\ path)
, renderer: \metrics -> loaded { boxes, path, reload, session, onClick, onInit, metrics } , renderer: \metrics -> loaded { path, reload, session, onClick, onInit, metrics }
, spinnerClass: Just "echarts-for-react-spinner" } , spinnerClass: Just "echarts-for-react-spinner" }
...@@ -103,12 +103,11 @@ histo props = R.createElement histoCpt props [] ...@@ -103,12 +103,11 @@ histo props = R.createElement histoCpt props []
histoCpt :: R.Component Props histoCpt :: R.Component Props
histoCpt = here.component "histo" cpt histoCpt = here.component "histo" cpt
where where
cpt { boxes, path, session, onClick, onInit } _ = do cpt { path, session, onClick, onInit } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView pure $ metricsWithCacheLoadView
{ boxes { getMetricsHash
, getMetricsHash
, handleResponse , handleResponse
, loaded , loaded
, mkRequest: mkRequest session , mkRequest: mkRequest session
......
...@@ -112,12 +112,11 @@ metrics props = R.createElement metricsCpt props [] ...@@ -112,12 +112,11 @@ metrics props = R.createElement metricsCpt props []
metricsCpt :: R.Component Props metricsCpt :: R.Component Props
metricsCpt = here.component "etrics" cpt metricsCpt = here.component "etrics" cpt
where where
cpt { boxes, onClick, onInit, path, session } _ = do cpt { onClick, onInit, path, session } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView { pure $ metricsWithCacheLoadView {
boxes getMetricsHash
, getMetricsHash
, handleResponse , handleResponse
, loaded , loaded
, mkRequest: mkRequest session , mkRequest: mkRequest session
......
...@@ -109,12 +109,11 @@ pie = R2.leaf pieCpt ...@@ -109,12 +109,11 @@ pie = R2.leaf pieCpt
pieCpt :: R.Component Props pieCpt :: R.Component Props
pieCpt = here.component "pie" cpt pieCpt = here.component "pie" cpt
where where
cpt { boxes, path, session, onClick, onInit } _ = do cpt { path, session, onClick, onInit } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView pure $ metricsWithCacheLoadView
{ boxes { getMetricsHash
, getMetricsHash
, handleResponse , handleResponse
, loaded: loadedPie , loaded: loadedPie
, mkRequest: mkRequest session , mkRequest: mkRequest session
...@@ -144,12 +143,11 @@ bar props = R.createElement barCpt props [] ...@@ -144,12 +143,11 @@ bar props = R.createElement barCpt props []
barCpt :: R.Component Props barCpt :: R.Component Props
barCpt = here.component "bar" cpt barCpt = here.component "bar" cpt
where where
cpt { boxes, path, session, onClick, onInit} _ = do cpt { path, session, onClick, onInit} _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView { pure $ metricsWithCacheLoadView {
boxes getMetricsHash
, getMetricsHash
, handleResponse , handleResponse
, loaded: loadedBar , loaded: loadedBar
, mkRequest: mkRequest session , mkRequest: mkRequest session
......
...@@ -7,7 +7,6 @@ import Data.Maybe (Maybe(..), fromMaybe) ...@@ -7,7 +7,6 @@ import Data.Maybe (Maybe(..), fromMaybe)
import Data.Ord.Generic (genericCompare) import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Effect (Effect) import Effect (Effect)
import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.Charts.Options.Type (EChartsInstance, MouseEvent) import Gargantext.Components.Charts.Options.Type (EChartsInstance, MouseEvent)
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo) import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
...@@ -55,8 +54,7 @@ allPredefinedCharts = ...@@ -55,8 +54,7 @@ allPredefinedCharts =
type Params = type Params =
( boxes :: Boxes ( corpusId :: NodeID
, corpusId :: NodeID
-- optinal params -- optinal params
, limit :: Maybe Int , limit :: Maybe Int
, listId :: Maybe Int , listId :: Maybe Int
...@@ -66,40 +64,40 @@ type Params = ...@@ -66,40 +64,40 @@ type Params =
) )
render :: PredefinedChart -> Record Params -> R.Element render :: PredefinedChart -> Record Params -> R.Element
render CDocsHistogram { boxes, corpusId, listId, session, onClick, onInit } = render CDocsHistogram { corpusId, listId, session, onClick, onInit } =
histo { boxes, path, session, onClick, onInit } histo { path, session, onClick, onInit }
where where
path = { corpusId path = { corpusId
, listId: fromMaybe 0 listId , listId: fromMaybe 0 listId
, limit: Nothing , limit: Nothing
, tabType: TabCorpus TabDocs , tabType: TabCorpus TabDocs
} }
render CAuthorsPie { boxes, corpusId, listId, session, onClick, onInit } = render CAuthorsPie { corpusId, listId, session, onClick, onInit } =
pie { boxes, path, session, onClick, onInit } pie { path, session, onClick, onInit }
where where
path = { corpusId path = { corpusId
, listId: fromMaybe 0 listId , listId: fromMaybe 0 listId
, limit: Nothing , limit: Nothing
, tabType: TabCorpus (TabNgramType $ modeTabType Authors) , tabType: TabCorpus (TabNgramType $ modeTabType Authors)
} }
render CInstitutesTree { boxes, corpusId, limit, listId, session, onClick, onInit } = render CInstitutesTree { corpusId, limit, listId, session, onClick, onInit } =
tree { boxes, path, session, onClick, onInit } tree { path, session, onClick, onInit }
where where
path = { corpusId path = { corpusId
, limit , limit
, listId: fromMaybe 0 listId , listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Institutes) , tabType: TabCorpus (TabNgramType $ modeTabType Institutes)
} }
render CTermsMetrics { boxes, corpusId, limit, listId, session, onClick, onInit } = render CTermsMetrics { corpusId, limit, listId, session, onClick, onInit } =
metrics { boxes, path, session, onClick, onInit } metrics { path, session, onClick, onInit }
where where
path = { corpusId path = { corpusId
, limit , limit
, listId: fromMaybe 0 listId , listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Terms) , tabType: TabCorpus (TabNgramType $ modeTabType Terms)
} }
render CSourcesBar { boxes, corpusId, limit, listId, session, onClick, onInit } = render CSourcesBar { corpusId, limit, listId, session, onClick, onInit } =
bar { boxes, path, session, onClick, onInit } bar { path, session, onClick, onInit }
where where
path = { corpusId path = { corpusId
, limit , limit
......
...@@ -79,12 +79,11 @@ tree props = R.createElement treeCpt props [] ...@@ -79,12 +79,11 @@ tree props = R.createElement treeCpt props []
treeCpt :: R.Component Props treeCpt :: R.Component Props
treeCpt = here.component "tree" cpt treeCpt = here.component "tree" cpt
where where
cpt { boxes, path, session, onClick, onInit } _ = do cpt { path, session, onClick, onInit } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView pure $ metricsWithCacheLoadView
{ boxes { getMetricsHash
, getMetricsHash
, handleResponse , handleResponse
, loaded , loaded
, mkRequest: mkRequest session , mkRequest: mkRequest session
...@@ -107,3 +106,4 @@ loadedCpt = here.component "loaded" cpt where ...@@ -107,3 +106,4 @@ loadedCpt = here.component "loaded" cpt where
, U.chartUpdateButton { chartType: ChartTree, path, reload, session } , U.chartUpdateButton { chartType: ChartTree, path, reload, session }
, -} chart $ scatterOptions p , -} chart $ scatterOptions p
] ]
...@@ -18,8 +18,7 @@ type Path = ( ...@@ -18,8 +18,7 @@ type Path = (
) )
type Props = ( type Props = (
boxes :: Boxes path :: Record Path
, path :: Record Path
, session :: Session , session :: Session
, onClick :: Maybe (MouseEvent -> Effect Unit) , onClick :: Maybe (MouseEvent -> Effect Unit)
, onInit :: Maybe (EChartsInstance -> Effect Unit) , onInit :: Maybe (EChartsInstance -> Effect Unit)
......
...@@ -17,7 +17,6 @@ import Gargantext.Components.Node (NodePoly(..)) ...@@ -17,7 +17,6 @@ import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus.Types (Hyperdata(..)) import Gargantext.Components.Nodes.Corpus.Types (Hyperdata(..))
import Gargantext.Components.Nodes.Types (FTFieldList(..), FTFieldsWithIndex(..), defaultField) import Gargantext.Components.Nodes.Types (FTFieldList(..), FTFieldsWithIndex(..), defaultField)
import Gargantext.Components.TileMenu (tileMenu) import Gargantext.Components.TileMenu (tileMenu)
import Gargantext.Config.REST (logRESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
...@@ -48,16 +47,15 @@ type ViewProps = ...@@ -48,16 +47,15 @@ type ViewProps =
corpusCodeLayout :: R2.Leaf Props corpusCodeLayout :: R2.Leaf Props
corpusCodeLayout = R2.leaf corpusCodeLayoutCpt corpusCodeLayout = R2.leaf corpusCodeLayoutCpt
corpusCodeLayoutCpt :: R.Component Props corpusCodeLayoutCpt :: R.Component Props
corpusCodeLayoutCpt = here.component "corpusCodeLayout" cpt where corpusCodeLayoutCpt = R2.hereComponent here "corpusCodeLayout" hCpt where
cpt { nodeId, session, boxes } _ = do hCpt hp { nodeId, session, boxes } _ = do
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload reload' <- T.useLive T.unequal reload
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadCorpusWithReload , loader: loadCorpusWithReload
, path: { nodeId, reload: reload', session } , path: { nodeId, reload: reload', session }
, render: \corpus -> corpusCodeView { corpus, nodeId, reload, session, boxes } } , render: \corpus -> corpusCodeView { corpus, nodeId, reload, session, boxes } }
where
errorHandler = logRESTError here "[corpusLayoutWithKey]"
corpusCodeView :: Record ViewProps -> R.Element corpusCodeView :: Record ViewProps -> R.Element
corpusCodeView props = R.createElement corpusCodeViewCpt props [] corpusCodeView props = R.createElement corpusCodeViewCpt props []
......
...@@ -8,12 +8,10 @@ import Data.Maybe (Maybe(..), fromMaybe) ...@@ -8,12 +8,10 @@ import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.Corpus.CodeSection (fieldsCodeEditor) import Gargantext.Components.Corpus.CodeSection (fieldsCodeEditor)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Dashboard.Types as DT import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Components.Nodes.Types (FTFieldList(..), FTFieldsWithIndex(..), defaultField) import Gargantext.Components.Nodes.Types (FTFieldList(..), FTFieldsWithIndex(..), defaultField)
import Gargantext.Config.REST (logRESTError)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, discard, pure, read, show, unit, ($), (<$>), (<>), (==)) import Gargantext.Prelude (Unit, bind, discard, pure, read, show, unit, ($), (<$>), (<>), (==))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
...@@ -29,8 +27,7 @@ here :: R2.Here ...@@ -29,8 +27,7 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Dashboard" here = R2.here "Gargantext.Components.Nodes.Corpus.Dashboard"
type Props = type Props =
( boxes :: Boxes ( nodeId :: NodeID
, nodeId :: NodeID
, session :: Session ) , session :: Session )
dashboardLayout :: R2.Component Props dashboardLayout :: R2.Component Props
...@@ -50,43 +47,40 @@ type KeyProps = ...@@ -50,43 +47,40 @@ type KeyProps =
dashboardLayoutWithKey :: R2.Component KeyProps dashboardLayoutWithKey :: R2.Component KeyProps
dashboardLayoutWithKey = R.createElement dashboardLayoutWithKeyCpt dashboardLayoutWithKey = R.createElement dashboardLayoutWithKeyCpt
dashboardLayoutWithKeyCpt :: R.Component KeyProps dashboardLayoutWithKeyCpt :: R.Component KeyProps
dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt dashboardLayoutWithKeyCpt = R2.hereComponent here "dashboardLayoutWithKey" hCpt where
where hCpt hp { nodeId, session } _ = do
cpt { boxes, nodeId, session } _ = do reload <- T.useBox T2.newReload
reload <- T.useBox T2.newReload reload' <- T.useLive T.unequal reload
reload' <- T.useLive T.unequal reload
useLoader { errorHandler: Nothing
useLoader { errorHandler , herePrefix: hp
, loader: DT.loadDashboardWithReload , loader: DT.loadDashboardWithReload
, path: { nodeId, reload: reload', session } , path: { nodeId, reload: reload', session }
, render: \(DT.DashboardData { hyperdata: DT.Hyperdata h, parentId }) -> do , render: \(DT.DashboardData { hyperdata: DT.Hyperdata h, parentId }) -> do
let { charts, fields } = h let { charts, fields } = h
dashboardLayoutLoaded { boxes dashboardLayoutLoaded { charts
, charts , corpusId: parentId
, corpusId: parentId , defaultListId: 0
, defaultListId: 0 , fields
, fields , nodeId
, nodeId , onChange: onChange nodeId reload (DT.Hyperdata h)
, onChange: onChange nodeId reload (DT.Hyperdata h) , session } [] }
, session } [] } where
where onChange :: NodeID -> T2.ReloadS -> DT.Hyperdata -> { charts :: Array P.PredefinedChart
errorHandler = logRESTError here "[dashboardLayoutWithKey]" , fields :: FTFieldList } -> Effect Unit
onChange :: NodeID -> T2.ReloadS -> DT.Hyperdata -> { charts :: Array P.PredefinedChart onChange nodeId' reload (DT.Hyperdata h) { charts, fields } = do
, fields :: FTFieldList } -> Effect Unit launchAff_ do
onChange nodeId' reload (DT.Hyperdata h) { charts, fields } = do res <- DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields }
launchAff_ do , nodeId:nodeId'
res <- DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields } , session }
, nodeId:nodeId' liftEffect $ do
, session } _ <- case res of
liftEffect $ do Left err -> R2.hpWarn2 hp "onChange RESTError" err
_ <- case res of _ -> pure unit
Left err -> here.warn2 "[dashboardLayoutWithKey] onChange RESTError" err T2.reload reload
_ -> pure unit
T2.reload reload
type LoadedProps = type LoadedProps =
( boxes :: Boxes ( charts :: Array P.PredefinedChart
, charts :: Array P.PredefinedChart
, corpusId :: NodeID , corpusId :: NodeID
, defaultListId :: Int , defaultListId :: Int
, fields :: FTFieldList , fields :: FTFieldList
...@@ -101,8 +95,7 @@ dashboardLayoutLoaded = R.createElement dashboardLayoutLoadedCpt ...@@ -101,8 +95,7 @@ dashboardLayoutLoaded = R.createElement dashboardLayoutLoadedCpt
dashboardLayoutLoadedCpt :: R.Component LoadedProps dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
where where
cpt { boxes cpt { charts
, charts
, corpusId , corpusId
, defaultListId , defaultListId
, fields , fields
...@@ -132,8 +125,7 @@ dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt ...@@ -132,8 +125,7 @@ dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
, fields } , fields }
chartsEls = mapWithIndex chartIdx charts chartsEls = mapWithIndex chartIdx charts
chartIdx idx chart = chartIdx idx chart =
renderChart { boxes renderChart { chart
, chart
, corpusId , corpusId
, defaultListId , defaultListId
, onChange: onChangeChart , onChange: onChangeChart
...@@ -209,8 +201,7 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt ...@@ -209,8 +201,7 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
List.snoc fs $ { idx: List.length fs, ftField: defaultField }) fieldsS List.snoc fs $ { idx: List.length fs, ftField: defaultField }) fieldsS
type PredefinedChartProps = type PredefinedChartProps =
( boxes :: Boxes ( chart :: P.PredefinedChart
, chart :: P.PredefinedChart
, corpusId :: NodeID , corpusId :: NodeID
, defaultListId :: Int , defaultListId :: Int
, onChange :: P.PredefinedChart -> Effect Unit , onChange :: P.PredefinedChart -> Effect Unit
...@@ -223,8 +214,7 @@ renderChart = R.createElement renderChartCpt ...@@ -223,8 +214,7 @@ renderChart = R.createElement renderChartCpt
renderChartCpt :: R.Component PredefinedChartProps renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt = here.component "renderChart" cpt renderChartCpt = here.component "renderChart" cpt
where where
cpt { boxes cpt { chart
, chart
, corpusId , corpusId
, defaultListId , defaultListId
, onChange , onChange
...@@ -259,8 +249,7 @@ renderChartCpt = here.component "renderChart" cpt ...@@ -259,8 +249,7 @@ renderChartCpt = here.component "renderChart" cpt
where where
value = R.unsafeEventValue e value = R.unsafeEventValue e
onRemoveClick _ = onRemove unit onRemoveClick _ = onRemove unit
params = { boxes params = { corpusId
, corpusId
, limit: Just 1000 , limit: Just 1000
, listId: Just defaultListId , listId: Just defaultListId
, onClick: Nothing , onClick: Nothing
......
...@@ -32,11 +32,11 @@ here = R2.here "Gargantext.Components.Nodes.Corpus.Document" ...@@ -32,11 +32,11 @@ here = R2.here "Gargantext.Components.Nodes.Corpus.Document"
node :: R2.Leaf ( key :: String | Props ) node :: R2.Leaf ( key :: String | Props )
node = R2.leaf nodeCpt node = R2.leaf nodeCpt
nodeCpt :: R.Component ( key :: String | Props ) nodeCpt :: R.Component ( key :: String | Props )
nodeCpt = here.component "node" cpt where nodeCpt = R2.hereComponent here "node" hCpt where
cpt { listId hCpt hp { listId
, mCorpusId , mCorpusId
, nodeId , nodeId
} _ = do } _ = do
-- | States -- | States
-- | -- |
session <- useSession session <- useSession
...@@ -55,7 +55,7 @@ nodeCpt = here.component "node" cpt where ...@@ -55,7 +55,7 @@ nodeCpt = here.component "node" cpt where
-- | Hooks -- | Hooks
-- | -- |
useLoaderEffect useLoaderEffect
{ errorHandler: logRESTError here "[documentLayoutWithKey]" { errorHandler: logRESTError hp
, loader: loadData , loader: loadData
, path , path
, state , state
......
...@@ -34,8 +34,8 @@ node :: R2.Leaf MainProps ...@@ -34,8 +34,8 @@ node :: R2.Leaf MainProps
node = R2.leaf nodeCpt node = R2.leaf nodeCpt
nodeCpt :: R.Component MainProps nodeCpt :: R.Component MainProps
nodeCpt = here.component "node" cpt where nodeCpt = R2.hereComponent here "node" hCpt where
cpt { nodeId } _ = do hCpt hp { nodeId } _ = do
-- | States -- | States
-- | -- |
session <- useSession session <- useSession
...@@ -45,7 +45,7 @@ nodeCpt = here.component "node" cpt where ...@@ -45,7 +45,7 @@ nodeCpt = here.component "node" cpt where
-- | Computed -- | Computed
-- | -- |
let errorHandler = logRESTError here "[phylo]" let errorHandler = logRESTError hp
-- | Hooks -- | Hooks
-- | -- |
......
...@@ -6,7 +6,7 @@ import Data.Eq.Generic (genericEq) ...@@ -6,7 +6,7 @@ import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Gargantext.Config.REST (AffRESTError, logRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Ends (toUrl) import Gargantext.Ends (toUrl)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
...@@ -50,14 +50,14 @@ type FileLayoutProps = ( nodeId :: NodeID, session :: Session ) ...@@ -50,14 +50,14 @@ type FileLayoutProps = ( nodeId :: NodeID, session :: Session )
fileLayout :: R2.Leaf FileLayoutProps fileLayout :: R2.Leaf FileLayoutProps
fileLayout = R2.leaf fileLayoutCpt fileLayout = R2.leaf fileLayoutCpt
fileLayoutCpt :: R.Component FileLayoutProps fileLayoutCpt :: R.Component FileLayoutProps
fileLayoutCpt = here.component "fileLayout" cpt where fileLayoutCpt = R2.hereComponent here "fileLayout" hCpt where
cpt { nodeId, session } _ = do hCpt hp { nodeId, session } _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadFile session , loader: loadFile session
, path: nodeId , path: nodeId
, render: onLoad } , render: onLoad }
where where
errorHandler = logRESTError here "[fileLayout]"
onLoad loaded = fileLayoutLoaded { loaded, nodeId, session } onLoad loaded = fileLayoutLoaded { loaded, nodeId, session }
loadFile :: Session -> NodeID -> AffRESTError File loadFile :: Session -> NodeID -> AffRESTError File
......
...@@ -32,10 +32,10 @@ node :: R2.Leaf ( key :: String | Props ) ...@@ -32,10 +32,10 @@ node :: R2.Leaf ( key :: String | Props )
node = R2.leaf nodeCpt node = R2.leaf nodeCpt
nodeCpt :: R.Component ( key :: String | Props ) nodeCpt :: R.Component ( key :: String | Props )
nodeCpt = here.component "node" cpt where nodeCpt = R2.hereComponent here "node" hCpt where
cpt { nodeId hCpt hp { nodeId
, nodeType , nodeType
} _ = do } _ = do
-- | States -- | States
-- | -- |
session <- useSession session <- useSession
...@@ -46,7 +46,7 @@ nodeCpt = here.component "node" cpt where ...@@ -46,7 +46,7 @@ nodeCpt = here.component "node" cpt where
-- | Hooks -- | Hooks
-- | -- |
useLoaderEffect useLoaderEffect
{ errorHandler: logRESTError here "[frameLayout]" { errorHandler: logRESTError hp
, loader: loadframeWithReload , loader: loadframeWithReload
, path: , path:
{ nodeId { nodeId
......
...@@ -41,8 +41,8 @@ here = R2.here "Gargantext.Components.Nodes.Graph" ...@@ -41,8 +41,8 @@ here = R2.here "Gargantext.Components.Nodes.Graph"
node :: R2.Leaf ( key :: String | Props ) node :: R2.Leaf ( key :: String | Props )
node = R2.leaf nodeCpt node = R2.leaf nodeCpt
nodeCpt :: R.Component ( key :: String | Props ) nodeCpt :: R.Component ( key :: String | Props )
nodeCpt = here.component "node" cpt where nodeCpt = R2.hereComponent here "node" hCpt where
cpt { graphId } _ = do hCpt hp { graphId } _ = do
-- | States -- | States
-- | -- |
{ graphVersion { graphVersion
...@@ -56,7 +56,7 @@ nodeCpt = here.component "node" cpt where ...@@ -56,7 +56,7 @@ nodeCpt = here.component "node" cpt where
-- | Computed -- | Computed
-- | -- |
let errorHandler = logRESTError here "[node]" let errorHandler = logRESTError hp
-- | Hooks -- | Hooks
-- | -- |
......
...@@ -7,7 +7,7 @@ import Data.Maybe (Maybe(..)) ...@@ -7,7 +7,7 @@ import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.String (take) import Data.String (take)
import Gargantext.Config (publicBackend) import Gargantext.Config (publicBackend)
import Gargantext.Config.REST (AffRESTError, get, logRESTError) import Gargantext.Config.REST (AffRESTError, get)
import Gargantext.Ends (backendUrl) import Gargantext.Ends (backendUrl)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -68,15 +68,15 @@ loadPublicData _l = do ...@@ -68,15 +68,15 @@ loadPublicData _l = do
renderPublic :: R2.Leaf () renderPublic :: R2.Leaf ()
renderPublic = R2.leaf renderPublicCpt renderPublic = R2.leaf renderPublicCpt
renderPublicCpt :: R.Component () renderPublicCpt :: R.Component ()
renderPublicCpt = here.component "renderPublic" cpt where renderPublicCpt = R2.hereComponent here "renderPublic" hCpt where
cpt _ _ = do hCpt hp _ _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, loader: loadPublicData , loader: loadPublicData
, path: { reload: 0 } , path: { reload: 0 }
, render: loaded } , render: loaded }
where where
loaded publicData = publicLayout { publicData } loaded publicData = publicLayout { publicData }
errorHandler = logRESTError here "[renderPublic]"
publicLayout :: Record PublicDataProps -> R.Element publicLayout :: Record PublicDataProps -> R.Element
publicLayout props = R.createElement publicLayoutCpt props [] publicLayout props = R.createElement publicLayoutCpt props []
......
...@@ -17,7 +17,7 @@ import Gargantext.Components.Nodes.Lists.Tabs as Tabs ...@@ -17,7 +17,7 @@ import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types (CacheState(..)) import Gargantext.Components.Nodes.Lists.Types (CacheState(..))
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Config (defaultFrontends) import Gargantext.Config (defaultFrontends)
import Gargantext.Config.REST (logRESTError, AffRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Core.NgramsTable.Types (NgramsTerm(..)) import Gargantext.Core.NgramsTable.Types (NgramsTerm(..))
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
...@@ -58,12 +58,12 @@ listsLayoutCpt = here.component "listsLayout" cpt where ...@@ -58,12 +58,12 @@ listsLayoutCpt = here.component "listsLayout" cpt where
listsLayoutWithKey :: R2.Component ( key :: String | Props ) listsLayoutWithKey :: R2.Component ( key :: String | Props )
listsLayoutWithKey = R.createElement listsLayoutWithKeyCpt listsLayoutWithKey = R.createElement listsLayoutWithKeyCpt
listsLayoutWithKeyCpt :: R.Component ( key :: String | Props ) listsLayoutWithKeyCpt :: R.Component ( key :: String | Props )
listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where listsLayoutWithKeyCpt = R2.hereComponent here "listsLayoutWithKey" hCpt where
cpt { boxes hCpt hp { boxes
, nodeId , nodeId
, session , session
, sessionUpdate , sessionUpdate
, sidePanel } _ = do , sidePanel } _ = do
activeTab <- T.useBox 0 activeTab <- T.useBox 0
let path = { nodeId, session } let path = { nodeId, session }
...@@ -74,7 +74,8 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where ...@@ -74,7 +74,8 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
R.useEffectOnce' $ do R.useEffectOnce' $ do
T.listen (\{ new } -> afterCacheStateChange new) cacheState T.listen (\{ new } -> afterCacheStateChange new) cacheState
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, path , path
, loader: loadCorpusWithChild , loader: loadCorpusWithChild
, render: \corpusData@{ corpusId, corpusNode: NodePoly poly } -> , render: \corpusData@{ corpusId, corpusNode: NodePoly poly } ->
...@@ -92,17 +93,14 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where ...@@ -92,17 +93,14 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
} }
, Tabs.tabs { , Tabs.tabs {
activeTab activeTab
, boxes
, cacheState , cacheState
, corpusData , corpusData
, corpusId , corpusId
, key: "listsLayoutWithKey-tabs-" <> (show cacheState') , key: "listsLayoutWithKey-tabs-" <> (show cacheState')
, session , session
, sidePanel
} }
] } ] }
where where
errorHandler = logRESTError here "[listsLayoutWithKey]"
afterCacheStateChange cacheState = do afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit launchAff_ $ clearCache unit
sessionUpdate $ setCacheState session nodeId cacheState sessionUpdate $ setCacheState session nodeId cacheState
...@@ -193,18 +191,19 @@ type NgramsDocListProps = ...@@ -193,18 +191,19 @@ type NgramsDocListProps =
ngramsDocList :: R2.Component NgramsDocListProps ngramsDocList :: R2.Component NgramsDocListProps
ngramsDocList = R.createElement ngramsDocListCpt ngramsDocList = R.createElement ngramsDocListCpt
ngramsDocListCpt :: R.Component NgramsDocListProps ngramsDocListCpt :: R.Component NgramsDocListProps
ngramsDocListCpt = here.component "ngramsDocList" cpt where ngramsDocListCpt = R2.hereComponent here "ngramsDocList" hCpt where
cpt { mCorpusId: Nothing } _ = do hCpt hp { mCorpusId: Nothing } _ = do
pure $ H.div {} [] pure $ H.div {} []
cpt { mListId: Nothing } _ = do hCpt hp { mListId: Nothing } _ = do
pure $ H.div {} [] pure $ H.div {} []
cpt { mNgrams: Nothing } _ = do hCpt hp { mNgrams: Nothing } _ = do
pure $ H.div {} [] pure $ H.div {} []
cpt { mCorpusId: Just corpusId hCpt hp { mCorpusId: Just corpusId
, mListId: Just listId , mListId: Just listId
, mNgrams: Just ngrams , mNgrams: Just ngrams
, session } _ = do , session } _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, path: { corpusId, ngrams, session } , path: { corpusId, ngrams, session }
, loader: loaderNgramsDocList , loader: loaderNgramsDocList
, render: \ctx -> ngramsDocListLoaded { contexts: ctx , render: \ctx -> ngramsDocListLoaded { contexts: ctx
...@@ -213,8 +212,6 @@ ngramsDocListCpt = here.component "ngramsDocList" cpt where ...@@ -213,8 +212,6 @@ ngramsDocListCpt = here.component "ngramsDocList" cpt where
, ngrams , ngrams
, session } [] , session } []
} }
where
errorHandler = logRESTError here "[ngramsDocList]"
type NgramsDocLoadProps = type NgramsDocLoadProps =
( corpusId :: GT.CorpusId ( corpusId :: GT.CorpusId
......
...@@ -6,7 +6,7 @@ import Data.Array as A ...@@ -6,7 +6,7 @@ import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Core.NgramsTable.Functions as NTC import Gargantext.Core.NgramsTable.Functions as NTC
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
...@@ -33,12 +33,10 @@ here = R2.here "Gargantext.Components.Nodes.Lists.Tabs" ...@@ -33,12 +33,10 @@ here = R2.here "Gargantext.Components.Nodes.Lists.Tabs"
type Props = ( type Props = (
activeTab :: T.Box Int activeTab :: T.Box Int
, boxes :: Boxes
, cacheState :: T.Box CacheState , cacheState :: T.Box CacheState
, corpusData :: CorpusData , corpusData :: CorpusData
, corpusId :: Int , corpusId :: Int
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record SidePanel))
) )
tabs :: Record ( key :: String | Props ) -> R.Element tabs :: Record ( key :: String | Props ) -> R.Element
...@@ -87,13 +85,11 @@ ngramsView :: R2.Component NgramsViewProps ...@@ -87,13 +85,11 @@ ngramsView :: R2.Component NgramsViewProps
ngramsView = R.createElement ngramsViewCpt ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewProps ngramsViewCpt :: R.Component NgramsViewProps
ngramsViewCpt = here.component "ngramsView" cpt where ngramsViewCpt = here.component "ngramsView" cpt where
cpt props@{ boxes cpt props@{ cacheState
, cacheState
, corpusData: { defaultListId } , corpusData: { defaultListId }
, mode , mode
, session , session
, path , path } _ = do
, sidePanel } _ = do
chartsReload <- T.useBox T2.newReload chartsReload <- T.useBox T2.newReload
onCancelRef <- R.useRef Nothing onCancelRef <- R.useRef Nothing
onNgramsClickRef <- R.useRef Nothing onNgramsClickRef <- R.useRef Nothing
...@@ -106,8 +102,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -106,8 +102,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
R.fragment R.fragment
[ [
ngramsView' ngramsView'
{ boxes { corpusData: props.corpusData
, corpusData: props.corpusData
, listIds , listIds
, mode , mode
, nodeId , nodeId
...@@ -117,12 +112,10 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -117,12 +112,10 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, ,
NT.mainNgramsTable NT.mainNgramsTable
{ afterSync: afterSync chartsReload { afterSync: afterSync chartsReload
, boxes
, cacheState , cacheState
, defaultListId , defaultListId
, path , path
, session , session
, sidePanel
, tabNgramType , tabNgramType
, tabType , tabType
, treeEdit: { box: treeEditBox , treeEdit: { box: treeEditBox
...@@ -156,8 +149,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -156,8 +149,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
-- @XXX re-render issue -> clone component -- @XXX re-render issue -> clone component
type NgramsViewProps' = type NgramsViewProps' =
( boxes :: Boxes ( corpusData :: CorpusData
, corpusData :: CorpusData
, listIds :: Array Int , listIds :: Array Int
, mode :: Mode , mode :: Mode
, nodeId :: Int , nodeId :: Int
...@@ -171,8 +163,7 @@ ngramsView' = R.createElement ngramsViewCpt' ...@@ -171,8 +163,7 @@ ngramsView' = R.createElement ngramsViewCpt'
--ngramsViewCpt' = R.memo' $ here.component "ngramsView_clone" cpt where --ngramsViewCpt' = R.memo' $ here.component "ngramsView_clone" cpt where
ngramsViewCpt' :: R.Component NgramsViewProps' ngramsViewCpt' :: R.Component NgramsViewProps'
ngramsViewCpt' = here.component "ngramsView_clone" cpt where ngramsViewCpt' = here.component "ngramsView_clone" cpt where
cpt { boxes cpt { corpusData: { defaultListId }
, corpusData: { defaultListId }
, listIds , listIds
, mode , mode
, nodeId , nodeId
...@@ -232,10 +223,10 @@ ngramsViewCpt' = here.component "ngramsView_clone" cpt where ...@@ -232,10 +223,10 @@ ngramsViewCpt' = here.component "ngramsView_clone" cpt where
] ]
charts params' _ = [ chart params' mode ] charts params' _ = [ chart params' mode ]
chart path Authors = pie { boxes, path, session, onClick: Nothing, onInit: Nothing } chart path Authors = pie { path, session, onClick: Nothing, onInit: Nothing }
chart path Institutes = tree { boxes, path, session, onClick: Nothing, onInit: Nothing } chart path Institutes = tree { path, session, onClick: Nothing, onInit: Nothing }
chart path Sources = bar { boxes, path, session, onClick: Nothing, onInit: Nothing } chart path Sources = bar { path, session, onClick: Nothing, onInit: Nothing }
chart path Terms = metrics { boxes, path, session, onClick: Nothing, onInit: Nothing } chart path Terms = metrics { path, session, onClick: Nothing, onInit: Nothing }
tabType = TabCorpus (TabNgramType tabNgramType) tabType = TabCorpus (TabNgramType tabNgramType)
......
This diff is collapsed.
...@@ -36,11 +36,11 @@ type Props = ...@@ -36,11 +36,11 @@ type Props =
docFocus :: R2.Leaf ( key :: String | Props ) docFocus :: R2.Leaf ( key :: String | Props )
docFocus = R2.leaf docFocusCpt docFocus = R2.leaf docFocusCpt
docFocusCpt :: R.Component ( key :: String | Props ) docFocusCpt :: R.Component ( key :: String | Props )
docFocusCpt = here.component "main" cpt where docFocusCpt = R2.hereComponent here "main" hCpt where
cpt { frameDoc: FrameDoc { docId, listId, corpusId } hCpt hp { frameDoc: FrameDoc { docId, listId, corpusId }
, session , session
, closeCallback , closeCallback
} _ = do } _ = do
-- | States -- | States
-- | -- |
state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData) state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
...@@ -64,7 +64,7 @@ docFocusCpt = here.component "main" cpt where ...@@ -64,7 +64,7 @@ docFocusCpt = here.component "main" cpt where
-- | Hooks -- | Hooks
-- | -- |
useLoaderEffect useLoaderEffect
{ errorHandler: logRESTError here "[docFocus]" { errorHandler: logRESTError hp
, loader: loadData , loader: loadData
, path , path
, state , state
......
...@@ -63,79 +63,78 @@ data RangeUpdate = SetMin Number | SetMax Number ...@@ -63,79 +63,78 @@ data RangeUpdate = SetMin Number | SetMax Number
rangeSlider :: Record Props -> R.Element rangeSlider :: Record Props -> R.Element
rangeSlider props = R.createElement rangeSliderCpt props [] rangeSlider props = R.createElement rangeSliderCpt props []
rangeSliderCpt :: R.Component Props rangeSliderCpt :: R.Component Props
rangeSliderCpt = here.component "rangeSlider" cpt rangeSliderCpt = here.component "rangeSlider" cpt where
where cpt props _ = do
cpt props _ = do -- rounding precision (i.e. how many decimal digits are in epsilon)
-- rounding precision (i.e. how many decimal digits are in epsilon) let (Range.Closed { min: minR, max: maxR }) = props.initialValue
let (Range.Closed { min: minR, max: maxR }) = props.initialValue let decPrecision num =
let decPrecision num = -- int digits
-- int digits (fromMaybe 0 $ fromNumber $ DN.ceil $ (DN.log num) / DN.ln10)
(fromMaybe 0 $ fromNumber $ DN.ceil $ (DN.log num) / DN.ln10) -- float digits
-- float digits + (fromMaybe 0 $ fromNumber $ DN.ceil $ -(DN.log (num - (DN.floor num))) / DN.ln10)
+ (fromMaybe 0 $ fromNumber $ DN.ceil $ -(DN.log (num - (DN.floor num))) / DN.ln10) let epsilonPrecision = decPrecision props.epsilon
let epsilonPrecision = decPrecision props.epsilon let minPrecision = decPrecision minR
let minPrecision = decPrecision minR let maxPrecision = decPrecision maxR
let maxPrecision = decPrecision maxR --let precision = fromMaybe 0 $ fromNumber $ max 0.0 epsilonPrecision
--let precision = fromMaybe 0 $ fromNumber $ max 0.0 epsilonPrecision let precision = fromMaybe 0 $ maximum [0, epsilonPrecision, minPrecision, maxPrecision]
let precision = fromMaybe 0 $ maximum [0, epsilonPrecision, minPrecision, maxPrecision]
-- scale bar
-- scale bar scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref -- scale sel bar
-- scale sel bar scaleSelElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
scaleSelElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref -- low knob
-- low knob lowElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the low knob
lowElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the low knob -- high knob
-- high knob highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the high knob
highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the high knob -- The value of the user's selection
-- The value of the user's selection value <- T.useBox $ initialValue props
value <- T.useBox $ initialValue props value' <- T.useLive T.unequal value
value' <- T.useLive T.unequal value
-- the knob we are currently in a drag for. set by mousedown on a knob
-- the knob we are currently in a drag for. set by mousedown on a knob dragKnob <- T.useBox (Nothing :: Maybe Knob)
dragKnob <- T.useBox (Nothing :: Maybe Knob) dragKnob' <- T.useLive T.unequal dragKnob
dragKnob' <- T.useLive T.unequal dragKnob
-- the handler functions for trapping mouse events, so they can be removed
-- the handler functions for trapping mouse events, so they can be removed mouseMoveHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
mouseMoveHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent))) mouseUpHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
mouseUpHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent))) let destroy = \_ -> do
let destroy = \_ -> do destroyEventHandler "mousemove" mouseMoveHandler
destroyEventHandler "mousemove" mouseMoveHandler destroyEventHandler "mouseup" mouseUpHandler
destroyEventHandler "mouseup" mouseUpHandler R.setRef mouseMoveHandler $ Nothing
R.setRef mouseMoveHandler $ Nothing R.setRef mouseUpHandler $ Nothing
R.setRef mouseUpHandler $ Nothing
R2.useLayoutEffect1' dragKnob' $ \_ -> do
R2.useLayoutEffect1' dragKnob' $ \_ -> do let scalePos = R2.readPositionRef scaleElem
let scalePos = R2.readPositionRef scaleElem let lowPos = R2.readPositionRef lowElem
let lowPos = R2.readPositionRef lowElem let highPos = R2.readPositionRef highElem
let highPos = R2.readPositionRef highElem
case dragKnob' of
case dragKnob' of Just knob -> do
Just knob -> do let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of
case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of Just val -> do
Just val -> do setKnob knob value value' val
setKnob knob value value' val props.onChange $ knobSetter knob value' val
props.onChange $ knobSetter knob value' val Nothing -> destroy unit
Nothing -> destroy unit let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do
let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do --props.onChange $ knobSetter knob value val
--props.onChange $ knobSetter knob value val T.write_ Nothing dragKnob
T.write_ Nothing dragKnob destroy unit
destroy unit EL.addEventListener document "mousemove" onMouseMove
EL.addEventListener document "mousemove" onMouseMove EL.addEventListener document "mouseup" onMouseUp
EL.addEventListener document "mouseup" onMouseUp R.setRef mouseMoveHandler $ Just onMouseMove
R.setRef mouseMoveHandler $ Just onMouseMove R.setRef mouseUpHandler $ Just onMouseUp
R.setRef mouseUpHandler $ Just onMouseUp Nothing -> destroy unit
Nothing -> destroy unit pure $ H.div { className, aria }
pure $ H.div { className, aria } [ renderScale scaleElem props value'
[ renderScale scaleElem props value' , renderScaleSel scaleSelElem props value'
, renderScaleSel scaleSelElem props value' , renderKnob MinKnob lowElem value' props.bounds dragKnob precision props.status
, renderKnob MinKnob lowElem value' props.bounds dragKnob precision props.status , renderKnob MaxKnob highElem value' props.bounds dragKnob precision props.status
, renderKnob MaxKnob highElem value' props.bounds dragKnob precision props.status ]
] className = "range-slider"
className = "range-slider" aria = { label: "Range Slider Control. Expresses filtering data by a minimum and maximum value range through two slider knobs. Knobs can be adjusted with the arrow keys." }
aria = { label: "Range Slider Control. Expresses filtering data by a minimum and maximum value range through two slider knobs. Knobs can be adjusted with the arrow keys." }
destroyEventHandler destroyEventHandler
:: forall e :: forall e
......
...@@ -37,7 +37,7 @@ import Gargantext.Components.Tile (tileBlock) ...@@ -37,7 +37,7 @@ import Gargantext.Components.Tile (tileBlock)
import Gargantext.Components.TopBar as TopBar import Gargantext.Components.TopBar as TopBar
import Gargantext.Components.TreeSearch (treeSearch) import Gargantext.Components.TreeSearch (treeSearch)
import Gargantext.Config (defaultFrontends, defaultBackends) import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Config.REST (AffRESTError, logRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Context.Session as SessionContext import Gargantext.Context.Session as SessionContext
import Gargantext.Ends (Backend) import Gargantext.Ends (Backend)
import Gargantext.Hooks.Resize (ResizeType(..), useResizeHandler) import Gargantext.Hooks.Resize (ResizeType(..), useResizeHandler)
...@@ -279,8 +279,7 @@ forestCpt = R.memo' $ here.component "forest" cpt where ...@@ -279,8 +279,7 @@ forestCpt = R.memo' $ here.component "forest" cpt where
{ className: "router__aside__inner" } { className: "router__aside__inner" }
[ [
forestLayout forestLayout
{ boxes { frontends: defaultFrontends
, frontends: defaultFrontends
} }
] ]
, ,
...@@ -518,7 +517,7 @@ dashboardCpt = here.component "dashboard" cpt ...@@ -518,7 +517,7 @@ dashboardCpt = here.component "dashboard" cpt
cpt props@{ boxes, nodeId } _ = do cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session -> pure $ authed (Record.merge { content: \session ->
dashboardLayout { boxes, nodeId, session } [] } sessionProps) [] dashboardLayout { nodeId, session } [] } sessionProps) []
-------------------------------------------------------------- --------------------------------------------------------------
...@@ -730,12 +729,10 @@ user :: R2.Component SessionNodeProps ...@@ -730,12 +729,10 @@ user :: R2.Component SessionNodeProps
user = R.createElement userCpt user = R.createElement userCpt
userCpt :: R.Component SessionNodeProps userCpt :: R.Component SessionNodeProps
userCpt = here.component "user" cpt where userCpt = here.component "user" cpt where
cpt props@{ boxes cpt props@{ nodeId } _ = do
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session -> pure $ authed (Record.merge { content: \session ->
userLayout { boxes userLayout { frontends: defaultFrontends
, frontends: defaultFrontends
, nodeId , nodeId
, session } [] } sessionProps) [] , session } [] } sessionProps) []
......
...@@ -62,10 +62,10 @@ tab :: R2.Component TabProps ...@@ -62,10 +62,10 @@ tab :: R2.Component TabProps
tab = R.createElement tabCpt tab = R.createElement tabCpt
-- | A tab only shows its contents if it is currently selected -- | A tab only shows its contents if it is currently selected
tabCpt :: R.Component TabProps tabCpt :: R.Component TabProps
tabCpt = here.component "tab" cpt tabCpt = here.component "tab" cpt where
where cpt { selected, index } children = do
cpt { selected, index } children = pure $ H.div { className } children' pure $ H.div { className } children'
where where
same = selected == index same = selected == index
className = "tab-pane" <> (if same then "show active" else "fade") className = "tab-pane" <> (if same then "show active" else "fade")
children' = if same then children else [] children' = if same then children else []
...@@ -104,7 +104,6 @@ tableHeaderWithRenameLayoutCpt = here.component "tableHeaderWithRenameLayoutCpt" ...@@ -104,7 +104,6 @@ tableHeaderWithRenameLayoutCpt = here.component "tableHeaderWithRenameLayoutCpt"
tableHeaderWithRenameBoxedLayout :: R2.Component TableHeaderWithRenameBoxedLayoutProps tableHeaderWithRenameBoxedLayout :: R2.Component TableHeaderWithRenameBoxedLayoutProps
tableHeaderWithRenameBoxedLayout = R.createElement tableHeaderWithRenameBoxedLayoutCpt tableHeaderWithRenameBoxedLayout = R.createElement tableHeaderWithRenameBoxedLayoutCpt
tableHeaderWithRenameBoxedLayoutCpt :: R.Component TableHeaderWithRenameBoxedLayoutProps tableHeaderWithRenameBoxedLayoutCpt :: R.Component TableHeaderWithRenameBoxedLayoutProps
tableHeaderWithRenameBoxedLayoutCpt = here.component "tableHeaderWithRenameBoxedLayoutCpt" cpt tableHeaderWithRenameBoxedLayoutCpt = here.component "tableHeaderWithRenameBoxedLayoutCpt" cpt
where where
...@@ -120,8 +119,7 @@ tableHeaderWithRenameBoxedLayoutCpt = here.component "tableHeaderWithRenameBoxed ...@@ -120,8 +119,7 @@ tableHeaderWithRenameBoxedLayoutCpt = here.component "tableHeaderWithRenameBoxed
cacheState' <- T.useLive T.unequal cacheState cacheState' <- T.useLive T.unequal cacheState
CorpusInfo {title, desc, query, authors} <- T.read corpusInfoS CorpusInfo {title, desc, query, authors} <- T.read corpusInfoS
{ expandTableEdition { expandTableEdition } <- AppStore.use
} <- AppStore.use
expandTableEdition' <- R2.useLive' expandTableEdition expandTableEdition' <- R2.useLive' expandTableEdition
......
...@@ -75,29 +75,27 @@ type ThemeSwitcherProps = ( ...@@ -75,29 +75,27 @@ type ThemeSwitcherProps = (
themeSwitcher :: R2.Component ThemeSwitcherProps themeSwitcher :: R2.Component ThemeSwitcherProps
themeSwitcher = R.createElement themeSwitcherCpt themeSwitcher = R.createElement themeSwitcherCpt
themeSwitcherCpt :: R.Component ThemeSwitcherProps themeSwitcherCpt :: R.Component ThemeSwitcherProps
themeSwitcherCpt = here.component "themeSwitcher" cpt themeSwitcherCpt = here.component "themeSwitcher" cpt where
where cpt { theme, themes } _ = do
cpt { theme, themes } _ = do currentTheme <- T.useLive T.unequal theme
currentTheme <- T.useLive T.unequal theme
let option (Theme { name }) = H.option { value: name } [ H.text name ]
let option (Theme { name }) = H.option { value: name } [ H.text name ] let options = map option themes
let options = map option themes
R.useEffectOnce' $ markThemeToDOMTree currentTheme
R.useEffectOnce' $ markThemeToDOMTree currentTheme
pure $ R2.select { className: "form-control rounded-circle-2"
pure $ R2.select { className: "form-control rounded-circle-2" , defaultValue: themeName currentTheme
, defaultValue: themeName currentTheme , on: { change: onChange theme } } options
, on: { change: onChange theme } } options where
where onChange box e = do
onChange box e = do let value = R.unsafeEventValue e
let value = R.unsafeEventValue e let mTheme = A.head $ A.filter (\(Theme { name }) -> value == name) themes
let mTheme = A.head $ A.filter (\(Theme { name }) -> value == name) themes
case mTheme of
case mTheme of Nothing -> pure unit
Nothing -> pure unit Just t -> do
Just t -> do switchTheme t
switchTheme t markThemeToDOMTree t
markThemeToDOMTree t T.write_ t box
T.write_ t box
...@@ -333,8 +333,7 @@ handedChooserCpt = here.component "handedChooser" cpt where ...@@ -333,8 +333,7 @@ handedChooserCpt = here.component "handedChooser" cpt where
cpt _ _ = do cpt _ _ = do
-- | States -- | States
-- | -- |
{ handed { handed } <- AppStore.use
} <- AppStore.use
handed' <- R2.useLive' handed handed' <- R2.useLive' handed
......
...@@ -9,7 +9,7 @@ import Gargantext.Components.Bootstrap (formSelect') ...@@ -9,7 +9,7 @@ import Gargantext.Components.Bootstrap (formSelect')
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), ModalSizing(..), Position(..), TooltipPosition(..), Variant(..)) import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), ModalSizing(..), Position(..), TooltipPosition(..), Variant(..))
import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Config.REST (AffRESTError, logRESTError) import Gargantext.Config.REST (AffRESTError)
import Gargantext.Hooks.LinkHandler (useLinkHandler) import Gargantext.Hooks.LinkHandler (useLinkHandler)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute(..), appPath, nodeTypeAppRoute) import Gargantext.Routes (AppRoute(..), appPath, nodeTypeAppRoute)
...@@ -142,16 +142,15 @@ treeSearchContainer :: R2.Leaf ContainerProps ...@@ -142,16 +142,15 @@ treeSearchContainer :: R2.Leaf ContainerProps
treeSearchContainer = R2.leaf treeSearchContainerCpt treeSearchContainer = R2.leaf treeSearchContainerCpt
treeSearchContainerCpt :: R.Component ContainerProps treeSearchContainerCpt :: R.Component ContainerProps
treeSearchContainerCpt = here.component "treeSearchContainerCpt" cpt where treeSearchContainerCpt = R2.hereComponent here "treeSearchContainerCpt" hCpt where
cpt {query, visible, session } _ = do hCpt hp {query, visible, session } _ = do
useLoader { errorHandler useLoader { errorHandler: Nothing
, herePrefix: hp
, path: { session, query } , path: { session, query }
, loader: loadSearch , loader: loadSearch
, render: \searchData -> treeSearchRenderContainer { visible, session, searchData } , render: \searchData -> treeSearchRenderContainer { visible, session, searchData }
} }
where
errorHandler = logRESTError here "[treeSearchContainer]"
treeSearchRenderContainer :: R2.Leaf RenderContainerProps treeSearchRenderContainer :: R2.Leaf RenderContainerProps
treeSearchRenderContainer = R2.leaf treeSearchRenderContainerCpt treeSearchRenderContainer = R2.leaf treeSearchRenderContainerCpt
......
...@@ -16,6 +16,7 @@ import Data.Maybe (Maybe(..)) ...@@ -16,6 +16,7 @@ import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData) import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
...@@ -171,10 +172,12 @@ instance JSON.ReadForeign FrontendError where ...@@ -171,10 +172,12 @@ instance JSON.ReadForeign FrontendError where
pure $ EC_500__node_generic_exception { error } pure $ EC_500__node_generic_exception { error }
"EC_500__node_not_implemented_yet" -> do "EC_500__node_not_implemented_yet" -> do
pure $ EC_500__node_not_implemented_yet pure $ EC_500__node_not_implemented_yet
_ -> Foreign.fail $ Foreign.ForeignError $ "deserialization for '" <> type_ <> "' not implemented" _ -> do
Foreign.fail $ Foreign.ForeignError $ "deserialization for '" <> type_ <> "' not implemented"
logRESTError :: R2.Here -> String -> RESTError -> Effect Unit
logRESTError here' prefix e = here'.warn2 (prefix <> " " <> show e) e logRESTError :: R2.HerePrefix -> RESTError -> Effect Unit
logRESTError (R2.HerePrefix { here: here', prefix }) e = here'.warn2 (prefix <> " " <> show e) e
-- logRESTError here prefix (SendResponseError e) = here.warn2 (prefix <> " SendResponseError ") e -- TODO: No show -- logRESTError here prefix (SendResponseError e) = here.warn2 (prefix <> " SendResponseError ") e -- TODO: No show
-- logRESTError here prefix (ReadJSONError e) = here.warn2 (prefix <> " ReadJSONError ") $ show e -- logRESTError here prefix (ReadJSONError e) = here.warn2 (prefix <> " ReadJSONError ") $ show e
-- logRESTError here prefix (CustomError e) = here.warn2 (prefix <> " CustomError ") $ e -- logRESTError here prefix (CustomError e) = here.warn2 (prefix <> " CustomError ") $ e
......
...@@ -18,14 +18,14 @@ here :: R2.Here ...@@ -18,14 +18,14 @@ here :: R2.Here
here = R2.here "Gargantext.Config.Utils" here = R2.here "Gargantext.Config.Utils"
handleRESTError :: forall a. handleRESTError :: forall a.
R2.Here R2.HerePrefix
-> T.Box (Array FrontendError) -> T.Box (Array FrontendError)
-> Either RESTError a -> Either RESTError a
-> (a -> Aff Unit) -> (a -> Aff Unit)
-> Aff Unit -> Aff Unit
handleRESTError here' errors (Left error) _ = liftEffect $ do handleRESTError herePrefix errors (Left error) _ = liftEffect $ do
T.modify_ (A.cons $ FRESTError { error }) errors T.modify_ (A.cons $ FRESTError { error }) errors
logRESTError here' "[handleTaskError]" error logRESTError herePrefix error
-- here.warn2 "[handleTaskError] RESTError" error -- here.warn2 "[handleTaskError] RESTError" error
handleRESTError _ _ (Right task) handler = handler task handleRESTError _ _ (Right task) handler = handler task
......
...@@ -13,6 +13,7 @@ import Effect (Effect) ...@@ -13,6 +13,7 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Timer (IntervalId, clearInterval, setInterval) import Effect.Timer (IntervalId, clearInterval, setInterval)
import Gargantext.Components.App.Store as AppStore
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (QueryProgressData, queryProgress) import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (QueryProgressData, queryProgress)
import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError) import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError)
import Gargantext.Hooks.FirstEffect (useFirstEffect') import Gargantext.Hooks.FirstEffect (useFirstEffect')
...@@ -26,7 +27,6 @@ import Toestand as T ...@@ -26,7 +27,6 @@ import Toestand as T
type AsyncProps = type AsyncProps =
( asyncTask :: GT.AsyncTaskWithType ( asyncTask :: GT.AsyncTaskWithType
, errors :: T.Box (Array FrontendError)
, nodeId :: GT.ID , nodeId :: GT.ID
, onFinish :: Unit -> Effect Unit , onFinish :: Unit -> Effect Unit
, session :: Session , session :: Session
...@@ -38,10 +38,10 @@ here = R2.here "Gargantext.Context.Progress" ...@@ -38,10 +38,10 @@ here = R2.here "Gargantext.Context.Progress"
asyncProgress :: R2.Component AsyncProps asyncProgress :: R2.Component AsyncProps
asyncProgress = R2.component asyncProgressCpt asyncProgress = R2.component asyncProgressCpt
asyncProgressCpt :: R.Component AsyncProps asyncProgressCpt :: R.Component AsyncProps
asyncProgressCpt = R.hooksComponent "asyncProgress" cpt where asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
cpt props@{ errors hCpt hp props@{ onFinish } children = do
, onFinish { errors } <- AppStore.use
} children = do
-- States -- States
progress /\ progressBox <- R2.useBox' 0.0 progress /\ progressBox <- R2.useBox' 0.0
intervalIdRef <- R.useRef (Nothing :: Maybe IntervalId) intervalIdRef <- R.useRef (Nothing :: Maybe IntervalId)
...@@ -62,7 +62,7 @@ asyncProgressCpt = R.hooksComponent "asyncProgress" cpt where ...@@ -62,7 +62,7 @@ asyncProgressCpt = R.hooksComponent "asyncProgress" cpt where
Right _ -> T.write_ 1000 interval Right _ -> T.write_ 1000 interval
interval' <- T.read interval interval' <- T.read interval
resetInterval intervalIdRef (Just interval') exec resetInterval intervalIdRef (Just interval') exec
handleRESTError here errors eAsyncProgress onProgress handleRESTError hp errors eAsyncProgress onProgress
onProgress :: AsyncProgress -> Aff Unit onProgress :: AsyncProgress -> Aff Unit
onProgress value = liftEffect do onProgress value = liftEffect do
......
...@@ -450,7 +450,7 @@ syncPatches props state callback = do ...@@ -450,7 +450,7 @@ syncPatches props state callback = do
launchAff_ $ do launchAff_ $ do
ePatches <- putNgramsPatches props pt ePatches <- putNgramsPatches props pt
case ePatches of case ePatches of
Left err -> liftEffect $ logRESTError here "[syncPatches]" err Left err -> liftEffect $ logRESTError (R2.herePrefix here "[syncPatches]") err
Right (Versioned { data: newPatch, version: newVersion }) -> do Right (Versioned { data: newPatch, version: newVersion }) -> do
callback unit callback unit
liftEffect $ do liftEffect $ do
...@@ -585,8 +585,7 @@ chartsAfterSync :: forall props discard. ...@@ -585,8 +585,7 @@ chartsAfterSync :: forall props discard.
-> Aff Unit -> Aff Unit
chartsAfterSync path'@{ nodeId } errors tasks _ = do chartsAfterSync path'@{ nodeId } errors tasks _ = do
eTask <- postNgramsChartsAsync path' eTask <- postNgramsChartsAsync path'
handleRESTError here errors eTask $ \task -> liftEffect $ do handleRESTError (R2.herePrefix here "[chartsAfterSync]") errors eTask $ \task -> liftEffect $ do
here.log2 "[chartsAfterSync] Synchronize task" task
GAT.insert nodeId task tasks GAT.insert nodeId task tasks
postNgramsChartsAsync :: forall s. CoreParams s -> AffRESTError AsyncTaskWithType postNgramsChartsAsync :: forall s. CoreParams s -> AffRESTError AsyncTaskWithType
......
...@@ -11,9 +11,9 @@ import Effect (Effect) ...@@ -11,9 +11,9 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError) import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store as Store
import Gargantext.Components.LoadingSpinner (loadingSpinner) import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Config.REST (RESTError, AffRESTError) import Gargantext.Config.REST (RESTError, AffRESTError, logRESTError)
import Gargantext.Config.Utils (handleRESTError) import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Types (FrontendError(..)) import Gargantext.Types (FrontendError(..))
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
...@@ -33,7 +33,8 @@ clearCache :: Unit -> Aff Unit ...@@ -33,7 +33,8 @@ clearCache :: Unit -> Aff Unit
clearCache _ = GUC.delete $ GUC.CacheName cacheName clearCache _ = GUC.delete $ GUC.CacheName cacheName
type UseLoader path state = type UseLoader path state =
( errorHandler :: RESTError -> Effect Unit ( errorHandler :: Maybe (RESTError -> Effect Unit)
, herePrefix :: R2.HerePrefix
, loader :: path -> AffRESTError state , loader :: path -> AffRESTError state
, path :: path , path :: path
, render :: state -> R.Element , render :: state -> R.Element
...@@ -42,7 +43,39 @@ type UseLoader path state = ...@@ -42,7 +43,39 @@ type UseLoader path state =
useLoader :: forall path st. Eq path => Eq st useLoader :: forall path st. Eq path => Eq st
=> Record (UseLoader path st) => Record (UseLoader path st)
-> R.Hooks R.Element -> R.Hooks R.Element
useLoader { errorHandler, loader: loader', path, render } = do useLoader props@{ errorHandler
, herePrefix
, loader
, path
, render } = do
{ errors } <- Store.use
state <- T.useBox Nothing
useLoader' { errorHandler: errorHandler' errors
, loader
, path
, render }
where
errorHandler' errors error = do
T.modify_ (A.cons $ FRESTError { error }) errors
-- default error handler
case errorHandler of
Nothing -> logRESTError herePrefix error
Just eh -> eh error
-- | Version that doesn't use boxes for errors, prefer unticked one
type UseLoader' path state =
( errorHandler :: RESTError -> Effect Unit
, loader :: path -> AffRESTError state
, path :: path
, render :: state -> R.Element
)
useLoader' :: forall path st. Eq path => Eq st
=> Record (UseLoader' path st)
-> R.Hooks R.Element
useLoader' { errorHandler, loader: loader', path, render } = do
state <- T.useBox Nothing state <- T.useBox Nothing
useLoaderEffect { errorHandler, loader: loader', path, state: state } useLoaderEffect { errorHandler, loader: loader', path, state: state }
...@@ -93,7 +126,8 @@ useLoaderEffect { errorHandler, loader: loader', path, state } = do ...@@ -93,7 +126,8 @@ useLoaderEffect { errorHandler, loader: loader', path, state } = do
type UseLoaderBox path state = type UseLoaderBox path state =
( errorHandler :: RESTError -> Effect Unit ( errorHandler :: Maybe (RESTError -> Effect Unit)
, herePrefix :: R2.HerePrefix
, loader :: path -> AffRESTError state , loader :: path -> AffRESTError state
, path :: T.Box path , path :: T.Box path
, render :: state -> R.Element , render :: state -> R.Element
...@@ -102,10 +136,14 @@ type UseLoaderBox path state = ...@@ -102,10 +136,14 @@ type UseLoaderBox path state =
useLoaderBox :: forall path st. Eq path => Eq st useLoaderBox :: forall path st. Eq path => Eq st
=> Record (UseLoaderBox path st) => Record (UseLoaderBox path st)
-> R.Hooks R.Element -> R.Hooks R.Element
useLoaderBox { errorHandler, loader: loader', path, render } = do useLoaderBox { errorHandler, herePrefix, loader: loader', path, render } = do
path' <- T.useLive T.unequal path path' <- T.useLive T.unequal path
useLoader { errorHandler, loader: loader', path: path', render } useLoader { errorHandler
, herePrefix
, loader: loader'
, path: path'
, render }
newtype HashedResponse a = HashedResponse { hash :: Hash, value :: a } newtype HashedResponse a = HashedResponse { hash :: Hash, value :: a }
...@@ -115,8 +153,7 @@ derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (HashedResponse a ...@@ -115,8 +153,7 @@ derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (HashedResponse a
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (HashedResponse a) derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (HashedResponse a)
type LoaderWithCacheAPIProps path res ret = type LoaderWithCacheAPIProps path res ret =
( boxes :: Boxes ( cacheEndpoint :: path -> AffRESTError Hash
, cacheEndpoint :: path -> AffRESTError Hash
, handleResponse :: HashedResponse res -> ret , handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
...@@ -128,8 +165,7 @@ useLoaderWithCacheAPI :: forall path res ret. ...@@ -128,8 +165,7 @@ useLoaderWithCacheAPI :: forall path res ret.
Eq ret => Eq path => JSON.ReadForeign res => Eq ret => Eq path => JSON.ReadForeign res =>
Record (LoaderWithCacheAPIProps path res ret) Record (LoaderWithCacheAPIProps path res ret)
-> R.Hooks R.Element -> R.Hooks R.Element
useLoaderWithCacheAPI { boxes useLoaderWithCacheAPI { cacheEndpoint
, cacheEndpoint
, handleResponse , handleResponse
, mkRequest , mkRequest
, path , path
...@@ -138,8 +174,7 @@ useLoaderWithCacheAPI { boxes ...@@ -138,8 +174,7 @@ useLoaderWithCacheAPI { boxes
state <- T.useBox Nothing state <- T.useBox Nothing
state' <- T.useLive T.unequal state state' <- T.useLive T.unequal state
useCachedAPILoaderEffect { boxes useCachedAPILoaderEffect { cacheEndpoint
, cacheEndpoint
, handleResponse , handleResponse
, mkRequest , mkRequest
, path , path
...@@ -147,8 +182,7 @@ useLoaderWithCacheAPI { boxes ...@@ -147,8 +182,7 @@ useLoaderWithCacheAPI { boxes
pure $ maybe (loadingSpinner { additionalClass: spinnerClass }) renderer state' pure $ maybe (loadingSpinner { additionalClass: spinnerClass }) renderer state'
type LoaderWithCacheAPIEffectProps path res ret = ( type LoaderWithCacheAPIEffectProps path res ret = (
boxes :: Boxes cacheEndpoint :: path -> AffRESTError Hash
, cacheEndpoint :: path -> AffRESTError Hash
, handleResponse :: HashedResponse res -> ret , handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
...@@ -159,12 +193,12 @@ useCachedAPILoaderEffect :: forall path res ret. ...@@ -159,12 +193,12 @@ useCachedAPILoaderEffect :: forall path res ret.
Eq ret => Eq path => JSON.ReadForeign res => Eq ret => Eq path => JSON.ReadForeign res =>
Record (LoaderWithCacheAPIEffectProps path res ret) Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit -> R.Hooks Unit
useCachedAPILoaderEffect { boxes: { errors } useCachedAPILoaderEffect { cacheEndpoint
, cacheEndpoint
, handleResponse , handleResponse
, mkRequest , mkRequest
, path , path
, state } = do , state } = do
{ errors } <- Store.use
state' <- T.useLive T.unequal state state' <- T.useLive T.unequal state
oPath <- R.useRef path oPath <- R.useRef path
...@@ -181,7 +215,7 @@ useCachedAPILoaderEffect { boxes: { errors } ...@@ -181,7 +215,7 @@ useCachedAPILoaderEffect { boxes: { errors }
-- TODO Parallelize? -- TODO Parallelize?
hr@(HashedResponse { hash }) <- GUC.cachedJson cache req hr@(HashedResponse { hash }) <- GUC.cachedJson cache req
eCacheReal <- cacheEndpoint path eCacheReal <- cacheEndpoint path
handleRESTError here errors eCacheReal $ \cacheReal -> do handleRESTError (R2.herePrefix here "[useCachedAPILoaderEffect]") errors eCacheReal $ \cacheReal -> do
val <- if hash == cacheReal then val <- if hash == cacheReal then
pure hr pure hr
else do else do
......
...@@ -111,6 +111,25 @@ here mod = ...@@ -111,6 +111,25 @@ here mod =
, info3 : Console.print3 Console.Main mod Console.Info , info3 : Console.print3 Console.Main mod Console.Info
} }
type Prefix = String
newtype HerePrefix = HerePrefix { here :: Here
, prefix :: Prefix }
hpLog2 :: forall a b. HerePrefix -> a -> b -> Effect Unit
hpLog2 (HerePrefix { here: h, prefix }) = h.log3 prefix
hpWarn2 :: forall a b. HerePrefix -> a -> b -> Effect Unit
hpWarn2 (HerePrefix { here: h, prefix }) = h.warn3 prefix
herePrefix :: Here -> Prefix -> HerePrefix
herePrefix here prefix = HerePrefix { here, prefix }
hereComponent :: forall p. Here -> Prefix -> (HerePrefix -> R.HooksComponent p) -> R.Component p
hereComponent here' prefix hpComponent = here'.component prefix (hpComponent hp)
where
hp :: HerePrefix
hp = herePrefix here' prefix
-- newtypes -- newtypes
type NTHooksComponent props = props -> Array R.Element -> R.Hooks R.Element type NTHooksComponent props = props -> Array R.Element -> R.Hooks R.Element
newtype NTComponent p = NTComponent (EffectFn1 p R.Element) newtype NTComponent p = NTComponent (EffectFn1 p R.Element)
......
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