Skip to content

P
purescript-gargantext
Commit 5d8de4c3 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into dev-markdown

parents 69ee823b 33bb55e6
Show whitespace changes
Inline Side-by-side
Showing with 1945 additions and 1422 deletions
src/Gargantext/Components/App.purs
View file @ 5d8de4c3
module Gargantext.Components.App where
import Prelude
import Data.Array (fromFoldable)
import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Folder (folder)
import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout)
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.User.Contacts (annuaireUserLayout, userLayout)
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.Document (documentLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.Router (router)
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 as Sessions
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
-- TODO (what does this mean?)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
......@@ -77,16 +75,16 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
simpleLayout $
explorerLayout { graphId, mCurrentRoute, session
, sessions: (fst sessions), frontends
, showLogin}
, showLogin }
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 {} ]
where
main =
R.fragment
[ H.div {className: "col-md-2", style: {paddingTop: "60px"}}
[ forest {sessions, route, frontends, showLogin} ]
[ forest {sessions, route, frontends, showLogin } ]
, mainPage child
]
......
src/Gargantext/Components/Forest.purs
View file @ 5d8de4c3
module Gargantext.Components.Forest where
import Prelude (const, pure, ($), (<$>))
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Data.Tuple.Nested ((/\))
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, unSessions)
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Utils.Reactix as R2
import Prelude (const, pure, ($), (<$>))
import Reactix as R
import Reactix.DOM.HTML as H
type Props =
( frontends :: Frontends
......@@ -24,7 +24,7 @@ forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props
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) =
pure $ R.fragment $ A.cons (plus showLogin) trees
where
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 5d8de4c3
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 Data.Array as A
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 Effect.Aff (Aff)
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.Box (nodeMainSpan)
import Gargantext.Ends (Frontends)
import Gargantext.Components.Loader (loader)
import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session)
import Gargantext.Types (AsyncTask(..))
import Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -32,34 +37,44 @@ treeView props = R.createElement treeViewCpt props []
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where
cpt props _children = do
cpt { root, mCurrentRoute, session, frontends } _children = do
-- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload)
pure $ treeLoadView reload props
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: Set TreeId)
pure $ treeLoadView reload
{ root, mCurrentRoute, session, frontends, openNodes }
treeLoadView :: R.State Reload -> Record Props -> R.Element
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 []
where
el = R.staticComponent "TreeLoadView" cpt
cpt {root, mCurrentRoute, session, frontends} _ = do
cpt {root, mCurrentRoute, session, frontends, openNodes} _ = do
loader root (loadNode session) $ \loaded ->
loadedTreeView reload {tree: loaded, mCurrentRoute, session, frontends}
loadedTreeView reload {tree: loaded, mCurrentRoute, session, frontends, openNodes}
type TreeViewProps = ( tree :: FTree
, mCurrentRoute :: Maybe AppRoute
, frontends :: Frontends
, session :: Session
, openNodes :: R.State (Set TreeId)
)
loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element
loadedTreeView reload p = R.createElement el p []
where
el = R.hooksComponent "LoadedTreeView" cpt
cpt {tree, mCurrentRoute, session, frontends} _ = do
treeState <- R.useState' {tree, asyncTasks: [AsyncTask {id: "1hello", status: "pending"}]}
cpt {tree, mCurrentRoute, session, frontends, openNodes} _ = do
treeState <- R.useState' {tree, asyncTasks: []}
pure $ H.div {className: "tree"}
[ toHtml reload treeState session frontends mCurrentRoute ]
[ toHtml reload treeState session frontends mCurrentRoute openNodes ]
------------------------------------------------------------------------
toHtml :: R.State Reload
......@@ -67,35 +82,50 @@ toHtml :: R.State Reload
-> Session
-> Frontends
-> Maybe AppRoute
-> R.State (Set TreeId)
-> 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
el = R.hooksComponent "NodeView" cpt
pAction = performAction session reload treeState
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'
pure $ H.ul {}
[ H.li {}
( [ nodeMainSpan pAction {id, asyncTasks, name, nodeType, mCurrentRoute} folderOpen session frontends ]
<> childNodes session frontends reload folderOpen mCurrentRoute ary
( [ nodeMainSpan pAction { id
, 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
-> Frontends
-> R.State Reload
-> R.State Boolean
-> Maybe AppRoute
-> R.State (Set TreeId)
-> Array FTree
-> Array R.Element
childNodes _ _ _ _ _ [] = []
childNodes _ _ _ (false /\ _) _ _ = []
childNodes session frontends reload (true /\ _) mCurrentRoute ary =
childNodes _ _ _ _ _ _ [] = []
childNodes _ _ _ (false /\ _) _ _ _ = []
childNodes session frontends reload (true /\ _) mCurrentRoute openNodes ary =
map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted ary
where
sorted :: Array FTree -> Array FTree
......@@ -105,8 +135,7 @@ childNodes session frontends reload (true /\ _) mCurrentRoute ary =
el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, asyncTasks} _ = do
treeState <- R.useState' {tree, asyncTasks}
pure $ toHtml reload treeState session frontends mCurrentRoute
pure $ toHtml reload treeState session frontends mCurrentRoute openNodes
performAction :: Session
-> R.State Int
......
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ 5d8de4c3
......@@ -3,9 +3,19 @@ module Gargantext.Components.Forest.Tree.Node.Box where
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
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.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
......@@ -23,22 +33,16 @@ import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (AsyncTask, NodePath(..), NodeType(..), fldr)
import Gargantext.Utils (glyphicon, glyphiconActive)
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
type NodeMainSpanProps =
( id :: ID
, asyncTasks :: Array AsyncTask
, mCurrentRoute :: Maybe AppRoute
, name :: Name
, nodeType :: NodeType
, mCurrentRoute :: Maybe AppRoute
, onAsyncTaskFinish :: AsyncTask -> Effect Unit
)
nodeMainSpan :: (Action -> Aff Unit)
......@@ -50,7 +54,7 @@ nodeMainSpan :: (Action -> Aff Unit)
nodeMainSpan d p folderOpen session frontends = R.createElement el p []
where
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
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
popupPosition <- R.useState' (Nothing :: Maybe R2.Point)
......@@ -67,7 +71,10 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p []
, popOverIcon showBox popupOpen popupPosition
, mNodePopupView props showBox popupOpen popupPosition
, 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
SettingsBox {show: showBox} = settingsBox nodeType
......
src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs
View file @ 5d8de4c3
module Gargantext.Components.Forest.Tree.Node.ProgressBar where
import Gargantext.Prelude
import Data.Int (fromNumber)
import Data.Maybe (fromJust)
import Data.Maybe (Maybe(..), fromJust)
import Data.Tuple.Nested ((/\))
import Effect.Timer (setTimeout)
import Math (min)
import Effect (Effect)
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 Prelude (bind, discard, pure, show, unit, ($), (+), (<>))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action (ID)
import Gargantext.Types (AsyncTask(..))
type Props =
(
asyncTask :: AsyncTask
, corpusId :: ID
, onFinish :: Unit -> Effect Unit
, session :: Session
)
......@@ -27,12 +34,26 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p []
asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
where
cpt {asyncTask: (AsyncTask {id}), corpusId} _ = do
cpt props@{asyncTask: (AsyncTask {id}), corpusId, onFinish} _ = do
(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
......@@ -46,3 +67,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
toInt :: Number -> Int
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"
src/Gargantext/Components/GraphExplorer.purs
View file @ 5d8de4c3
......@@ -2,6 +2,7 @@ module Gargantext.Components.GraphExplorer where
import Gargantext.Prelude hiding (max,min)
import DOM.Simple.Types (Element)
import Data.Array as A
import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Int (toNumber)
......@@ -12,13 +13,7 @@ import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (fst, snd, Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Types (Element)
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.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls
......@@ -35,6 +30,10 @@ import Gargantext.Sessions (Session, Sessions, get)
import Gargantext.Types as Types
import Gargantext.Utils.Range as Range
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
......@@ -70,7 +69,7 @@ explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element
explorerLayoutView graphVersion p = R.createElement el p []
where
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
where
handler loaded =
......@@ -82,7 +81,7 @@ explorerLayoutView graphVersion p = R.createElement el p []
, mMetaData
, session
, sessions
, showLogin}
, showLogin }
where (Tuple mMetaData graph) = convert loaded
--------------------------------------------------------------
......@@ -92,7 +91,7 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props
explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
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
graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion)
......@@ -167,7 +166,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
-> R.Element
tree false _ _ = RH.div { id: "tree" } []
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
-> { frontends :: Frontends
......
src/Gargantext/Sessions.purs
View file @ 5d8de4c3
-- | A module for authenticating to create sessions and handling them
module Gargantext.Sessions where
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind)
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify)
import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Traversable (traverse)
import DOM.Simple.Console (log2)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Traversable (traverse)
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R
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.Components.Login.Types (AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..))
import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath)
import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath)
import Gargantext.Utils.Reactix (getls)
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
......@@ -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 session@(Session {token}) p = REST.postMultipartFormData (Just token) (toUrl session p)
getls :: Effect Storage
getls = window >>= localStorage
src/Gargantext/Types.purs
View file @ 5d8de4c3
......@@ -2,7 +2,9 @@ module Gargantext.Types where
import Prelude
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Array as A
import Data.Either (Either(..))
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe)
import Effect.Aff (Aff)
import Prim.Row (class Union)
......@@ -435,11 +437,27 @@ modeFromString "Institutes" = Just Institutes
modeFromString "Terms" = Just Terms
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 {
id :: String
, status :: String
id :: AsyncTaskID
, status :: AsyncTaskStatus
}
derive instance genericAsyncTask :: Generic AsyncTask _
instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
......@@ -448,3 +466,43 @@ instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
id <- obj .: "id"
status <- obj .: "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
src/Gargantext/Utils/Reactix.purs
View file @ 5d8de4c3
......@@ -2,23 +2,27 @@ module Gargantext.Utils.Reactix where
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.Console (log2)
import DOM.Simple.Document (document)
import DOM.Simple.Element as Element
import DOM.Simple.Event as DE
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.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Class (liftEffect)
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 Partial.Unsafe (unsafePartial)
import React (class ReactPropFields, Children, ReactClass, ReactElement)
......@@ -32,6 +36,9 @@ import Reactix.Utils (currySecond, hook, tuple)
import Unsafe.Coerce (unsafeCoerce)
import Web.File.File (toBlob)
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 }
......@@ -249,3 +256,38 @@ stringify :: Json -> Int -> String
stringify j indent = runFn2 _stringify j indent
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)
yarn.lock
View file @ 5d8de4c3
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