Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
20879d3c
Commit
20879d3c
authored
Jun 01, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
[MERGE] dev
parents
eb01d47d
d6d78ff1
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
212 additions
and
121 deletions
+212
-121
AsyncTasks.purs
src/Gargantext/AsyncTasks.purs
+46
-0
Forest.purs
src/Gargantext/Components/Forest.purs
+7
-4
Tree.purs
src/Gargantext/Components/Forest/Tree.purs
+51
-55
Box.purs
src/Gargantext/Components/Forest/Tree/Node/Box.purs
+39
-18
Types.purs
src/Gargantext/Types.purs
+69
-44
No files found.
src/Gargantext/AsyncTasks.purs
0 → 100644
View file @
20879d3c
module Gargantext.AsyncTasks where
import Data.Argonaut (decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
import Data.Map as Map
import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Web.Storage.Storage as WSS
import Gargantext.Prelude
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
localStorageKey :: String
localStorageKey = "garg-async-tasks"
type Storage = Map.Map Int (Array GT.AsyncTaskWithType)
empty :: Storage
empty = Map.empty
getAsyncTasks :: Effect Storage
getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
where
handleMaybe (Just val) = handleEither (parse val >>= decode)
handleMaybe Nothing = pure empty
-- either parsing or decoding could fail, hence two errors
handleEither (Left err) = err *> pure empty
handleEither (Right ss) = pure ss
parse s = mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
decode j = mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j)
mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
mapLeft f (Left l) = Left (f l)
mapLeft _ (Right r) = Right r
removeTaskFromList :: Array GT.AsyncTaskWithType -> GT.AsyncTaskWithType -> Array GT.AsyncTaskWithType
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
src/Gargantext/Components/Forest.purs
View file @
20879d3c
...
...
@@ -3,6 +3,7 @@ module Gargantext.Components.Forest where
import Gargantext.Prelude
import Data.Array as A
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Tuple (fst)
...
...
@@ -11,6 +12,7 @@ import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Components.Forest.Tree.Node.Action (Reload)
import Gargantext.Ends (Frontends)
...
...
@@ -35,15 +37,16 @@ forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
-- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty
R2.useCache
(frontends /\ route /\ sessions /\ fst openNodes /\ fst extReload /\ fst reload)
(cpt' openNodes reload showLogin)
cpt' openNodes
reload showLogin (frontends /\ route /\ sessions
/\ _ /\ _ /\ _) = do
(frontends /\ route /\ sessions /\ fst openNodes /\ fst extReload /\ fst reload
/\ fst asyncTasks
)
(cpt' openNodes
asyncTasks
reload showLogin)
cpt' openNodes
asyncTasks reload showLogin (frontends /\ route /\ sessions /\ _
/\ _ /\ _ /\ _) = do
pure $ R.fragment $ A.cons (plus showLogin) trees
where
trees = tree <$> unSessions sessions
tree s@(Session {treeId}) =
treeView { root: treeId, frontends, mCurrentRoute: Just route, session: s, openNodes, reload }
treeView { root: treeId,
asyncTasks,
frontends, mCurrentRoute: Just route, session: s, openNodes, reload }
plus :: R2.Setter Boolean -> R.Element
plus showLogin =
...
...
src/Gargantext/Components/Forest/Tree.purs
View file @
20879d3c
module Gargantext.Components.Forest.Tree where
import DOM.Simple.Console (log2)
import Data.Array as A
import Data.Maybe (Maybe)
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Set as Set
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R
...
...
@@ -13,13 +15,14 @@ import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, deleteNode, loadNode, renameNode)
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
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
, Tasks, tasksStruct
)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>))
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>)
, identity
)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT
...
...
@@ -36,6 +39,7 @@ type CommonProps =
------------------------------------------------------------------------
type Props = ( root :: ID
, asyncTasks :: R.State GAT.Storage
| CommonProps
)
...
...
@@ -55,20 +59,23 @@ treeLoadView p = R.createElement treeLoadViewCpt p []
treeLoadViewCpt :: R.Component Props
treeLoadViewCpt = R.hooksComponent "TreeLoadView" cpt
where
cpt {
root, mCurrentRoute, session, frontends, openNodes, reload} _
= do
cpt {
root, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children
= do
let fetch _ = loadNode session root
let paint loaded = loadedTreeView { tree: loaded
let paint loaded = loadedTreeView {
asyncTasks
, frontends
, mCurrentRoute
, openNodes
, reload
, session
,
frontends
,
openNodes, reloa
d
,
tasks: tasksStruct root asyncTasks reload
,
tree: loade
d
}
useLoader { root
, counter: fst reload
}
fetch paint
useLoader { root, counter: fst reload } fetch paint
type TreeViewProps = ( tree :: FTree
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree
, tasks :: Record Tasks
| CommonProps
)
...
...
@@ -78,29 +85,28 @@ loadedTreeView p = R.createElement loadedTreeViewCpt p []
loadedTreeViewCpt :: R.Component TreeViewProps
loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt
where
cpt {tree, mCurrentRoute, session, frontends, openNodes, reload} _ = do
tasks <- R.useState' []
cpt { asyncTasks, frontends, mCurrentRoute, openNodes, reload, tasks, tree, session } _ = do
pure $ H.div {className: "tree"}
[ toHtml { frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
[ toHtml {
asyncTasks,
frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
------------------------------------------------------------------------
type ToHtmlProps =
(
tasks :: R.State (Array GT.AsyncTaskWithType)
asyncTasks :: R.State GAT.Storage
, tasks :: Record Tasks
, tree :: FTree
| CommonProps
)
toHtml :: Record ToHtmlProps -> R.Element
toHtml p@{ frontends
toHtml p@{ asyncTasks
, frontends
, mCurrentRoute
, openNodes
, reload: reload@(_ /\ setReload)
, session
, tasks: tasks@(asyncTasks /\ setAsyncTasks)
, tree: tree@(NTree (LNode {id, name, nodeType}) ary)
} = R.createElement el {} []
, tasks: tasks@{ onTaskAdd, onTaskFinish, tasks: tasks' }
, tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
commonProps = RecordE.pick p :: Record CommonProps
...
...
@@ -118,31 +124,26 @@ toHtml p@{ frontends
pure $ H.ul {}
[ H.li {}
( [ nodeMainSpan { id
, asyncTasks
, dispatch: pAction
, folderOpen
, frontends
, mCurrentRoute
, name
, nodeType
, onAsyncTaskFinish
, session
, tasks
} ]
<> childNodes (Record.merge commonProps
{ children: ary
{ asyncTasks
, children: ary
, folderOpen })
)
]
onAsyncTaskFinish (GT.AsyncTaskWithType {task: GT.AsyncTask {id: id'}}) = do
setAsyncTasks $ const newAsyncTasks
setReload (_ + 1)
where
newAsyncTasks = A.filter (\(GT.AsyncTaskWithType {task: GT.AsyncTask {id: id''}}) -> id' /= id'') asyncTasks
type ChildNodesProps =
( children :: Array FTree
( asyncTasks :: R.State GAT.Storage
, children :: Array FTree
, folderOpen :: R.State Boolean
| CommonProps
)
...
...
@@ -150,24 +151,23 @@ type ChildNodesProps =
childNodes :: Record ChildNodesProps -> Array R.Element
childNodes { children: [] } = []
childNodes { folderOpen: (false /\ _) } = []
childNodes props@{ children } =
map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted children
where
commonProps = RecordE.pick props :: Record CommonProps
sorted :: Array FTree -> Array FTree
sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
childNode :: Tree -> R.Element
childNode props = R.createElement el props []
el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, asyncTasks} _ = do
tasks <- R.useState' asyncTasks
pure $ toHtml (Record.merge commonProps { tasks, tree })
childNodes props@{ asyncTasks, children, reload } =
map (\ctree@(NTree (LNode {id}) _) ->
toHtml (Record.merge commonProps {
asyncTasks
, tasks: tasksStruct id asyncTasks reload
, tree: ctree
})) $ sorted children
where
commonProps = RecordE.pick props :: Record CommonProps
sorted :: Array FTree -> Array FTree
sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
type PerformActionProps =
( openNodes :: R.State OpenNodes
, reload :: R.State Reload
, session :: Session
, tasks :: R
.State (Array GT.AsyncTaskWithType)
, tasks :: R
ecord Tasks
, tree :: FTree
)
...
...
@@ -185,10 +185,9 @@ performAction p@{ openNodes: (_ /\ setOpenNodes)
performAction { reload: (_ /\ setReload)
, session
, tasks: (_ /\ setAsyncTasks)
, tree: (NTree (LNode {id}) _)
} (SearchQuery task) = do
liftEffect $ setAsyncTasks $ A.cons task
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _) } (SearchQuery task) = do
liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] SearchQuery task:" task
performAction { reload: (_ /\ setReload)
...
...
@@ -206,21 +205,18 @@ performAction p@{ reload: (_ /\ setReload)
performAction p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, tasks: (_ /\ setAsyncTasks)
, session
, tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
-- task <- createNodeAsync session id $ CreateValue {name, nodeType}
task <- addNode session id $ AddNodeValue {name, nodeType}
-- liftEffect $ setAsyncTasks $ A.cons task
liftEffect do
setOpenNodes (Set.insert (mkNodeId session id))
performAction p RefreshTree
performAction { session
, tasks:
(_ /\ setAsyncTasks)
, tasks:
{ onTaskAdd }
, tree: (NTree (LNode {id}) _) } (UploadFile nodeType fileType mName contents) = do
task <- uploadFile session nodeType id fileType {mName, contents}
liftEffect $
setAsyncTasks $ A.cons
task
liftEffect $
onTaskAdd
task
liftEffect $ log2 "uploaded, task:" task
performAction { reload: (_ /\ setReload) } RefreshTree = do
...
...
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @
20879d3c
module Gargantext.Components.Forest.Tree.Node.Box where
import Gargantext.Prelude
import Data.Array as A
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Nullable (Nullable, null)
import Data.Tuple (fst, Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM
import DOM.Simple.Event
import DOM.Simple.EventListener
import DOM.Simple.Types
import DOM.Simple.Window
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null)
import Data.Tuple (fst, Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Console
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.AsyncTasks as GAT
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,
Reload,
UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView)
...
...
@@ -38,15 +48,27 @@ import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
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)
type Dispatch = Action -> Aff Unit
type Tasks =
(
onTaskAdd :: GT.AsyncTaskWithType -> Effect Unit
, onTaskFinish :: GT.AsyncTaskWithType -> Effect Unit
, tasks :: Array GT.AsyncTaskWithType
)
tasksStruct :: Int -> R.State GAT.Storage -> R.State Reload -> Record Tasks
tasksStruct id (asyncTasks /\ setAsyncTasks) (_ /\ setReload) = { onTaskAdd, onTaskFinish, tasks }
where
tasks = maybe [] identity $ Map.lookup id asyncTasks
onTaskAdd t = do
setReload (_ + 1)
setAsyncTasks $ Map.alter (maybe (Just [t]) $ (\ts -> Just $ A.cons t ts)) id
onTaskFinish t = do
setReload (_ + 1)
setAsyncTasks $ Map.alter (maybe Nothing $ (\ts -> Just $ GAT.removeTaskFromList ts t)) id
type CommonProps =
( dispatch :: Dispatch
, session :: Session
...
...
@@ -55,13 +77,12 @@ type CommonProps =
-- Main Node
type NodeMainSpanProps =
( id :: ID
, asyncTasks :: Array GT.AsyncTaskWithType
, folderOpen :: R.State Boolean
, frontends :: Frontends
, mCurrentRoute :: Maybe Routes.AppRoute
, name :: Name
, nodeType :: GT.NodeType
,
onAsyncTaskFinish :: GT.AsyncTaskWithType -> Effect Unit
,
tasks :: Record Tasks
| CommonProps
)
...
...
@@ -70,7 +91,7 @@ nodeMainSpan :: Record NodeMainSpanProps
nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el p []
where
el = R.hooksComponent "G.C.F.T.N.B.NodeMainSpan" cpt
cpt props@{id,
asyncTasks, mCurrentRoute, name, nodeType, onAsyncTaskFinish
} _ = do
cpt props@{id,
mCurrentRoute, name, nodeType, tasks: { onTaskFinish, tasks }
} _ = do
-- only 1 popup at a time is allowed to be opened
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
...
...
@@ -102,8 +123,8 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie
, corpusId: id
, onFinish: const $ on
Async
TaskFinish t
, session })
asyncT
asks)
, onFinish: const $ onTaskFinish t
, session })
t
asks)
]
where
SettingsBox {show: showBox} = settingsBox nodeType
...
...
src/Gargantext/Types.purs
View file @
20879d3c
...
...
@@ -439,14 +439,11 @@ type AffTableResult a = Aff (TableResult a)
data Mode = Authors | Sources | Institutes | Terms
derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where
show = genericShow
derive instance eqMode :: Eq Mode
instance ordMode :: Ord Mode where
compare = genericCompare
instance encodeMode :: EncodeJson Mode where
encodeJson x = encodeJson $ show x
...
...
@@ -457,41 +454,51 @@ modeTabType Institutes = CTabInstitutes
modeTabType Terms = CTabTerms
modeFromString :: String -> Maybe Mode
modeFromString "Authors"
= Just Authors
modeFromString "Sources"
= Just Sources
modeFromString "Authors" = Just Authors
modeFromString "Sources" = Just Sources
modeFromString "Institutes" = Just Institutes
modeFromString "Terms"
= Just Terms
modeFromString _
= Nothing
modeFromString "Terms" = Just Terms
modeFromString _ = Nothing
--
|
Async tasks
-- Async tasks
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form
| GraphT
| Query
| AddNode
| UpdateNode
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
instance eqAsyncTaskType :: Eq AsyncTaskType where
eq = genericEq
instance showAsyncTaskType :: Show AsyncTaskType where
show = genericShow
instance encodeJsonAsyncTaskType :: EncodeJson AsyncTaskType where
encodeJson t = encodeJson $ show t
instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
decodeJson json = do
obj <- decodeJson json
case obj of
"Form" -> pure Form
"GraphT" -> pure GraphT
"Query" -> pure Query
"AddNode" -> pure AddNode
s -> Left ("Unknown string " <> s)
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "async/"
type AsyncTaskID = String
data AsyncTaskStatus = Running
| Pending
| Received
| Started
| Failed
| Finished
| Killed
data AsyncTaskStatus = Running | Pending | Received | Started | Failed | Finished | Killed
derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
instance showAsyncTaskStatus :: Show AsyncTaskStatus where
show = genericShow
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
instance encodeJsonAsyncTaskStatus :: EncodeJson AsyncTaskStatus where
encodeJson s = encodeJson $ show s
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
decodeJson json = do
obj <- decodeJson json
...
...
@@ -507,46 +514,64 @@ readAsyncTaskStatus "IsRunning" = Running
readAsyncTaskStatus "IsStarted" = Started
readAsyncTaskStatus _ = Running
newtype AsyncTask =
AsyncTask {
id :: AsyncTaskID
, status :: AsyncTaskStatus
}
newtype AsyncTask =
AsyncTask {
id :: AsyncTaskID
, status :: AsyncTaskStatus
}
derive instance genericAsyncTask :: Generic AsyncTask _
instance eqAsyncTask :: Eq AsyncTask where
eq = genericEq
instance encodeJsonAsyncTask :: EncodeJson AsyncTask where
encodeJson (AsyncTask { id, status }) =
"id" := id
~> "status" := status
~> jsonEmptyObject
instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
decodeJson json = do
obj <- decodeJson json
id
<- obj .: "id"
id <- obj .: "id"
status <- obj .: "status"
pure $ AsyncTask {id, status}
newtype AsyncTaskWithType =
AsyncTaskWithType { task :: AsyncTask
, typ :: AsyncTaskType
}
newtype AsyncProgress =
AsyncProgress { id :: AsyncTaskID
, log :: Array AsyncTaskLog
, status :: AsyncTaskStatus
}
pure $ AsyncTask { id, status }
newtype AsyncTaskWithType = AsyncTaskWithType {
task :: AsyncTask
, typ :: AsyncTaskType
}
derive instance genericAsyncTaskWithType :: Generic AsyncTaskWithType _
instance eqAsyncTaskWithType :: Eq AsyncTaskWithType where
eq = genericEq
instance encodeJsonAsyncTaskWithType :: EncodeJson AsyncTaskWithType where
encodeJson (AsyncTaskWithType { task, typ }) =
"task" := task
~> "typ" := typ
~> jsonEmptyObject
instance decodeJsonAsyncTaskWithType :: DecodeJson AsyncTaskWithType where
decodeJson json = do
obj <- decodeJson json
task <- obj .: "task"
typ <- obj .: "typ"
pure $ AsyncTaskWithType { task, typ }
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"
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
}
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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment