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