Commit c82a7f6b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[errors] implement errors view in various places

parent 85f4f9f2
Pipeline #1710 canceled with stage
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where
import Gargantext.Prelude
import Prelude
import Control.Monad.Error.Class (throwError)
import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array as A
import Data.Either (Either(..))
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Lens ((^.))
import Data.Lens.At (at)
......@@ -24,7 +19,7 @@ import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
......@@ -36,11 +31,11 @@ import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Prelude (class Ord, Unit, bind, const, discard, identity, mempty, otherwise, pure, show, unit, ($), (/=), (<$>), (<<<), (<>), (==))
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get, delete)
import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TableResult, TabSubType, TabType, showTabType')
import Gargantext.Types (FrontendError, ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TabSubType, TabType, TableResult, showTabType')
import Gargantext.Utils (sortWith)
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
......@@ -66,6 +61,7 @@ type Path a =
type CommonProps =
( cacheState :: T.Box NT.CacheState
, errors :: T.Box (Array FrontendError)
, frontends :: Frontends
, listId :: Int
, mCorpusId :: Maybe Int
......@@ -101,7 +97,6 @@ _localCategories = prop (SProxy :: SProxy "localCategories")
docViewLayout :: Record LayoutProps -> R.Element
docViewLayout props = R.createElement docViewLayoutCpt props []
docViewLayoutCpt :: R.Component LayoutProps
docViewLayoutCpt = here.component "docViewLayout" cpt
where
......@@ -118,11 +113,11 @@ type Props = (
docView :: R2.Component Props
docView = R.createElement docViewCpt
docViewCpt :: R.Component Props
docViewCpt = here.component "docView" cpt where
cpt { layout: { cacheState
, chart
, errors
, frontends
, listId
, mCorpusId
......@@ -147,6 +142,7 @@ docViewCpt = here.component "docView" cpt where
, if showSearch then searchBar { query } [] else H.div {} []
, H.div {className: "col-md-12"}
[ pageLayout { cacheState
, errors
, frontends
, key: "docView-" <> (show cacheState')
, listId
......@@ -167,7 +163,6 @@ type SearchBarProps =
searchBar :: R2.Component SearchBarProps
searchBar = R.createElement searchBarCpt
searchBarCpt :: R.Component SearchBarProps
searchBarCpt = here.component "searchBar" cpt
where
......@@ -268,6 +263,7 @@ pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt where
cpt props@{ cacheState
, errors
, frontends
, listId
, mCorpusId
......@@ -303,6 +299,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where
case cacheState' of
NT.CacheOn -> do
let paint (Tuple count docs) = page { documents: docs
, errors
, layout: props { totalRecords = count }
, params } []
mkRequest :: PageParams -> GUC.Request
......@@ -310,6 +307,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where
useLoaderWithCacheAPI {
cacheEndpoint: getPageHash session
, errors
, handleResponse
, mkRequest
, path
......@@ -339,13 +337,13 @@ pageLayoutCpt = here.component "pageLayout" cpt where
type PageProps = (
documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, params :: TT.Params
, errors :: T.Box (Array FrontendError)
, layout :: Record PageLayoutProps
, params :: TT.Params
)
page :: R2.Component PageProps
page = R.createElement pageCpt
pageCpt :: R.Component PageProps
pageCpt = here.component "pageCpt" cpt where
cpt { documents, layout, params } _ = do
......@@ -361,7 +359,6 @@ type PagePaintProps = (
pagePaint :: R2.Component PagePaintProps
pagePaint = R.createElement pagePaintCpt
pagePaintCpt :: R.Component PagePaintProps
pagePaintCpt = here.component "pagePaintCpt" cpt
where
......
module Gargantext.Components.ErrorsView where
import Gargantext.Prelude
import Data.Array (deleteAt)
import Data.FunctorWithIndex (mapWithIndex)
import Data.Maybe (Maybe(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Types (FrontendError(..))
import Gargantext.Utils.ReactBootstrap as RB
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.ErrorsView"
type ErrorsProps =
( errors :: T.Box (Array FrontendError) )
errorsView :: R2.Component ErrorsProps
errorsView = R.createElement errorsViewCpt
errorsViewCpt :: R.Component ErrorsProps
errorsViewCpt = here.component "errorsView" cpt
where
cpt { errors } _ = do
errors' <- T.useLive T.unequal errors
pure $ H.div {}
( mapWithIndex (showError errors) errors' )
showError errors i (FStringError { error }) =
RB.alert { dismissible: true
, onClose
, variant: "danger" } [ H.text error ]
where
onClose = do
here.log2 "click!" error
T.modify_ (\es -> case deleteAt i es of
Nothing -> es
Just es' -> es'
) errors
showError errors i (FRESTError { error }) =
RB.alert { dismissible: true
, onClose
, variant: "danger" } [ H.text $ show error ]
where
onClose = do
here.log2 "click!" error
T.modify_ (\es -> case deleteAt i es of
Nothing -> es
Just es' -> es'
) errors
......@@ -6,15 +6,9 @@ import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (null)
import Data.Traversable (traverse_)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff, error)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
......@@ -31,15 +25,20 @@ import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Ordering, Unit, bind, compare, discard, pure, unit, void, ($), (<$>), (<>))
import Gargantext.Routes (AppRoute(Home), SessionRoute(..), appPath, nodeTypeAppRoute)
import Gargantext.Sessions (Session, get, sessionId)
import Gargantext.Types (NodeType(..))
import Gargantext.Types (FrontendError, NodeType(..))
import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
foreign import back :: Effect Unit
foreign import link :: String -> Effect Unit
......@@ -48,11 +47,12 @@ here :: R2.Here
here = R2.here "Gargantext.Components.FolderView"
type Props =
( nodeId :: Int
, session :: Session
, backFolder :: Boolean
, tasks :: T.Box GAT.Storage
( backFolder :: Boolean
, errors :: T.Box (Array FrontendError)
, nodeId :: Int
, reloadForest :: T.Box T2.Reload
, session :: Session
, tasks :: T.Box GAT.Storage
)
data FolderStyle = FolderUp | FolderChild
......@@ -61,35 +61,43 @@ folderView :: R2.Leaf Props
folderView props = R.createElement folderViewCpt props []
folderViewCpt :: R.Component Props
folderViewCpt = here.component "folderViewCpt" cpt where
cpt {nodeId, session, backFolder, tasks, reloadForest} _ = do
cpt { errors, nodeId, session, backFolder, tasks, reloadForest } _ = do
setPopoverRef <- R.useRef Nothing
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
useLoader { errorHandler
, loader: loadFolders
, path: { nodeId, session, reload: reload'}
, render: \folders -> folderViewMain {folders, nodeId, session, backFolder, tasks, reload, setPopoverRef, reloadForest} }
, render: \folders -> folderViewMain { backFolder
, errors
, folders
, nodeId
, session
, tasks
, reload
, setPopoverRef
, reloadForest} }
where
errorHandler err = here.log2 "[folderView] RESTError" err
type FolderViewProps =
(
nodeId :: Int
, folders:: FTree
, session :: Session
, backFolder :: Boolean
, tasks :: T.Box GAT.Storage
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
( backFolder :: Boolean
, errors :: T.Box (Array FrontendError)
, folders :: FTree
, nodeId :: Int
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
, session :: Session
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box GAT.Storage
)
folderViewMain :: Record FolderViewProps -> R.Element
folderViewMain props = R.createElement folderViewMainCpt props []
folderViewMainCpt :: R.Component FolderViewProps
folderViewMainCpt = here.component "folderViewMainCpt" cpt where
cpt { backFolder
, errors
, folders: NTree (LNode {parent_id: parentId, nodeType}) (folders)
, nodeId
, reload
......@@ -100,22 +108,23 @@ folderViewMainCpt = here.component "folderViewMainCpt" cpt where
let foldersS = A.sortBy sortFolders folders
let backHome = isBackHome nodeType
let parent = makeParentFolder parentId session backFolder backHome
let children = makeFolderElements foldersS {session, setPopoverRef, nodeId, tasks, reload, reloadForest}
let children = makeFolderElements foldersS { errors, session, setPopoverRef, nodeId, tasks, reload, reloadForest }
pure $ H.div {className: "fv folders"} $ parent <> children
makeFolderElements foldersS props = makeFolderElementsMap <$> foldersS where
makeFolderElementsMap :: NTree LNode -> R.Element
makeFolderElementsMap (NTree (LNode node) _) = folder {style: FolderChild
, text: node.name
makeFolderElementsMap (NTree (LNode node) _) = folder { errors: props.errors
, nodeId: node.id
, nodeType: node.nodeType
, session: props.session
, setPopoverRef: props.setPopoverRef
, parentId: props.nodeId
, tasks: props.tasks
, reload: props.reload
, reloadForest: props.reloadForest} []
, reloadForest: props.reloadForest
, session: props.session
, setPopoverRef: props.setPopoverRef
, style: FolderChild
, text: node.name } []
makeParentFolder :: Maybe Int -> Session -> Boolean -> Boolean -> Array R.Element
makeParentFolder (Just parentId) session _ _ =
......@@ -171,23 +180,22 @@ folderSimpleCpt = here.component "folderSimpleCpt" cpt where
getFolderPath nodeType sid nodeId = appPath $ fromMaybe Home $ nodeTypeAppRoute nodeType sid nodeId
type FolderProps =
(
setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, parentId :: Int
, tasks :: T.Box GAT.Storage
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
( errors :: T.Box (Array FrontendError)
, parentId :: Int
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box GAT.Storage
| FolderSimpleProps
)
folder :: R2.Component FolderProps
folder = R.createElement folderCpt
folderCpt :: R.Component FolderProps
folderCpt = here.component "folderCpt" cpt where
cpt props@{style, text, nodeId, session, nodeType, setPopoverRef, parentId, tasks, reload, reloadForest} _ = do
cpt props@{ errors, style, text, nodeId, session, nodeType, setPopoverRef, parentId, tasks, reload, reloadForest } _ = do
let sid = sessionId session
let dispatch a = performAction a {setPopoverRef, session, nodeId, parentId, tasks, reload, reloadForest}
let dispatch a = performAction a { errors, nodeId, parentId, tasks, reload, reloadForest, session, setPopoverRef }
popoverRef <- R.useRef null
R.useEffect' $ do
......@@ -226,11 +234,12 @@ folderCpt = here.component "folderCpt" cpt where
<> "Click here to execute one of them." } []
]
mNodePopupView props opc = nodePopupView {onPopoverClose: opc
,nodeType: props.nodeType
, name: props.text
mNodePopupView props opc = nodePopupView { dispatch: props.dispatch
, errors: props.errors
, id: props.nodeId
, dispatch: props.dispatch
, onPopoverClose: opc
, nodeType: props.nodeType
, name: props.text
, session: props.session
, handed: GT.RightHanded
}
......@@ -264,14 +273,14 @@ loadFolders :: Record LoadProps -> Aff (Either RESTError FTree)
loadFolders {nodeId, session} = get session $ TreeFirstLevel (Just nodeId) ""
type PerformActionProps =
(
setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, session :: Session
, nodeId :: Int
, parentId :: Int
, tasks :: T.Box GAT.Storage
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
( errors :: T.Box (Array FrontendError)
, nodeId :: Int
, parentId :: Int
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, session :: Session
, tasks :: T.Box GAT.Storage
)
performAction :: Action -> Record PerformActionProps -> Aff Unit
......@@ -286,13 +295,13 @@ performAction = performAction' where
performAction' (AddNode name nodeType) p = addNode' name nodeType p
performAction' (UploadFile nodeType fileType mName contents) p = uploadFile' nodeType fileType mName contents p
performAction' (UploadArbitraryFile mName blob) p = uploadArbitraryFile' mName blob p
performAction' DownloadNode _ = liftEffect $ log "[performAction] DownloadNode"
performAction' DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
performAction' (MoveNode {params}) p = moveNode params p
performAction' (MergeNode {params}) p = mergeNode params p
performAction' (LinkNode { nodeType, params }) p = linkNode nodeType params p
performAction' NoAction _ = liftEffect $ log "[performAction] NoAction"
performAction' NoAction _ = liftEffect $ here.log "[performAction] NoAction"
performAction' ClosePopover p = closePopover p
performAction' _ _ = liftEffect $ log "[performAction] unsupported action"
performAction' _ _ = liftEffect $ here.log "[performAction] unsupported action"
closePopover { setPopoverRef } =
liftEffect $ traverse_ (\set -> set false) (R.readRef setPopoverRef)
......@@ -311,59 +320,63 @@ performAction = performAction' where
doSearch task { tasks, nodeId: id } = liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] DoSearch task:" task
here.log2 "[performAction] DoSearch task:" task
updateNode params p@{ tasks, nodeId: id } = do
task <- updateRequest params p.session id
liftEffect $ do
updateNode params p@{ errors, tasks, nodeId: id } = do
eTask <- updateRequest params p.session id
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UpdateNode task:" task
here.log2 "[performAction] UpdateNode task:" task
shareTeam username p@{ nodeId: id} =
void $ Share.shareReq p.session id $ Share.ShareTeamParams {username}
shareTeam username p@{ errors, nodeId: id} = do
eTask <- Share.shareReq p.session id $ Share.ShareTeamParams {username}
handleRESTError errors eTask $ \_task -> pure unit
sharePublic params p = traverse_ f params where
sharePublic params p@{ errors } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
void $ Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
eTask <- Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
addContact params p@{ nodeId: id } =
void $ Contact.contactReq p.session id params
uploadFile' nodeType fileType mName contents p@{ tasks, nodeId: id } = do
task <- uploadFile p.session nodeType id fileType {mName, contents}
liftEffect $ do
uploadFile' nodeType fileType mName contents p@{ errors, tasks, nodeId: id } = do
eTask <- uploadFile { contents, fileType, id, nodeType, mName, session: p.session }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadFile, uploaded, task:" task
here.log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ tasks, nodeId: id } = do
uploadArbitraryFile' mName blob p@{ errors, tasks, nodeId: id } = do
eTask <- uploadArbitraryFile p.session id { blob, mName }
case eTask of
Left _err -> throwError $ error "[uploadArbitraryFile] RESTError"
Right task -> do
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p = traverse_ f params where
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ errors } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ moveNodeReq p.session in' out
eTask <- moveNodeReq p.session in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
mergeNode params p = traverse_ f params where
mergeNode params p@{ errors } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ mergeNodeReq p.session in' out
eTask <- mergeNodeReq p.session in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
linkNode nodeType params p = traverse_ f params where
linkNode nodeType params p@{ errors } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ linkNodeReq p.session nodeType in' out
eTask <- linkNodeReq p.session nodeType in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
renameNode name p@{ nodeId: id } = do
void $ rename p.session id $ RenameValue { text: name }
renameNode name p@{ errors, nodeId: id } = do
eTask <- rename p.session id $ RenameValue { text: name }
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
addNode' name nodeType p@{ nodeId: id } = do
void $ addNode p.session id $ AddNodeValue {name, nodeType}
addNode' name nodeType p@{ errors, nodeId: id } = do
eTask <- addNode p.session id $ AddNodeValue {name, nodeType}
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
......@@ -14,7 +14,7 @@ import Gargantext.Components.Forest.Tree (treeLoader)
import Gargantext.Ends (Frontends, Backend)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Types (Handed, switchHanded)
import Gargantext.Types (FrontendError, Handed, switchHanded)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
......@@ -36,6 +36,7 @@ type Common =
type Props =
( backend :: T.Box (Maybe Backend)
, errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes
, reloadForest :: T2.ReloadS
, sessions :: T.Box Sessions
......@@ -53,6 +54,7 @@ forest = R.createElement forestCpt
forestCpt :: R.Component Props
forestCpt = here.component "forest" cpt where
cpt props@{ backend
, errors
, forestOpen
, frontends
, handed
......@@ -81,7 +83,8 @@ forestCpt = here.component "forest" cpt where
common = RX.pick props :: Record Common
trees handed' sessions' = (tree handed') <$> unSessions sessions'
tree handed' s@(Session {treeId}) =
treeLoader { forestOpen
treeLoader { errors
, forestOpen
, frontends
, handed: handed'
, reload: reloadForest
......
......@@ -2,21 +2,13 @@ module Gargantext.Components.Forest.Tree where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Data.Array as A
import Data.Either (Either(..))
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Traversable (traverse_, traverse)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff, error)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Toestand as T
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (nodeSpan)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
......@@ -33,16 +25,22 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadA
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute)
import Gargantext.Routes as GR
import Gargantext.Sessions (OpenNodes, Session, get, mkNodeId)
import Gargantext.Sessions.Types (useOpenNodesMemberBox, openNodesInsert, openNodesDelete)
import Gargantext.Types (Handed, ID, isPublic, publicize, switchHanded)
import Gargantext.Types (FrontendError, Handed, ID, isPublic, publicize, switchHanded)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree"
......@@ -61,8 +59,9 @@ type Global =
| Universal )
-- Shared by every component here
type Common = (
forestOpen :: T.Box OpenNodes
type Common =
( errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes
, reload :: T2.ReloadS
| Global
)
......@@ -105,12 +104,12 @@ tree :: R2.Leaf TreeProps
tree props = R.createElement treeCpt props []
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where
cpt p@{ reload, session, tree: NTree (LNode { id, name, nodeType }) children } _ = do
cpt p@{ errors, reload, session, tree: NTree (LNode { id, name, nodeType }) children } _ = do
setPopoverRef <- R.useRef Nothing
folderOpen <- useOpenNodesMemberBox nodeId p.forestOpen
pure $ H.ul { className: ulClass }
[ H.li { className: childrenClass children' }
[ nodeSpan (nsprops { folderOpen, name, id, nodeType, setPopoverRef, isLeaf })
[ nodeSpan (nsprops { errors, folderOpen, name, id, nodeType, setPopoverRef, isLeaf })
[ renderChildren (Record.merge p { childProps: { children', folderOpen, render: tree } } ) [] ]
]
]
......@@ -125,7 +124,7 @@ treeCpt = here.component "tree" cpt where
extra' = Record.merge extra { dispatch, reload } where
dispatch a = performAction a (Record.merge common' spr) where
common' = RecordE.pick p :: Record PACommon
spr = { setPopoverRef: extra.setPopoverRef }
spr = { errors, setPopoverRef: extra.setPopoverRef }
pub (LNode n@{ nodeType: t }) = LNode (n { nodeType = publicize t })
childrenClass [] = "no-children"
childrenClass _ = "with-children"
......@@ -167,7 +166,8 @@ renderTreeChildrenCpt = here.component "renderTreeChildren" cpt where
--- The properties tree shares in common with performAction
type PACommon =
( forestOpen :: T.Box OpenNodes
( errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes
, reloadTree :: T2.ReloadS
, session :: Session
, tasks :: T.Box GAT.Storage
......@@ -220,83 +220,88 @@ deleteNode' nt p@{ tree: (NTree (LNode {id, parent_id}) _) } = do
doSearch task p@{ tasks, tree: NTree (LNode {id}) _ } = liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] DoSearch task:" task
updateNode params p@{ tasks, tree: (NTree (LNode {id}) _) } = do
task <- updateRequest params p.session id
liftEffect $ do
here.log2 "[doSearch] DoSearch task:" task
updateNode params p@{ errors, tasks, tree: (NTree (LNode {id}) _) } = do
eTask <- updateRequest params p.session id
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UpdateNode task:" task
here.log2 "[updateNode] UpdateNode task:" task
renameNode name p@{ tree: (NTree (LNode {id}) _) } = do
void $ rename p.session id $ RenameValue { text: name }
renameNode name p@{ errors, tree: (NTree (LNode {id}) _) } = do
eTask <- rename p.session id $ RenameValue { text: name }
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
shareTeam username p@{ tree: (NTree (LNode {id}) _)} =
void $ Share.shareReq p.session id $ Share.ShareTeamParams {username}
shareTeam username p@{ errors, tree: (NTree (LNode {id}) _)} = do
eTask <- Share.shareReq p.session id $ Share.ShareTeamParams {username}
handleRESTError errors eTask $ \_task -> pure unit
sharePublic params p@{ forestOpen } = traverse_ f params where
sharePublic params p@{ errors, forestOpen } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
void $ Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
eTask <- Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
handleRESTError errors eTask $ \_task -> do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
refreshTree p
addContact params p@{ errors, tree: (NTree (LNode {id}) _) } = do
eTask <- Contact.contactReq p.session id params
handleRESTError errors eTask $ \_task -> pure unit
addNode' name nodeType p@{ errors, forestOpen, tree: (NTree (LNode { id }) _) } = do
eId <- addNode p.session id $ AddNodeValue {name, nodeType}
handleRESTError errors eId $ \_id -> liftEffect $ do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session id)) forestOpen
refreshTree p
addContact params p@{ tree: (NTree (LNode {id}) _) } =
void $ Contact.contactReq p.session id params
addNode' name nodeType p@{ forestOpen, tree: (NTree (LNode { id }) _) } = do
task <- addNode p.session id $ AddNodeValue {name, nodeType}
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session id)) forestOpen
refreshTree p
uploadFile' nodeType fileType mName contents p@{ tasks, tree: (NTree (LNode { id }) _) } = do
task <- uploadFile p.session nodeType id fileType {mName, contents}
liftEffect $ do
uploadFile' nodeType fileType mName contents p@{ errors, tasks, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadFile { contents, fileType, id, mName, nodeType, session: p.session }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadFile, uploaded, task:" task
here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do
uploadArbitraryFile' mName blob p@{ errors, tasks, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadArbitraryFile p.session id { blob, mName }
case eTask of
Left err -> throwError $ error $ "[uploadArbitraryFile'] RESTError"
Right task -> do
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ forestOpen, session } = traverse_ f params where
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ errors, forestOpen, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ moveNodeReq p.session in' out
eTask <- moveNodeReq p.session in' out
handleRESTError errors eTask $ \_task -> pure unit
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen
refreshTree p
mergeNode params p = traverse_ f params where
mergeNode params p@{ errors } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ mergeNodeReq p.session in' out
eTask <- mergeNodeReq p.session in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
linkNode nodeType params p = traverse_ f params where
linkNode nodeType params p@{ errors } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ linkNodeReq p.session nodeType in' out
eTask <- linkNodeReq p.session nodeType in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
-- | This thing is basically a hangover from when garg was a thermite
-- | application. we should slowly get rid of it.
performAction :: Action -> Record PerformActionProps -> Aff Unit
performAction (DeleteNode nt) p = deleteNode' nt p
performAction (DoSearch task) p = doSearch task p
performAction (UpdateNode params) p = updateNode params p
performAction (RenameNode name) p = renameNode name p
performAction (ShareTeam username) p = shareTeam username p
performAction (SharePublic { params }) p = sharePublic params p
performAction (AddContact params) p = addContact params p
performAction (AddNode name nodeType) p = addNode' name nodeType p
performAction (DeleteNode nt) p = deleteNode' nt p
performAction (DoSearch task) p = doSearch task p
performAction (UpdateNode params) p = updateNode params p
performAction (RenameNode name) p = renameNode name p