Commit f1adf579 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch '241-sequence-becomes-slower-over-time' into 'master'

Resolve "sequence becomes slower over time"

Closes #241

See merge request !182
parents d30db4a9 62fbf150
Pipeline #13509 passed with stage
in 10 minutes and 45 seconds
......@@ -6,7 +6,7 @@ import Incidone.OP.Concepts, Incidone.OP.SDSs, Incidone.OP.ContactManagementTask
importContactsFromCSVFile :: Document -> Task ()
importContactsFromCSVFile doc
= importCSVDocument doc
>>- \csv -> sequence "Importing contacts" (map create (skipHeader csv))
>>- \csv -> sequence (map create (skipHeader csv))
@! ()
where
skipHeader [] = []
......
......@@ -118,7 +118,7 @@ where
@! ()
createIncidoneTables db
= (sequence "Creating Incidone tables" [sqlExecuteCreateTable db table \\ table <- IncidoneDB]
= (sequence [sqlExecuteCreateTable db table \\ table <- IncidoneDB]
>>- viewInformation "Incidone schema created" []) <<@ Title "Creating Incidone tables..."
>>* [OnAction ActionOk (always (return ()))]
......@@ -127,7 +127,7 @@ where
>>? \_ ->
get (sdsFocus db sqlTables)
>>- \tables ->
sequence "Deleting all tables" [sqlExecuteDropTable db table \\ table <- tables]
sequence [sqlExecuteDropTable db table \\ table <- tables]
>>- viewInformation ("Empty database","All data deleted") []
>>* [OnAction ActionOk (always (return ()))]
......@@ -191,7 +191,7 @@ where
-&&-
enterInformation "Immediate close the incidents?" []
>>= \(num,closed) ->
sequence "Generating test incidents" (repeatn num (generateTestIncident closed))
sequence (repeatn num (generateTestIncident closed))
@! ()
configureIntegration :: Task ()
......
......@@ -57,7 +57,7 @@ whileAuthenticated user ents alwaysOnTasks tlist
openAssignedTasks ws = whileUnchanged tasksToDo (doOpen ws) // (watch tasksToDo >>* [OnValue (hasValue (doOpen ws))])
where
doOpen :: Workspace [(TaskId, WorklistRow)] -> Task ()
doOpen ws xs = sequence "openAssignedTasks" (map (\(taskId, _) -> appendOnce taskId (workOn taskId @! ()) ws) xs) @! ()
doOpen ws xs = sequence (map (\(taskId, _) -> appendOnce taskId (workOn taskId @! ()) ws) xs) @! ()
layout = sequenceLayouts
[removeSubUIs (SelectByPath [1]) //Don't show the openAssignedTasks UI
......
......@@ -147,13 +147,12 @@ justdo :: !(Task (Maybe a)) -> Task a | iTask a
/**
* Execute the list of tasks one after another.
*
* @param Label: A label for tracing
* @param Tasks: The list of tasks to be executed sequentially
* @return The combined task
*
* @gin-icon sequence
*/
sequence :: !String ![Task a] -> Task [a] | iTask a
sequence :: ![Task a] -> Task [a] | iTask a
/**
* Repeats a task until a given predicate holds. The predicate is tested as soon as the
......
......@@ -90,17 +90,22 @@ justdo task
Just x = return x
Nothing = throw ("The task returned nothing.")
sequence :: !String ![Task a] -> Task [a] | iTask a
sequence _ tasks = seqTasks tasks
where
seqTasks [] = return []
seqTasks [t:ts] = t >>- \a -> seqTasks ts >>- \as -> return [a:as]
sequence :: ![Task a] -> Task [a] | iTask a
sequence tasks = foreverStIf
//Continue while there are tasks left
(not o isEmpty o snd)
//Initial state, empty accumulator, all tasks
([], tasks)
//Run the first task and add it to the accumulator
(\(acc, [todo:todos])->todo >>- \t->treturn ([t:acc], todos))
//When done, just return the accumulator
@ reverse o fst
foreverStIf :: (a -> Bool) a !(a -> Task a) -> Task a | iTask a
foreverStIf pred st t = parallel [(Embedded, par st Nothing)] []
>>- \tv->case tv of
[(_, Value i True)] = treturn i
_ = throw "Corrupt parallel in foreverStIf"
>>* [OnValue (withValue \v->case v of
[(_, Value i True)] = Just (treturn i)
_ = Nothing)]
where
par st (Just tid) tlist = removeTask tid tlist >>- \_->par st Nothing tlist
par st Nothing tlist
......
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