Commit 5d8de4c3 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-markdown

parents 69ee823b 33bb55e6
module Gargantext.Components.App where module Gargantext.Components.App where
import Prelude import Prelude
import Data.Array (fromFoldable) import Data.Array (fromFoldable)
import Data.Foldable (intercalate) import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe') import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Data.Lang (Lang(..)) import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Folder (folder)
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout) import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Login (login) import Gargantext.Components.Login (login)
-- import Gargantext.Components.Search.SearchBar as SB
-- import Gargantext.Components.Search.Types (allDatabases)
import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Components.Folder (folder)
import Gargantext.Components.Nodes.Annuaire (annuaireLayout) import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout) import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout) import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout) import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout) import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout) import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Components.Nodes.Home (homeLayout) import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.Router (router) import Gargantext.Router (router)
import Gargantext.Routes (AppRoute(..)) import Gargantext.Routes (AppRoute(..))
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (Sessions, useSessions) import Gargantext.Sessions (Sessions, useSessions)
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
-- TODO (what does this mean?) -- TODO (what does this mean?)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc -- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
...@@ -44,10 +42,10 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -44,10 +42,10 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
cpt _ _ = do cpt _ _ = do
sessions <- useSessions sessions <- useSessions
route <- useHashRouter router Home route <- useHashRouter router Home
showLogin <- R.useState' false showLogin <- R.useState' false
showCorpus <- R.useState' false showCorpus <- R.useState' false
let forested = forestLayout frontends (fst sessions) (fst route) (snd showLogin) let forested = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
let mCurrentRoute = fst route let mCurrentRoute = fst route
let backends = fromFoldable defaultBackends let backends = fromFoldable defaultBackends
...@@ -77,16 +75,16 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -77,16 +75,16 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
simpleLayout $ simpleLayout $
explorerLayout { graphId, mCurrentRoute, session explorerLayout { graphId, mCurrentRoute, session
, sessions: (fst sessions), frontends , sessions: (fst sessions), frontends
, showLogin} , showLogin }
forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element
forestLayout frontends sessions route showLogin child = forestLayout frontends sessions route showLogin child = do
R.fragment [ topBar {}, R2.row [main], footer {} ] R.fragment [ topBar {}, R2.row [main], footer {} ]
where where
main = main =
R.fragment R.fragment
[ H.div {className: "col-md-2", style: {paddingTop: "60px"}} [ H.div {className: "col-md-2", style: {paddingTop: "60px"}}
[ forest {sessions, route, frontends, showLogin} ] [ forest {sessions, route, frontends, showLogin } ]
, mainPage child , mainPage child
] ]
......
module Gargantext.Components.Forest where module Gargantext.Components.Forest where
import Prelude (const, pure, ($), (<$>))
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Gargantext.Components.Forest.Tree (treeView)
import Reactix.DOM.HTML as H
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, unSessions) import Gargantext.Sessions (Session(..), Sessions, unSessions)
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Prelude (const, pure, ($), (<$>))
import Reactix as R
import Reactix.DOM.HTML as H
type Props = type Props =
( frontends :: Frontends ( frontends :: Frontends
...@@ -24,7 +24,7 @@ forest props = R.createElement forestCpt props [] ...@@ -24,7 +24,7 @@ forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props forestCpt :: R.Component Props
forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
cpt {frontends, route, sessions, showLogin} _ = R2.useCache (frontends /\ route /\ sessions) (cpt' showLogin) cpt {frontends, route, sessions, showLogin } _ = R2.useCache (frontends /\ route /\ sessions) (cpt' showLogin)
cpt' showLogin (frontends /\ route /\ sessions) = cpt' showLogin (frontends /\ route /\ sessions) =
pure $ R.fragment $ A.cons (plus showLogin) trees pure $ R.fragment $ A.cons (plus showLogin) trees
where where
......
module Gargantext.Components.Forest.Tree where module Gargantext.Components.Forest.Tree where
import Data.Array as A import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Prelude
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Data.Array as A
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
-- import Data.Newtype (class Newtype) import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan) import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
import Gargantext.Ends (Frontends)
import Gargantext.Components.Loader (loader) import Gargantext.Components.Loader (loader)
import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (AsyncTask(..)) import Gargantext.Types (AsyncTask(..))
import Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>)) import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -32,34 +37,44 @@ treeView props = R.createElement treeViewCpt props [] ...@@ -32,34 +37,44 @@ treeView props = R.createElement treeViewCpt props []
treeViewCpt :: R.Component Props treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where where
cpt props _children = do cpt { root, mCurrentRoute, session, frontends } _children = do
-- NOTE: this is a hack to reload the tree view on demand -- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload) reload <- R.useState' (0 :: Reload)
pure $ treeLoadView reload props openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: Set TreeId)
pure $ treeLoadView reload
treeLoadView :: R.State Reload -> Record Props -> R.Element { root, mCurrentRoute, session, frontends, openNodes }
type Props' = ( root :: ID
, mCurrentRoute :: Maybe AppRoute
, session :: Session
, frontends :: Frontends
, openNodes :: R.State (Set TreeId)
)
treeLoadView :: R.State Reload -> Record Props' -> R.Element
treeLoadView reload p = R.createElement el p [] treeLoadView reload p = R.createElement el p []
where where
el = R.staticComponent "TreeLoadView" cpt el = R.staticComponent "TreeLoadView" cpt
cpt {root, mCurrentRoute, session, frontends} _ = do cpt {root, mCurrentRoute, session, frontends, openNodes} _ = do
loader root (loadNode session) $ \loaded -> loader root (loadNode session) $ \loaded ->
loadedTreeView reload {tree: loaded, mCurrentRoute, session, frontends} loadedTreeView reload {tree: loaded, mCurrentRoute, session, frontends, openNodes}
type TreeViewProps = ( tree :: FTree type TreeViewProps = ( tree :: FTree
, mCurrentRoute :: Maybe AppRoute , mCurrentRoute :: Maybe AppRoute
, frontends :: Frontends , frontends :: Frontends
, session :: Session , session :: Session
, openNodes :: R.State (Set TreeId)
) )
loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element
loadedTreeView reload p = R.createElement el p [] loadedTreeView reload p = R.createElement el p []
where where
el = R.hooksComponent "LoadedTreeView" cpt el = R.hooksComponent "LoadedTreeView" cpt
cpt {tree, mCurrentRoute, session, frontends} _ = do cpt {tree, mCurrentRoute, session, frontends, openNodes} _ = do
treeState <- R.useState' {tree, asyncTasks: [AsyncTask {id: "1hello", status: "pending"}]} treeState <- R.useState' {tree, asyncTasks: []}
pure $ H.div {className: "tree"} pure $ H.div {className: "tree"}
[ toHtml reload treeState session frontends mCurrentRoute ] [ toHtml reload treeState session frontends mCurrentRoute openNodes ]
------------------------------------------------------------------------ ------------------------------------------------------------------------
toHtml :: R.State Reload toHtml :: R.State Reload
...@@ -67,35 +82,50 @@ toHtml :: R.State Reload ...@@ -67,35 +82,50 @@ toHtml :: R.State Reload
-> Session -> Session
-> Frontends -> Frontends
-> Maybe AppRoute -> Maybe AppRoute
-> R.State (Set TreeId)
-> R.Element -> R.Element
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary), asyncTasks} /\ _) session frontends mCurrentRoute = R.createElement el {} [] toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asyncTasks} /\ setTreeState) session frontends mCurrentRoute openNodes = R.createElement el {} []
where where
el = R.hooksComponent "NodeView" cpt el = R.hooksComponent "NodeView" cpt
pAction = performAction session reload treeState pAction = performAction session reload treeState
cpt props _ = do cpt props _ = do
folderOpen <- R.useState' true let folderIsOpen = Set.member id (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert
let toggleFolderIsOpen _ = (snd openNodes) (setFn id)
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
let withId (NTree (LNode {id: id'}) _) = id' let withId (NTree (LNode {id: id'}) _) = id'
pure $ H.ul {} pure $ H.ul {}
[ H.li {} [ H.li {}
( [ nodeMainSpan pAction {id, asyncTasks, name, nodeType, mCurrentRoute} folderOpen session frontends ] ( [ nodeMainSpan pAction { id
<> childNodes session frontends reload folderOpen mCurrentRoute ary , asyncTasks
, mCurrentRoute
, name
, nodeType
, onAsyncTaskFinish
} folderOpen session frontends ]
<> childNodes session frontends reload folderOpen mCurrentRoute openNodes ary
) )
] ]
onAsyncTaskFinish (AsyncTask {id}) = setTreeState $ const $ ts { asyncTasks = newAsyncTasks }
where
newAsyncTasks = A.filter (\(AsyncTask {id: id'}) -> id /= id') asyncTasks
childNodes :: Session childNodes :: Session
-> Frontends -> Frontends
-> R.State Reload -> R.State Reload
-> R.State Boolean -> R.State Boolean
-> Maybe AppRoute -> Maybe AppRoute
-> R.State (Set TreeId)
-> Array FTree -> Array FTree
-> Array R.Element -> Array R.Element
childNodes _ _ _ _ _ [] = [] childNodes _ _ _ _ _ _ [] = []
childNodes _ _ _ (false /\ _) _ _ = [] childNodes _ _ _ (false /\ _) _ _ _ = []
childNodes session frontends reload (true /\ _) mCurrentRoute ary = childNodes session frontends reload (true /\ _) mCurrentRoute openNodes ary =
map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted ary map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted ary
where where
sorted :: Array FTree -> Array FTree sorted :: Array FTree -> Array FTree
...@@ -105,8 +135,7 @@ childNodes session frontends reload (true /\ _) mCurrentRoute ary = ...@@ -105,8 +135,7 @@ childNodes session frontends reload (true /\ _) mCurrentRoute ary =
el = R.hooksComponent "ChildNodeView" cpt el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, asyncTasks} _ = do cpt {tree, asyncTasks} _ = do
treeState <- R.useState' {tree, asyncTasks} treeState <- R.useState' {tree, asyncTasks}
pure $ toHtml reload treeState session frontends mCurrentRoute pure $ toHtml reload treeState session frontends mCurrentRoute openNodes
performAction :: Session performAction :: Session
-> R.State Int -> R.State Int
......
...@@ -3,9 +3,19 @@ module Gargantext.Components.Forest.Tree.Node.Box where ...@@ -3,9 +3,19 @@ module Gargantext.Components.Forest.Tree.Node.Box where
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox) import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView) import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
...@@ -23,22 +33,16 @@ import Gargantext.Sessions (Session, sessionId) ...@@ -23,22 +33,16 @@ import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (AsyncTask, NodePath(..), NodeType(..), fldr) import Gargantext.Types (AsyncTask, NodePath(..), NodeType(..), fldr)
import Gargantext.Utils (glyphicon, glyphiconActive) import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Prelude (Unit, bind, const, discard, identity, map, pure, show, void, ($), (<>), (==), (-), (+))
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Web.File.FileReader.Aff (readAsText)
-- Main Node -- Main Node
type NodeMainSpanProps = type NodeMainSpanProps =
( id :: ID ( id :: ID
, asyncTasks :: Array AsyncTask , asyncTasks :: Array AsyncTask
, mCurrentRoute :: Maybe AppRoute
, name :: Name , name :: Name
, nodeType :: NodeType , nodeType :: NodeType
, mCurrentRoute :: Maybe AppRoute , onAsyncTaskFinish :: AsyncTask -> Effect Unit
) )
nodeMainSpan :: (Action -> Aff Unit) nodeMainSpan :: (Action -> Aff Unit)
...@@ -50,7 +54,7 @@ nodeMainSpan :: (Action -> Aff Unit) ...@@ -50,7 +54,7 @@ nodeMainSpan :: (Action -> Aff Unit)
nodeMainSpan d p folderOpen session frontends = R.createElement el p [] nodeMainSpan d p folderOpen session frontends = R.createElement el p []
where where
el = R.hooksComponent "NodeMainSpan" cpt el = R.hooksComponent "NodeMainSpan" cpt
cpt props@{id, asyncTasks, name, nodeType, mCurrentRoute} _ = do cpt props@{id, asyncTasks, mCurrentRoute, name, nodeType, onAsyncTaskFinish} _ = do
-- only 1 popup at a time is allowed to be opened -- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup) popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
popupPosition <- R.useState' (Nothing :: Maybe R2.Point) popupPosition <- R.useState' (Nothing :: Maybe R2.Point)
...@@ -67,7 +71,10 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p [] ...@@ -67,7 +71,10 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p []
, popOverIcon showBox popupOpen popupPosition , popOverIcon showBox popupOpen popupPosition
, mNodePopupView props showBox popupOpen popupPosition , mNodePopupView props showBox popupOpen popupPosition
, fileTypeView d {id, nodeType} droppedFile isDragOver , fileTypeView d {id, nodeType} droppedFile isDragOver
, H.div {} (map (\t -> asyncProgressBar {corpusId: id, asyncTask: t}) asyncTasks) , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, corpusId: id
, onFinish: \_ -> onAsyncTaskFinish t
, session }) asyncTasks)
] ]
where where
SettingsBox {show: showBox} = settingsBox nodeType SettingsBox {show: showBox} = settingsBox nodeType
......
module Gargantext.Components.Forest.Tree.Node.ProgressBar where module Gargantext.Components.Forest.Tree.Node.ProgressBar where
import Gargantext.Prelude
import Data.Int (fromNumber) import Data.Int (fromNumber)
import Data.Maybe (fromJust) import Data.Maybe (Maybe(..), fromJust)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Timer (setTimeout) import Effect (Effect)
import Math (min) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Timer (clearInterval, setInterval)
import Gargantext.Components.Forest.Tree.Node.Action (ID)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (AsyncProgress(..), AsyncTask(..), AsyncTaskStatus(..), NodeType(..), progressPercent)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Prelude (bind, discard, pure, show, unit, ($), (+), (<>))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action (ID)
import Gargantext.Types (AsyncTask(..))
type Props = type Props =
( (
asyncTask :: AsyncTask asyncTask :: AsyncTask
, corpusId :: ID , corpusId :: ID
, onFinish :: Unit -> Effect Unit
, session :: Session
) )
...@@ -27,12 +34,26 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p [] ...@@ -27,12 +34,26 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p []
asyncProgressBarCpt :: R.Component Props asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
where where
cpt {asyncTask: (AsyncTask {id}), corpusId} _ = do cpt props@{asyncTask: (AsyncTask {id}), corpusId, onFinish} _ = do
(progress /\ setProgress) <- R.useState' 0.0 (progress /\ setProgress) <- R.useState' 0.0
intervalIdRef <- R.useRef Nothing
R.useEffectOnce' $ do
intervalId <- setInterval 1000 $ do
launchAff_ $ do
asyncProgress@(AsyncProgress {status}) <- queryProgress props
liftEffect do
setProgress \p -> min 100.0 $ progressPercent asyncProgress
if (status == Finished) || (status == Killed) || (status == Failed) then do
_ <- case R.readRef intervalIdRef of
Nothing -> pure unit
Just iid -> clearInterval iid
onFinish unit
else
pure unit
R.setRef intervalIdRef $ Just intervalId
R.useEffect' $ do
_ <- setTimeout 1000 $ do
setProgress \p -> min 100.0 (p + 10.0)
pure unit pure unit
...@@ -46,3 +67,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt ...@@ -46,3 +67,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
toInt :: Number -> Int toInt :: Number -> Int
toInt n = unsafePartial $ fromJust $ fromNumber n toInt n = unsafePartial $ fromJust $ fromNumber n
queryProgress :: Record Props -> Aff AsyncProgress
queryProgress {asyncTask: AsyncTask {id}, corpusId, session} = get session p
where
p = NodeAPI Corpus (Just corpusId) $ "add/form/async/" <> id <> "/poll?limit=1"
...@@ -2,6 +2,7 @@ module Gargantext.Components.GraphExplorer where ...@@ -2,6 +2,7 @@ module Gargantext.Components.GraphExplorer where
import Gargantext.Prelude hiding (max,min) import Gargantext.Prelude hiding (max,min)
import DOM.Simple.Types (Element)
import Data.Array as A import Data.Array as A
import Data.FoldableWithIndex (foldMapWithIndex) import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Int (toNumber) import Data.Int (toNumber)
...@@ -12,13 +13,7 @@ import Data.Sequence as Seq ...@@ -12,13 +13,7 @@ import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst, snd, Tuple(..)) import Data.Tuple (fst, snd, Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Types (Element)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Math (log)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Components.Graph as Graph import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls import Gargantext.Components.GraphExplorer.Controls as Controls
...@@ -35,6 +30,10 @@ import Gargantext.Sessions (Session, Sessions, get) ...@@ -35,6 +30,10 @@ import Gargantext.Sessions (Session, Sessions, get)
import Gargantext.Types as Types import Gargantext.Types as Types
import Gargantext.Utils.Range as Range import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Math (log)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
type GraphId = Int type GraphId = Int
...@@ -70,7 +69,7 @@ explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element ...@@ -70,7 +69,7 @@ explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element
explorerLayoutView graphVersion p = R.createElement el p [] explorerLayoutView graphVersion p = R.createElement el p []
where where
el = R.hooksComponent "G.C.GE.explorerLayoutView" cpt el = R.hooksComponent "G.C.GE.explorerLayoutView" cpt
cpt {frontends, graphId, mCurrentRoute, session, sessions, showLogin} _ = do cpt {frontends, graphId, mCurrentRoute, session, sessions, showLogin } _ = do
useLoader graphId (getNodes session graphVersion) handler useLoader graphId (getNodes session graphVersion) handler
where where
handler loaded = handler loaded =
...@@ -82,7 +81,7 @@ explorerLayoutView graphVersion p = R.createElement el p [] ...@@ -82,7 +81,7 @@ explorerLayoutView graphVersion p = R.createElement el p []
, mMetaData , mMetaData
, session , session
, sessions , sessions
, showLogin} , showLogin }
where (Tuple mMetaData graph) = convert loaded where (Tuple mMetaData graph) = convert loaded
-------------------------------------------------------------- --------------------------------------------------------------
...@@ -92,7 +91,7 @@ explorer props = R.createElement explorerCpt props [] ...@@ -92,7 +91,7 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props explorerCpt :: R.Component Props
explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where where
cpt {frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin} _ = do cpt {frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin } _ = do
dataRef <- R.useRef graph dataRef <- R.useRef graph
graphRef <- R.useRef null graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion) graphVersionRef <- R.useRef (fst graphVersion)
...@@ -167,7 +166,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -167,7 +166,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
-> R.Element -> R.Element
tree false _ _ = RH.div { id: "tree" } [] tree false _ _ = RH.div { id: "tree" } []
tree true {sessions, mCurrentRoute: route, frontends} showLogin = tree true {sessions, mCurrentRoute: route, frontends} showLogin =
RH.div {className: "col-md-2 graph-tree"} [forest {sessions, route, frontends, showLogin}] RH.div {className: "col-md-2 graph-tree"} [forest {sessions, route, frontends, showLogin }]
mSidebar :: Maybe GET.MetaData mSidebar :: Maybe GET.MetaData
-> { frontends :: Frontends -> { frontends :: Frontends
......
-- | A module for authenticating to create sessions and handling them -- | A module for authenticating to create sessions and handling them
module Gargantext.Sessions where module Gargantext.Sessions where
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind) import DOM.Simple.Console (log2)
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:)) import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify) import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify)
import Data.Argonaut.Parser (jsonParser) import Data.Argonaut.Parser (jsonParser)
import Data.Array as A import Data.Array as A
import Data.Traversable (traverse)
import DOM.Simple.Console (log2)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Sequence (Seq) import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Traversable (traverse)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Gargantext.Components.Login.Types (AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..))
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (Storage, getItem, setItem, removeItem)
import Gargantext.Components.Login.Types
(AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..))
import Gargantext.Config.REST as REST import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath) import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath)
import Gargantext.Routes (SessionRoute) import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath) import Gargantext.Types (NodePath, SessionId(..), nodePath)
import Gargantext.Utils.Reactix (getls)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind)
import Reactix as R
import Web.Storage.Storage (getItem, removeItem, setItem)
-- | A Session represents an authenticated session for a user at a -- | A Session represents an authenticated session for a user at a
...@@ -228,6 +226,3 @@ postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just tok ...@@ -228,6 +226,3 @@ postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just tok
postMultipartFormData :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> String -> Aff b postMultipartFormData :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> String -> Aff b
postMultipartFormData session@(Session {token}) p = REST.postMultipartFormData (Just token) (toUrl session p) postMultipartFormData session@(Session {token}) p = REST.postMultipartFormData (Just token) (toUrl session p)
getls :: Effect Storage
getls = window >>= localStorage
...@@ -2,7 +2,9 @@ module Gargantext.Types where ...@@ -2,7 +2,9 @@ module Gargantext.Types where
import Prelude import Prelude
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject) import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Prim.Row (class Union) import Prim.Row (class Union)
...@@ -435,11 +437,27 @@ modeFromString "Institutes" = Just Institutes ...@@ -435,11 +437,27 @@ modeFromString "Institutes" = Just Institutes
modeFromString "Terms" = Just Terms modeFromString "Terms" = Just Terms
modeFromString _ = Nothing modeFromString _ = Nothing
type AsyncTaskID = String
data AsyncTaskStatus = Running | Failed | Finished | Killed
derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
decodeJson json = do
obj <- decodeJson json
pure $ readAsyncTaskStatus obj
readAsyncTaskStatus :: String -> AsyncTaskStatus
readAsyncTaskStatus "failed" = Failed
readAsyncTaskStatus "finished" = Finished
readAsyncTaskStatus "killed" = Killed
readAsyncTaskStatus "running" = Running
readAsyncTaskStatus _ = Running
newtype AsyncTask = AsyncTask { newtype AsyncTask = AsyncTask {
id :: String id :: AsyncTaskID
, status :: String , status :: AsyncTaskStatus
} }
derive instance genericAsyncTask :: Generic AsyncTask _ derive instance genericAsyncTask :: Generic AsyncTask _
instance decodeJsonAsyncTask :: DecodeJson AsyncTask where instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
...@@ -448,3 +466,43 @@ instance decodeJsonAsyncTask :: DecodeJson AsyncTask where ...@@ -448,3 +466,43 @@ instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
id <- obj .: "id" id <- obj .: "id"
status <- obj .: "status" status <- obj .: "status"
pure $ AsyncTask {id, status} pure $ AsyncTask {id, status}
newtype AsyncProgress = AsyncProgress {
id :: AsyncTaskID
, log :: Array AsyncTaskLog
, status :: AsyncTaskStatus
}
derive instance genericAsyncProgress :: Generic AsyncProgress _
instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
log <- obj .: "log"
status <- obj .: "status"
pure $ AsyncProgress {id, log, status}
newtype AsyncTaskLog = AsyncTaskLog {
events :: Array String
, failed :: Int
, remaining :: Int
, succeeded :: Int
}
derive instance genericAsyncTaskLog :: Generic AsyncTaskLog _
instance decodeJsonAsyncTaskLog :: DecodeJson AsyncTaskLog where
decodeJson json = do
obj <- decodeJson json
events <- obj .: "events"
failed <- obj .: "failed"
remaining <- obj .: "remaining"
succeeded <- obj .: "succeeded"
pure $ AsyncTaskLog {events, failed, remaining, succeeded}
progressPercent :: AsyncProgress -> Number
progressPercent (AsyncProgress {log}) = perc
where
perc = case A.head log of
Nothing -> 0.0
Just (AsyncTaskLog {failed, remaining, succeeded}) -> 100.0*nom/denom
where
nom = toNumber $ failed + succeeded
denom = toNumber $ failed + succeeded + remaining
...@@ -2,23 +2,27 @@ module Gargantext.Utils.Reactix where ...@@ -2,23 +2,27 @@ module Gargantext.Utils.Reactix where
import Prelude import Prelude
import Data.Argonaut.Core (Json)
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Maybe (Maybe(..), fromJust)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import DOM.Simple.Document (document) import DOM.Simple.Document (document)
import DOM.Simple.Element as Element import DOM.Simple.Element as Element
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import DOM.Simple.Types (class IsNode) import DOM.Simple.Types (class IsNode)
import Data.Argonaut as Argonaut
import Data.Argonaut as Json
import Data.Argonaut.Core (Json)
import Data.Either (hush)
import Data.Foldable (for_)
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Maybe (Maybe(..), fromJust)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber) import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Effect.Uncurried (EffectFn1, runEffectFn1, mkEffectFn1, EffectFn2, runEffectFn2, mkEffectFn2) import Effect.Uncurried (EffectFn1, mkEffectFn1, mkEffectFn2, runEffectFn1)
import FFI.Simple ((..), (...), defineProperty, delay, args2, args3) import FFI.Simple ((..), (...), defineProperty, delay, args2, args3)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (class ReactPropFields, Children, ReactClass, ReactElement) import React (class ReactPropFields, Children, ReactClass, ReactElement)
...@@ -32,6 +36,9 @@ import Reactix.Utils (currySecond, hook, tuple) ...@@ -32,6 +36,9 @@ import Reactix.Utils (currySecond, hook, tuple)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Web.File.File (toBlob) import Web.File.File (toBlob)
import Web.File.FileList (FileList, item) import Web.File.FileList (FileList, item)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (Storage, getItem, setItem)
newtype Point = Point { x :: Number, y :: Number } newtype Point = Point { x :: Number, y :: Number }
...@@ -249,3 +256,38 @@ stringify :: Json -> Int -> String ...@@ -249,3 +256,38 @@ stringify :: Json -> Int -> String
stringify j indent = runFn2 _stringify j indent stringify j indent = runFn2 _stringify j indent
foreign import _stringify :: Fn2 Json Int String foreign import _stringify :: Fn2 Json Int String
getls :: Effect Storage
getls = window >>= localStorage
openNodesKey :: LocalStorageKey
openNodesKey = "garg-open-nodes"
type LocalStorageKey = String
useLocalStorageState :: forall s. Argonaut.DecodeJson s => Argonaut.EncodeJson s => LocalStorageKey -> s -> R.Hooks (R.State s)
useLocalStorageState key s = do
ref <- R.useRef s
R.useEffectOnce' do
item :: Maybe String <- getItem key =<< getls
let json = hush <<< Argonaut.jsonParser =<< item
let parsed = hush <<< Argonaut.decodeJson =<< json
for_ parsed \(x :: s) -> R.setRef ref x
let init = R.readRef ref
Tuple state setState' <- R.useState' init
let
setState update = do
let new = update (R.readRef ref)
setState' (\_ -> new)
R.setRef ref new
let json = Json.stringify $ Argonaut.encodeJson new
storage <- getls
setItem key json storage
pure (Tuple state setState)
This source diff could not be displayed because it is too large. You can view the blob instead.
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