Skip to content

P
purescript-gargantext
Commit 4da3ef16 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[errors] get rid of temporary throwError.*RESTError

parent c82a7f6b
Hide whitespace changes
Inline Side-by-side
Showing with 89 additions and 82 deletions
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ 4da3ef16
......@@ -4,9 +4,9 @@ module Gargantext.Components.GraphExplorer.Sidebar
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Control.Parallel (parTraverse)
import Data.Array (head, last, concat)
import Data.Array as A
import Data.Either (Either(..))
import Data.Int (fromString)
import Data.Map as Map
......@@ -14,7 +14,7 @@ import Data.Maybe (Maybe(..), fromJust)
import Data.Sequence as Seq
import Data.Set as Set
import Effect (Effect)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.GraphExplorer.Legend as Legend
import Gargantext.Components.GraphExplorer.Types as GET
......@@ -28,7 +28,7 @@ import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Types (CTabNgramType, FrontendError(..), NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Partial.Unsafe (unsafePartial)
......@@ -43,7 +43,8 @@ here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
type Common = (
graphId :: NodeID
errors :: T.Box (Array FrontendError)
, graphId :: NodeID
, metaData :: GET.MetaData
, reloadForest :: T2.ReloadS
, removedNodeIds :: T.Box SigmaxT.NodeIds
......@@ -61,7 +62,6 @@ type Props = (
sidebar :: R2.Component Props
sidebar = R.createElement sidebarCpt
sidebarCpt :: R.Component Props
sidebarCpt = here.component "sidebar" cpt
where
......@@ -86,7 +86,6 @@ type SideTabNavProps = (
sideTabNav :: R2.Component SideTabNavProps
sideTabNav = R.createElement sideTabNavCpt
sideTabNavCpt :: R.Component SideTabNavProps
sideTabNavCpt = here.component "sideTabNav" cpt
where
......@@ -111,11 +110,10 @@ type SideTabProps = Props
sideTabLegend :: R2.Component SideTabProps
sideTabLegend = R.createElement sideTabLegendCpt
sideTabLegendCpt :: R.Component SideTabProps
sideTabLegendCpt = here.component "sideTabLegend" cpt
where
cpt props@{ metaData: GET.MetaData { legend } } _ = do
cpt { metaData: GET.MetaData { legend } } _ = do
pure $ H.div {}
[ Legend.legend { items: Seq.fromFoldable legend }
, documentation EN
......@@ -123,7 +121,6 @@ sideTabLegendCpt = here.component "sideTabLegend" cpt
sideTabData :: R2.Component SideTabProps
sideTabData = R.createElement sideTabDataCpt
sideTabDataCpt :: R.Component SideTabProps
sideTabDataCpt = here.component "sideTabData" cpt
where
......@@ -143,18 +140,10 @@ sideTabDataCpt = here.component "sideTabData" cpt
} []
]
]
where
checkbox text = RH.li {}
[ RH.span {} [ RH.text text ]
, RH.input { type: "checkbox"
, className: "checkbox"
, defaultChecked: true
, title: "Mark as completed" } ]
sideTabCommunity :: R2.Component SideTabProps
sideTabCommunity = R.createElement sideTabCommunityCpt
sideTabCommunityCpt :: R.Component SideTabProps
sideTabCommunityCpt = here.component "sideTabCommunity" cpt
where
......@@ -185,7 +174,6 @@ type SelectedNodesProps = (
selectedNodes :: R2.Component SelectedNodesProps
selectedNodes = R.createElement selectedNodesCpt
selectedNodesCpt :: R.Component SelectedNodesProps
selectedNodesCpt = here.component "selectedNodes" cpt
where
......@@ -228,7 +216,6 @@ selectedNodesCpt = here.component "selectedNodes" cpt
neighborhood :: R2.Component Props
neighborhood = R.createElement neighborhoodCpt
neighborhoodCpt :: R.Component Props
neighborhoodCpt = here.component "neighborhood" cpt
where
......@@ -262,6 +249,7 @@ updateTermButtonCpt :: R.Component UpdateTermButtonProps
updateTermButtonCpt = here.component "updateTermButton" cpt
where
cpt { buttonType
, errors
, graphId
, metaData
, nodesMap
......@@ -280,10 +268,11 @@ updateTermButtonCpt = here.component "updateTermButton" cpt
, on: { click: onClickRemove selectedNodeIds' }
} [ RH.text text ]
where
onClickRemove selectedNodeIds' e = do
onClickRemove selectedNodeIds' _ = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap)
$ Set.toUnfoldable selectedNodeIds'
sendPatches { graphId: graphId
sendPatches { errors
, graphId: graphId
, metaData: metaData
, nodes
, session: session
......@@ -300,7 +289,7 @@ badge selectedNodeIds {id, label} =
, on: { click: onClick }
} [ RH.h6 {} [ RH.text label ] ]
where
onClick e = do
onClick _ = do
T.write_ (Set.singleton id) selectedNodeIds
badges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
......@@ -311,7 +300,8 @@ neighbourBadges graph selectedNodeIds = SigmaxT.neighbours graph selectedNodes'
selectedNodes' = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
type SendPatches =
( graphId :: NodeID
( errors :: T.Box (Array FrontendError)
, graphId :: NodeID
, metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node)
, reloadForest :: T2.ReloadS
......@@ -320,13 +310,15 @@ type SendPatches =
)
sendPatches :: Record SendPatches -> Effect Unit
sendPatches { metaData, nodes, session, termList, reloadForest } = do
sendPatches { errors, metaData, nodes, reloadForest, session, termList } = do
launchAff_ do
patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array NTC.VersionedNgramsPatches)
let mPatch = last patches
case mPatch of
Nothing -> pure unit
Just (Left _err) -> throwError $ error $ "[sendPatches] RESTError"
Just (Left err) -> liftEffect $ do
T.modify_ (A.cons $ FRESTError { error: err }) errors
here.log2 "[sendPatches] RESTError" err
Just (Right (NTC.Versioned _patch)) -> do
liftEffect $ T2.reload reloadForest
......@@ -341,7 +333,7 @@ sendPatch termList session (GET.MetaData metaData) node = do
case eRet of
Left err -> pure $ Left err
Right ret -> do
task <- NTC.postNgramsChartsAsync coreParams -- TODO add task
_task <- NTC.postNgramsChartsAsync coreParams -- TODO add task
pure $ Right ret
where
nodeId :: NodeID
......@@ -362,9 +354,6 @@ sendPatch termList session (GET.MetaData metaData) node = do
term :: NTC.NgramsTerm
term = NTC.normNgram tabNgramType node.label
pt :: NTC.NgramsTablePatch
pt = NTC.fromNgramsPatches np
np :: NTC.NgramsPatches
np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
......
src/Gargantext/Components/NgramsTable.purs
View file @ 4da3ef16
......@@ -26,11 +26,6 @@ import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.NgramsTable.Components as NTC
......@@ -43,12 +38,16 @@ import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Types (CTabNgramType, FrontendError, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Seq as Seq
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable"
......@@ -250,12 +249,13 @@ tableContainerCpt { dispatch
-- NEXT
type CommonProps = (
afterSync :: Unit -> Aff Unit
, reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, tabNgramType :: CTabNgramType
, tasks :: T.Box GAT.Storage
, withAutoUpdate :: Boolean
afterSync :: Unit -> Aff Unit
, errors :: T.Box (Array FrontendError)
, reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, tabNgramType :: CTabNgramType
, tasks :: T.Box GAT.Storage
, withAutoUpdate :: Boolean
)
type Props =
......@@ -273,6 +273,7 @@ loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
cpt { afterSync
, cacheState
, errors
, mTotalRows
, path
, reloadForest
......@@ -343,7 +344,7 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
totalRecords = fromMaybe (Seq.length rows) mTotalRows
afterSync' _ = do
chartsAfterSync path' tasks unit
chartsAfterSync path' errors tasks unit
afterSync unit
syncResetButton = syncResetButtons { afterSync: afterSync'
......@@ -509,12 +510,12 @@ selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ng
type MainNgramsTableProps = (
cacheState :: T.Box NT.CacheState
, defaultListId :: Int
cacheState :: T.Box NT.CacheState
, defaultListId :: Int
-- ^ This node can be a corpus or contact.
, path :: T.Box PageParams
, session :: Session
, tabType :: TabType
, path :: T.Box PageParams
, session :: Session
, tabType :: TabType
| CommonProps
)
......@@ -526,6 +527,7 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
cpt { afterSync
, cacheState
, defaultListId
, errors
, path
, reloadForest
, reloadRoot
......@@ -541,6 +543,7 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
NT.CacheOn -> do
let render versioned = mainNgramsTablePaint { afterSync
, cacheState: cacheState'
, errors
, path
, reloadForest
, reloadRoot
......@@ -560,6 +563,7 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
-- path <- R.useState' path
let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
, cacheState: cacheState'
, errors
, path
, reloadForest
, reloadRoot
......@@ -615,20 +619,20 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
handleResponse v = v
type MainNgramsTablePaintProps = (
cacheState :: NT.CacheState
, path :: T.Box PageParams
, versioned :: VersionedNgramsTable
cacheState :: NT.CacheState
, path :: T.Box PageParams
, versioned :: VersionedNgramsTable
| CommonProps
)
mainNgramsTablePaint :: R2.Component MainNgramsTablePaintProps
mainNgramsTablePaint = R.createElement mainNgramsTablePaintCpt
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
where
cpt { afterSync
, cacheState
, errors
, path
, reloadForest
, reloadRoot
......@@ -640,6 +644,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
pure $ loadedNgramsTable { afterSync
, cacheState
, errors
, mTotalRows: Nothing
, path
, reloadForest
......@@ -666,6 +671,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
where
cpt { afterSync
, cacheState
, errors
, path
, reloadForest
, reloadRoot
......@@ -680,6 +686,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
pure $ loadedNgramsTable {
afterSync
, cacheState
, errors
, mTotalRows: Just count
, path: path
, reloadForest
......
src/Gargantext/Components/NgramsTable/Core.purs
View file @ 4da3ef16
......@@ -81,8 +81,8 @@ module Gargantext.Components.NgramsTable.Core
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Control.Monad.State (class MonadState, execState)
import DOM.Simple.Console (log2)
import Data.Array (head)
import Data.Array as A
import Data.Bifunctor (lmap)
......@@ -120,7 +120,6 @@ import Data.Traversable (for, traverse_, traverse)
import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
......@@ -128,23 +127,23 @@ import Effect.Exception.Unsafe (unsafeThrow)
import FFI.Simple.Functions (delay)
import Foreign as F
import Foreign.Object as FO
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, post, put)
import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), FrontendError, ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.Either (eitherMap)
import Gargantext.Utils.KarpRabin (indicesOfAny)
import Gargantext.Utils.Reactix as R2
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Core"
......@@ -1117,21 +1116,20 @@ chartsAfterSync :: forall props discard.
, tabType :: TabType
| props
}
-> T.Box (Array FrontendError)
-> T.Box GAT.Storage
-> discard
-> Aff Unit
chartsAfterSync path'@{ nodeId } tasks _ = do
task <- postNgramsChartsAsync path'
liftEffect $ do
chartsAfterSync path'@{ nodeId } errors tasks _ = do
eTask <- postNgramsChartsAsync path'
handleRESTError errors eTask $ \task -> liftEffect $ do
log2 "[chartsAfterSync] Synchronize task" task
GAT.insert nodeId task tasks
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType
postNgramsChartsAsync :: forall s. CoreParams s -> Aff (Either RESTError AsyncTaskWithType)
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
eTask :: Either RESTError AsyncTask <- post session putNgramsAsync acu
case eTask of
Left _err -> liftEffect $ throwError $ error "[postNgramsChartsAsync] RESTError"
Right task -> pure $ AsyncTaskWithType { task, typ: UpdateNgramsCharts }
pure $ (\task -> AsyncTaskWithType { task, typ: UpdateNgramsCharts }) <$> eTask
where
acu = AsyncNgramsChartsUpdate { listId: head listIds
, tabType }
......
src/Gargantext/Components/Nodes/Annuaire/Tabs.purs
View file @ 4da3ef16
......@@ -113,10 +113,9 @@ type NgramsViewTabsProps =
ngramsView :: R2.Leaf NgramsViewTabsProps
ngramsView props = R.createElement ngramsViewCpt props []
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = here.component "ngramsView" cpt where
cpt props@{ defaultListId, mode, nodeId, session } _ = do
cpt props@{ defaultListId, errors, mode, nodeId, session } _ = do
path <- T.useBox $
NTC.initialPageParams session nodeId
[ defaultListId ] (TabDocument TabDocs)
......@@ -126,6 +125,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
props' path =
(Record.merge most
{ afterSync
, errors
, path
, tabType: TabPairing (TabNgramType $ modeTabType mode)
, tabNgramType: modeTabType' mode
......
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs
View file @ 4da3ef16
......@@ -92,29 +92,36 @@ tabsCpt = here.component "tabs" cpt
, "Trash" /\ docs -- TODO pass-in trash mode
]
where
patentsView = { reloadRoot
, tasks
, cacheState
patentsView = { cacheState
, defaultListId
, errors
, mode: Patents
, nodeId
, reloadForest
, session }
booksView = { reloadRoot
, reloadRoot
, session
, tasks
, cacheState
}
booksView = { cacheState
, defaultListId
, errors
, mode: Books
, nodeId
, reloadForest
, session }
commView = { reloadRoot, tasks
, cacheState
, reloadRoot
, session
, tasks
}
commView = { cacheState
, defaultListId
, errors
, mode: Communication
, nodeId
, reloadForest
, session }
, reloadRoot
, session
, tasks
}
chart = mempty
totalRecords = 4736 -- TODO
docs = DT.docViewLayout
......@@ -138,6 +145,7 @@ tabsCpt = here.component "tabs" cpt
type NgramsViewTabsProps = (
cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int
, errors :: T.Box (Array FrontendError)
, mode :: Mode
, nodeId :: Int
, reloadForest :: T2.ReloadS
......@@ -154,6 +162,7 @@ ngramsViewCpt = here.component "ngramsView" cpt
where
cpt { cacheState
, defaultListId
, errors
, reloadForest
, reloadRoot
, mode
......@@ -166,6 +175,7 @@ ngramsViewCpt = here.component "ngramsView" cpt
afterSync: \_ -> pure unit
, cacheState
, defaultListId
, errors
, path
, reloadForest
, reloadRoot
......
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @ 4da3ef16
......@@ -95,6 +95,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
<> [ NT.mainNgramsTable { afterSync: afterSync chartsReload
, cacheState
, defaultListId
, errors
, path
, reloadForest
, reloadRoot
......
src/Gargantext/Components/Router.purs
View file @ 4da3ef16
......@@ -224,7 +224,8 @@ openedSidePanel :: R2.Component (WithSession Props)
openedSidePanel = R.createElement openedSidePanelCpt
openedSidePanelCpt :: R.Component (WithSession Props)
openedSidePanelCpt = here.component "openedSidePanel" cpt where
cpt { boxes: { graphVersion
cpt { boxes: { errors
, graphVersion
, reloadForest
, route
, sidePanelGraph
......@@ -249,7 +250,8 @@ openedSidePanelCpt = here.component "openedSidePanel" cpt where
(_ /\ Nothing) -> pure $ wrapper []
(Just graph /\ Just metaData) -> do
pure $ wrapper
[ GES.sidebar { frontends: defaultFrontends
[ GES.sidebar { errors
, frontends: defaultFrontends
, graph
, graphId: g
, graphVersion
......
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