Commit 601396b6 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into 342-tuning-task-attributes

parents e3a0f1f9 4e609023
Pipeline #35350 passed with stage
in 6 minutes and 54 seconds
......@@ -38,6 +38,35 @@ importCSVDocumentWith :: !Char !Char !Char !Document -> Task [[String]]
* @return The exported content as a document
*/
createCSVFile :: !String ![[String]] -> Task Document
/**
* Export a list of rows of fields to a comma separated vector (CSV) document.
*
* @param Separator: The field separator
* @param Quote character: The string quote character
* @param Escape character: The escape character
* @param File name: A name of the created CSV file
* @param Cells: The content to export as a list of rows of lists of fields
*
* @return The exported content as a document
*/
createCSVFileWith :: !Char !Char !Char !String ![[String]] -> Task Document
/**
* Export a list of rows of fields to a comma separated vector (CSV) document encoded in UTF-8.
* The file starts with a UTF-8 byte order mask.
* This is to make sure the Excel correctly detect the encoding when importing the file.
*
* @param Separator: The field separator
* @param Quote character: The string quote character
* @param Escape character: The escape character
* @param File name: A name of the created CSV file
* @param Cells: The content to export as a list of rows of lists of fields
*
* @return The exported content as a document
*/
createUtf8CSVFileWith :: !Char !Char !Char !String ![[String]] -> Task Document
/**
* Export a list of rows of fields to a comma separated vector (CSV) file on the server's filesystem.
*
......
......@@ -2,7 +2,7 @@ implementation module iTasks.Extensions.CSVFile
import StdBool, StdList, System.FilePath, Text, Text.CSV, System.File, Data.Error
import iTasks.Internal.IWorld, iTasks.Internal.Task, iTasks.Internal.TaskState
import iTasks.Extensions.Document
import iTasks, iTasks.Extensions.TextFile, iTasks.Extensions.Document
importCSVFile :: !FilePath -> Task [[String]]
importCSVFile filename = mkInstantTask eval
......@@ -28,17 +28,35 @@ where
# (filename,iworld) = documentLocation documentId iworld
= fileTaskRead taskId filename (readCSVFileWith delimitChar quoteChar escapeChar) iworld
createCSVFile :: !String ![[String]] -> Task Document
createCSVFile filename content = mkInstantTask eval
createCSVFile filename content =
withTemporaryDirectory
(\dir -> let tmpFilePath = dir </> filename in exportCSVFile filename content >-| importDocument tmpFilePath)
createCSVFileWith :: !Char !Char !Char !String ![[String]] -> Task Document
createCSVFileWith delimitChar quoteChar escapeChar filename content =
withTemporaryDirectory
( \dir ->
let tmpFilePath = dir </> filename in
exportCSVFileWith delimitChar quoteChar escapeChar filename content >-| importDocument tmpFilePath
)
createUtf8CSVFileWith :: !Char !Char !Char !String ![[String]] -> Task Document
createUtf8CSVFileWith delimitChar quoteChar escapeChar filename content =
withTemporaryDirectory
( \dir ->
let tmpFilePath = dir </> filename in
exportCSVFileWith delimitChar quoteChar escapeChar filename content >-|
importTextFile tmpFilePath >>- \fileContent ->
mkInstantTask (createDoc fileContent)
)
where
eval taskId iworld=:{current={taskTime}}
# csv = join "\n" (map (join ",") content)
# (mbDoc,iworld) = createDocument filename "text/csv" csv iworld
createDoc fileContent _ iworld
# (mbDoc, iworld) = createDocument filename "text/csv" ("\xEF\xBB\xBF" +++ fileContent) iworld
= case mbDoc of
Ok doc = (Ok doc, iworld)
Error e = (Error (dynamic e,toString e),iworld)
Ok doc -> (Ok doc, iworld)
Error e -> (Error (dynamic e, toString e), iworld)
exportCSVFile :: !FilePath ![[String]] -> Task [[String]]
exportCSVFile filename content = mkInstantTask eval
where
......
......@@ -14,8 +14,9 @@ import iTasks
* @param Recipients: The recipient addresses
* @param Subject: The subject line of the e-mail message
* @param Body: The body of the e-mail message
* @param Attachments: Attachments added to the e-mail message
*/
sendEmail :: ![EmailOpt] !String ![String] !String !String -> Task ()
sendEmail :: ![EmailOpt] !String ![String] !String !String ![Attachment] -> Task ()
/**
* Send an e-mail message with HTML body.
......@@ -25,8 +26,9 @@ sendEmail :: ![EmailOpt] !String ![String] !String !String -> Task ()
* @param Recipients: The recipient addresses
* @param Subject: The subject line of the e-mail message
* @param Body: The HTML body of the e-mail message. Text has to be UTF-8 encoded.
* @param Attachments: Attachments added to the e-mail message.
*/
sendHtmlEmail :: ![EmailOpt] !String ![String] !String !HtmlTag -> Task ()
sendHtmlEmail :: ![EmailOpt] !String ![String] !String !HtmlTag ![Attachment] -> Task ()
//Options for sendEmail
:: EmailOpt
......@@ -34,3 +36,9 @@ sendHtmlEmail :: ![EmailOpt] !String ![String] !String !HtmlTag -> Task ()
| EmailOptSMTPServerPort !Int //TCP port of the SMTP server to use. Default: 25
| EmailOptExtraHeaders ![(String,String)] //Additional headers to add before the body
| EmailOptTimeout !Timeout // TCP timeout
//* Email attachment.
:: Attachment =
{ name :: !String //* The attachment's filename.
, content :: !{#Char} //* Content of the attachment, arbitrary binary data.
}
implementation module iTasks.Extensions.Email
import iTasks
import StdEnv
import Data.Functor, Data.Func
import Text, Text.HTML
import Text, Text.HTML, Text.Encodings.Base64
import iTasks
sendEmail :: ![EmailOpt] !String ![String] !String !String -> Task ()
sendEmail opts sender recipients subject body
sendEmail :: ![EmailOpt] !String ![String] !String !String ![Attachment] -> Task ()
sendEmail opts sender recipients subject body attachments
= tcpconnect server port timeout (constShare ()) {ConnectionHandlers|onConnect=onConnect,onData=onData,onDisconnect=onDisconnect,onShareChange = \l _ = (Ok l, Nothing, [], False), onDestroy= \s->(Ok s, [])}
@! ()
where
......@@ -25,7 +26,7 @@ where
((\recipient -> (smtpTo recipient, 250)) <$> recipients)
++
[(smtpData, 354)
,(smtpBody sender recipients headers subject body, 250)
,(smtpBody sender recipients headers subject body attachments, 250)
,(smtpQuit, 221)
]
......@@ -50,10 +51,15 @@ where
onDisconnect _ _
= (Error "SMTP server disconnected unexpectedly",Nothing)
sendHtmlEmail :: ![EmailOpt] !String ![String] !String !HtmlTag -> Task ()
sendHtmlEmail opts sender recipients subject body =
sendHtmlEmail :: ![EmailOpt] !String ![String] !String !HtmlTag ![Attachment] -> Task ()
sendHtmlEmail opts sender recipients subject body attachments =
sendEmail
[EmailOptExtraHeaders [("content-type", "text/html; charset=UTF8")]: opts] sender recipients subject htmlString
[EmailOptExtraHeaders [("content-type", "text/html; charset=UTF8")]: opts]
sender
recipients
subject
htmlString
attachments
where
// avoid too long lines (SMTP allows a max length of 1000 characters only)
// by inserting a newline (\r\n is required for mails) after each tag
......@@ -64,15 +70,36 @@ smtpHelo = "HELO localhost\r\n"
smtpFrom email_from = "MAIL FROM:<" +++ (cleanupEmailString email_from) +++ ">\r\n"
smtpTo email_to = "RCPT TO:<" +++ (cleanupEmailString email_to) +++ ">\r\n"
smtpData = "DATA\r\n"
smtpBody email_from email_to email_headers email_subject email_body
= concat [k+++":"+++ v +++ "\r\n" \\ (k,v) <-
[("From",cleanupEmailString email_from)
: (\email_to -> ("To",cleanupEmailString email_to)) <$> email_to
] ++
[("Subject",cleanupEmailString email_subject)
:email_headers]
]
+++ "\r\n" +++ email_body +++ "\r\n.\r\n"
smtpBody email_from email_to bodyHeaders email_subject email_body attachments =
concat $ flatten $
[ [k, ":", v, "\r\n"]
\\ (k, v) <-
[ ("From", cleanupEmailString email_from)
: (\email_to -> ("To", cleanupEmailString email_to)) <$> email_to
]
++
[("Subject", cleanupEmailString email_subject)]
]
++
if (isEmpty attachments) [] [["Content-Type: multipart/mixed; boundary=sep\r\n--sep\r\n"]]
++
[[k, ":", v, "\r\n"] \\ (k, v) <- bodyHeaders]
++
[["\r\n", email_body, "\r\n"], if (isEmpty attachments) [] ["--sep"], ["\r\n"]]
++
[ flatten $
[ [ "content-type: application/octet-stream; name=\"", attachment.Attachment.name, "\"\r\n"
, "content-disposition: attachment; filename=\"", attachment.Attachment.name, "\"\r\n"
, "content-transfer-encoding: base64\r\n"
, "\r\n"
]
, withRestrictedLineLength (base64Encode attachment.content)
, ["\r\n--sep\r\n"]
]
\\ attachment <- attachments
]
++
[[".\r\n"]]
smtpQuit = "QUIT\r\n"
//Utility functions
......@@ -100,3 +127,13 @@ getHeadersOpt [x:xs] = getHeadersOpt xs
getTimeoutOpt [] = Nothing
getTimeoutOpt [EmailOptTimeout t:xs] = Just t
getTimeoutOpt [x:xs] = getTimeoutOpt xs
//* Cut into lines of 1000 character (including "\r\n"), to fulfil SMTP standard.
withRestrictedLineLength :: !String -> [String]
withRestrictedLineLength str = reverse $ withRestrictedLineLength` 0 []
where
withRestrictedLineLength` i acc
| strSize - i <= 998 = [str % (i, strSize - 1): acc]
| otherwise = withRestrictedLineLength` (i + 998) ["\r\n", str % (i, i + 997): acc]
strSize = size str
implementation module iTasks.Extensions.TextFile
import StdBool, StdList, StdFile, StdArray, System.FilePath, Text, System.File, Data.Error, StdString
import StdBool, StdList, StdFile, StdArray, StdString, System.FilePath, Text, System.File, Data.Error, Data.Func
import iTasks.Internal.IWorld, iTasks.Internal.Task, iTasks.Internal.TaskState
import iTasks.Extensions.Document
......@@ -38,14 +38,15 @@ fileTaskRead taskId filename f iworld=:{IWorld|current={taskTime},world}
# (ok,world) = fclose file world
| not ok = (closeException filename,{IWorld|iworld & world = world})
= (Ok res, {IWorld|iworld & world = world})
readAll file
# (chunk,file) = freads file CHUNK_SIZE
| size chunk < CHUNK_SIZE
= (chunk,file)
| otherwise
# (rest,file) = readAll file
= (chunk +++ rest,file)
readAll :: !*File -> (!String, !*File)
readAll file = readAll` [] file
where
readAll` :: ![String] !*File -> (!String, !*File)
readAll` acc file
# (chunk,file) = freads file CHUNK_SIZE
| size chunk < CHUNK_SIZE = (concat $ reverse [chunk: acc], file)
| otherwise = readAll` [chunk: acc] file
writeAll content file
= fwrites content file
......
......@@ -44,7 +44,7 @@ wrapIWorldConnectionTask :: (ConnectionHandlersIWorld l r w) (sds () r w) -> Con
/**
* Create a task that finishes instantly
*/
mkInstantTask :: (TaskId *IWorld -> (MaybeError TaskException a,*IWorld)) -> Task a | iTask a
mkInstantTask :: (TaskId *IWorld -> (MaybeError TaskException a,*IWorld)) -> Task a
/**
* Apply a function on the task continuation of the task result
......
......@@ -115,7 +115,7 @@ where
= (toDyn <$> mbl, out, env)
onDestroy` l env = abort ("onDestroy does not match with type l=" +++ toString (typeCodeOfDynamic l))
mkInstantTask :: (TaskId *IWorld -> (MaybeError TaskException a,*IWorld)) -> Task a | iTask a
mkInstantTask :: (TaskId *IWorld -> (MaybeError TaskException a,*IWorld)) -> Task a
mkInstantTask iworldfun = Task eval
where
eval DestroyEvent _ iworld = (DestroyedResult, iworld)
......
......@@ -80,6 +80,7 @@ where
wrapEditor = sequenceLayouts
[wrapUI UIContainer
,copySubUIAttributes SelectAll [0] []
,delUIAttributes (SelectKeys ["initUI","taskId","editorId"]) //Don't duplicate the UI initialization code
,layoutSubUIs hasTitle (setUIType UIPanel)
,layoutSubUIs hasPrompt (sequenceLayouts [createPrompt,fillPrompt])
]
......
......@@ -18,7 +18,7 @@ instance Functor Task
* @param The possible continuations
* @return The continuation's result
*/
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | iTask a & iTask b
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | TC, JSONEncode{|*|} a
//Standard monadic operations:
......@@ -31,7 +31,7 @@ instance Functor Task
* @param Second: The second task, which receives the result of the first task
* @return The combined task
*/
(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially. The first task is executed first.
......@@ -42,7 +42,7 @@ instance Functor Task
* @param Second: The second task
* @return The combined task
*/
(>>|) infixl 1 :: !(Task a) !(Task b) -> Task b | iTask a & iTask b
(>>|) infixl 1 :: !(Task a) !(Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially but explicitly waits for user input to confirm the completion of
......@@ -52,7 +52,7 @@ instance Functor Task
* @param Second: The second task, which receives the result of the first task
* @return The combined task
*/
(>>!) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>!) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially but continues only when the first task has a stable value.
*
......@@ -60,7 +60,7 @@ instance Functor Task
* @param Second: The second task, which receives the result of the first task
* @return The combined task
*/
(>>-) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>-) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially but continues only when the first task has a stable value.
*
......@@ -78,7 +78,7 @@ instance Functor Task
* @param Second: The second task, which receives the result of the first task
* @return The combined task
*/
(>>~) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>~) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially just as >>=, but the result of the second task is disregarded.
*
......@@ -87,7 +87,7 @@ instance Functor Task
*
* @return The combined task
*/
(>>^) infixl 1 :: !(Task a) (Task b) -> Task a| iTask a & iTask b
(>>^) infixl 1 :: !(Task a) (Task b) -> Task a| TC, JSONEncode{|*|} a & TC, JSONEncode{|*|} b
/**
* Infix shorthand for transform combinator
*
......
......@@ -28,25 +28,25 @@ import iTasks.WF.Tasks.SDS
instance Functor Task where
fmap f t = t @ f
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | iTask a & iTask b
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | TC, JSONEncode{|*|} a
(>>*) task steps = step task (const Nothing) steps
(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
(>>=) taska taskbf = step taska (const Nothing) [OnAction ActionContinue (hasValue taskbf), OnValue (ifStable taskbf)]
(>>|) infixl 1 :: !(Task a) !(Task b) -> Task b | iTask a & iTask b
(>>|) infixl 1 :: !(Task a) !(Task b) -> Task b | TC, JSONEncode{|*|} a
(>>|) l r = l >>* [OnAction ActionContinue (always r), OnValue (ifStable (\_->r))]
(>>!) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>!) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
(>>!) taska taskbf = step taska (const Nothing) [OnAction ActionContinue (hasValue taskbf)]
(>>-) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>-) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
(>>-) taska taskbf = step taska (const Nothing) [OnValue (ifStable taskbf)]
(>>~) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>~) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
(>>~) taska taskbf = step taska (const Nothing) [OnValue (hasValue taskbf)]
(>>^) infixl 1 :: !(Task a) (Task b) -> Task a | iTask a & iTask b
(>>^) infixl 1 :: !(Task a) (Task b) -> Task a | TC, JSONEncode{|*|} a & TC, JSONEncode{|*|} b
(>>^) taska taskb = taska >>= \x -> taskb >>| return x
(@?) infixl 1 :: !(Task a) !((TaskValue a) -> TaskValue b) -> Task b
......
......@@ -17,7 +17,7 @@ from iTasks.UI.Editor import :: EditMode
* @default ()
* @return A task that will return the value defined by the parameter
*/
return :: !a -> Task a | iTask a
return :: !a -> Task a
//Backwards compatibility
treturn :== return
......@@ -29,7 +29,7 @@ treturn :== return
* @param Value: The exception value
* @return The combined task
*/
throw :: !e -> Task a | iTask a & iTask, toString e
throw :: !e -> Task a | TC, toString e
/**
* Evaluate a "World" function that does not yield any result once.
......@@ -45,7 +45,7 @@ appWorld :: !(*World -> *World) -> Task ()
* @param World function: The function to evaluate
* @return A task that evaluates the function and yield a
*/
accWorld :: !(*World -> *(a,*World)) -> Task a | iTask a
accWorld :: !(*World -> *(a,*World)) -> Task a
/**
* Evaluate a "World" function that also returns a MaybeError value.
......@@ -55,7 +55,7 @@ accWorld :: !(*World -> *(a,*World)) -> Task a | iTask a
*
* @return A task that evaluates the function
*/
accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a | iTask a & TC, toString err
accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a | TC, toString err
/**
* Evaluate a "World" function that also returns a MaybeOSError value.
......@@ -65,7 +65,7 @@ accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a |
*
* @return A task that evaluates the function
*/
accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a | iTask a
accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a
:: OSException = OSException !OSError
instance toString OSException
......
......@@ -19,19 +19,19 @@ import StdString, StdBool, StdInt, StdMisc, StdFunc
import qualified Data.Set as DS
import qualified Data.Map as DM
return :: !a -> (Task a) | iTask a
return :: !a -> (Task a)
return a = mkInstantTask (\taskId iworld-> (Ok a, iworld))
throw :: !e -> Task a | iTask a & iTask, toString e
throw :: !e -> Task a | TC, toString e
throw e = mkInstantTask (\taskId iworld -> (Error (exception e), iworld))
appWorld :: !(*World -> *World) -> Task ()
appWorld fun = accWorld $ tuple () o fun
accWorld :: !(*World -> *(a, *World)) -> Task a | iTask a
accWorld :: !(*World -> *(a, *World)) -> Task a
accWorld fun = accWorldError (appFst Ok o fun) \_->""
accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a | iTask a & TC, toString err
accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a | TC, toString err
accWorldError fun errf = mkInstantTask eval
where
eval taskId iworld=:{IWorld|world}
......@@ -40,7 +40,7 @@ where
Error e = (Error (exception (errf e)), {IWorld|iworld & world = world})
Ok v = (Ok v, {IWorld|iworld & world = world})
accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a | iTask a
accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a
accWorldOSError fun = accWorldError fun OSException
instance toString OSException
......@@ -58,18 +58,34 @@ interactR shared handlers editor
= Task (readRegisterCompletely shared NoValue (\event->mkUIIfReset event (asyncSDSLoaderUI Read)) (evalInteractInit shared handlers editor \_ _->modifyCompletely (\()->undef) nullShare))
//This initializes the editor state and continues with the actual interact task
evalInteractInit sds handlers editor writefun r event evalOpts=:{TaskEvalOpts|taskId} iworld
evalInteractInit sds handlers editor writefun r _ evalOpts iworld
//Get initial value
# mode = handlers.onInit r
# v = case mode of
Enter = Nothing
Update x = Just x
View x = Just x
= evalInteract r v Nothing (mode=:View _) sds handlers editor writefun ResetEvent evalOpts iworld
= evalInteractInitWithValue r v (mode =: View _) sds handlers editor writefun evalOpts iworld
evalInteractInitWithValue r v mode sds handlers editor writefun evalOpts=:{TaskEvalOpts|taskId, lastEval} iworld
# resetMode = case (mode, v) of
(True, Just v) = View v
(True, _) = abort "view mode without value\n"
(_, Nothing) = Enter
(_, Just v) = Update v
= case withVSt taskId (editor.Editor.genUI 'DM'.newMap [] resetMode) iworld of
(Error e, iworld) = (ExceptionResult (exception e), iworld)
(Ok (UI type attr items, st), iworld)
# change = ReplaceUI (UI type (addClassAttr "interact" attr) items)
= (ValueResult
(maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld)
evalInteract ::
r
(Maybe v)
(Maybe EditState)
Bool
(sds () r w)
......@@ -90,9 +106,9 @@ evalInteract ::
*IWorld
-> *(TaskResult (r,v),*IWorld)
| iTask r & iTask v & TC r & TC w & Registrable sds
evalInteract _ _ _ _ _ _ _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
evalInteract _ _ _ _ _ _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
= (DestroyedResult, 'SDS'.clearTaskSDSRegistrations ('DS'.singleton taskId) iworld)
evalInteract r v mst mode sds handlers editor writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld
evalInteract r mst mode sds handlers editor writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld
| isNothing mst = (ExceptionResult (exception "corrupt editor state"), iworld)
| eTaskId == taskId
# (res, iworld) = withVSt taskId (editor.Editor.onEdit [] (s2dp name,edit) (fromJust mst)) iworld
......@@ -112,7 +128,7 @@ evalInteract r v mst mode sds handlers editor writefun event=:(EditEvent eTaskId
(Value (r,nv) False)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r (Just nv) (Just st) mode sds handlers editor writefun))
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld))
event evalOpts iworld
//There is no update function
......@@ -121,37 +137,23 @@ evalInteract r v mst mode sds handlers editor writefun event=:(EditEvent eTaskId
(Value (r,nv) False)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r (Just nv) (Just st) mode sds handlers editor writefun))
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld)
Nothing
= (ValueResult
NoValue
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r Nothing (Just st) mode sds handlers editor writefun))
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld)
Error e = (ExceptionResult (exception e), iworld)
evalInteract r v mst mode sds handlers editor writefun ResetEvent evalOpts=:{taskId,lastEval} iworld
# resetMode = case (mode, v) of
(True, Just v) = View v
(True, _) = abort "view mode without value\n"
(_, Nothing) = Enter
(_, Just v) = Update v
= case withVSt taskId (editor.Editor.genUI 'DM'.newMap [] resetMode) iworld of
(Error e, iworld) = (ExceptionResult (exception e), iworld)
(Ok (UI type attr items, st), iworld)
# change = ReplaceUI (UI type (addClassAttr "interact" attr) items)
# mbv = editor.Editor.valueFromState st
# v = maybe v Just mbv
= (ValueResult
(maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r v (Just st) mode sds handlers editor writefun))
, iworld)
evalInteract r v mst mode sds handlers editor writefun event=:(RefreshEvent taskIds _) evalOpts=:{taskId,lastEval} iworld
evalInteract r mst mode sds handlers editor writefun ResetEvent evalOpts iworld
# v = maybe Nothing editor.Editor.valueFromState mst
= evalInteractInitWithValue r v mode sds handlers editor writefun evalOpts iworld
evalInteract r mst mode sds handlers editor writefun event=:(RefreshEvent taskIds _) evalOpts=:{taskId,lastEval} iworld
| isNothing mst = (ExceptionResult (exception "corrupt editor state"), iworld)
# st = fromJust mst
# v = editor.Editor.valueFromState st
| 'DS'.member taskId taskIds
= readRegisterCompletely sds (maybe NoValue (\v->Value (r,v) False) v) (\e->mkUIIfReset e (asyncSDSLoaderUI Read))
(\r event evalOpts iworld
......@@ -165,24 +167,25 @@ evalInteract r v mst mode sds handlers editor writefun event=:(RefreshEvent task
# v = editor.Editor.valueFromState st
= case mbf of
Just f = writefun f sds NoValue (\_->change)
(\_->evalInteract r v (Just st) mode sds handlers editor writefun)
(\_->evalInteract r (Just st) mode sds handlers editor writefun)
event evalOpts iworld
Nothing
= (ValueResult
(maybe NoValue (\v -> Value (r,v) False) v)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r v (Just st) mode sds handlers editor writefun))
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld)
)
event evalOpts iworld
evalInteract r v mst mode sds handlers editor writefun event {lastEval} iworld
evalInteract r mst mode sds handlers editor writefun event {lastEval} iworld
# v = maybe Nothing editor.Editor.valueFromState mst
//An event for a sibling?
= (ValueResult
(maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval)
NoChange
(Task (evalInteract r v mst mode sds handlers editor writefun))
(Task (evalInteract r mst mode sds handlers editor writefun))
, iworld)
uniqueMode :: (EditMode a) -> *(EditMode a)
......
......@@ -96,7 +96,7 @@ where
clock = sdsFocus {start=zero,interval=poll} iworldTimespec
tcplisten :: !Int !Bool !(sds () r w) (ConnectionHandlers l r w) -> Task [l] | iTask l & iTask r & iTask w & RWShared sds
tcplisten port removeClosed sds handlers = Task eval
tcplisten port removeClosed sds handlers = Task evalinit
where
evalinit DestroyEvent _ iworld = (DestroyedResult, iworld)
evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
......
......@@ -20,7 +20,7 @@ from Data.Maybe import :: Maybe
* @return The value read
* @throws SharedException
*/
get :: !(sds () a w) -> Task a | iTask a & Readable sds & TC w
get :: !(sds () a w) -> Task a | TC a & Readable sds & TC w
/**
* Writes shared data.
......@@ -30,7 +30,7 @@ get :: !(sds () a w) -> Task a | iTask a & Readable sds & TC w
* @return The value written
* @throws SharedException
*/
set :: !a !(sds () r a) -> Task a | iTask a & TC r & Writeable sds
set :: !a !(sds () r a) -> Task a | TC a & TC r & Writeable sds
/**
* Updates shared data in one atomic operation.
......@@ -40,7 +40,7 @@ set :: !a !(sds () r a) -> Task a | iTask a & TC r & Writeable sds
* @return The value written
* @throws SharedException
*/
upd :: !(r -> w) !(sds () r w) -> Task w | iTask r & iTask w & RWShared sds
upd :: !(r -> w) !(sds () r w) -> Task w | TC r & TC w & RWShared sds
/**
* Reads shared data continously
......@@ -49,5 +49,4 @@ upd :: !(r -> w) !(sds () r w) -> Task w | iTask r & iTask w & RWShared sds
* @return The value read
* @throws SharedException
*/
watch :: !(sds () r w) -> Task r | iTask r & TC w & Readable, Registrable sds
watch :: !(sds () r w) -> Task r | TC r & TC w & Readable, Registrable sds
......@@ -13,16 +13,16 @@ import iTasks.Internal.TaskEval
import iTasks.Internal.TaskState
import iTasks.Internal.Util
get :: !(sds () a w) -> Task a | iTask a & Readable sds & TC w
get :: !(sds () a w) -> Task a | TC a & Readable sds & TC w