Commit eb5c9ab2 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into eliminate-sass

parents 524e3075 386ba915
Pipeline #29512 passed with stage
in 4 minutes and 42 seconds
...@@ -2,6 +2,7 @@ implementation module iTasks.Engine ...@@ -2,6 +2,7 @@ implementation module iTasks.Engine
import Data.Func import Data.Func
import Data.Functor import Data.Functor
import Data.List
import Data.Queue import Data.Queue
import Internet.HTTP import Internet.HTTP
import StdEnv import StdEnv
...@@ -53,16 +54,24 @@ doTasksWithOptions initFun startable world ...@@ -53,16 +54,24 @@ doTasksWithOptions initFun startable world
# (Right iworld) = mbIWorld # (Right iworld) = mbIWorld
# (symbolsResult, iworld) = initSymbolsShare options.distributed options.appName iworld # (symbolsResult, iworld) = initSymbolsShare options.distributed options.appName iworld
| symbolsResult =: (Error _) = show ["Error reading symbols while required: " +++ fromError symbolsResult] (setReturnCode 1 (destroyIWorld iworld)) | symbolsResult =: (Error _) = show ["Error reading symbols while required: " +++ fromError symbolsResult] (setReturnCode 1 (destroyIWorld iworld))
# iworld = if (hasDup requestPaths)
(iShow ["Warning: duplicate paths in the web tasks: " +++ join ", " ["'" +++ p +++ "'"\\p<-requestPaths]] iworld)
iworld
# iworld = serve (startupTasks options) (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld # iworld = serve (startupTasks options) (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld
= destroyIWorld iworld = destroyIWorld iworld
where where
webTasks = [t \\ WebTask t <- toStartable startable] requestPaths = [path\\{path}<-webTasks]
webTasks = [t \\ WebTask t <- toStartable startable]
startupTasks {distributed, sdsPort} startupTasks {distributed, sdsPort}
= if webTasks=:[]
//if there are no webtasks: stop when stable
[systemTask (startTask stopOnStable)]
//if there are: show instructions andcleanup old sessions
[startTask viewWebServerInstructions
,systemTask (startTask removeOutdatedSessions)]
//If distributed, start sds service task //If distributed, start sds service task
= (if distributed [systemTask (startTask (sdsServiceTask sdsPort))] []) ++ (if distributed [systemTask (startTask (sdsServiceTask sdsPort))] [])
++ [systemTask (startTask flushWritesWhenIdle) ++ [systemTask (startTask flushWritesWhenIdle)
//If there no webtasks, stop when stable, otherwise cleanup old sessions
,systemTask (startTask if (webTasks =: []) stopOnStable removeOutdatedSessions)
//Start all startup tasks //Start all startup tasks
:[t \\ StartupTask t <- toStartable startable]] :[t \\ StartupTask t <- toStartable startable]]
...@@ -161,17 +170,11 @@ where ...@@ -161,17 +170,11 @@ where
instance Startable (Task a) | iTask a //Default as web task instance Startable (Task a) | iTask a //Default as web task
where where
toStartable task = toStartable task = [onRequest "/" task]
[onStartup viewWebServerInstructions
,onRequest "/" task
]
instance Startable (HTTPRequest -> Task a) | iTask a //As web task instance Startable (HTTPRequest -> Task a) | iTask a //As web task
where where
toStartable task = toStartable task = [onRequestFromRequest "/" task]
[onStartup viewWebServerInstructions
,onRequestFromRequest "/" task
]
instance Startable StartableTask instance Startable StartableTask
where where
......
...@@ -48,8 +48,6 @@ usersWithRole :: !Role -> SDSLens () [User] () ...@@ -48,8 +48,6 @@ usersWithRole :: !Role -> SDSLens () [User] ()
* @param Password: The password * @param Password: The password
* *
* @return A single user who matches the given credentials, or nothing of none or more than one exists. * @return A single user who matches the given credentials, or nothing of none or more than one exists.
* @gin-icon key
*/ */
authenticateUser :: !Username !Password -> Task (Maybe User) authenticateUser :: !Username !Password -> Task (Maybe User)
...@@ -57,8 +55,6 @@ authenticateUser :: !Username !Password -> Task (Maybe User) ...@@ -57,8 +55,6 @@ authenticateUser :: !Username !Password -> Task (Maybe User)
* Wraps a task with an authentication task * Wraps a task with an authentication task
* *
* @param the task to wrap * @param the task to wrap
*
* @gin-icon key
*/ */
doAuthenticated :: (Task a) -> Task a | iTask a doAuthenticated :: (Task a) -> Task a | iTask a
...@@ -71,8 +67,6 @@ doAuthenticatedWith :: !(Credentials -> Task (Maybe User)) (Task a) -> Task a | ...@@ -71,8 +67,6 @@ doAuthenticatedWith :: !(Credentials -> Task (Maybe User)) (Task a) -> Task a |
* @param User details: The user-information which needs to be stored * @param User details: The user-information which needs to be stored
* *
* @return The stored user * @return The stored user
*
* @gin-icon user_add
*/ */
createUser :: !UserAccount -> Task StoredUserAccount createUser :: !UserAccount -> Task StoredUserAccount
/** /**
...@@ -81,8 +75,6 @@ createUser :: !UserAccount -> Task StoredUserAccount ...@@ -81,8 +75,6 @@ createUser :: !UserAccount -> Task StoredUserAccount
* @param User: The user who needs to be deleted * @param User: The user who needs to be deleted
* *
* @return The deleted user * @return The deleted user
*
* @gin-icon user_delete
*/ */
deleteUser :: !UserId -> Task () deleteUser :: !UserId -> Task ()
/** /**
......
...@@ -105,8 +105,6 @@ manageWorkOfCurrentUser :: !(Maybe HtmlTag) -> Task () ...@@ -105,8 +105,6 @@ manageWorkOfCurrentUser :: !(Maybe HtmlTag) -> Task ()
* *
* @param Workflow: The workflow to add * @param Workflow: The workflow to add
* @return The description of the added workflow * @return The description of the added workflow
*
* @gin False
*/ */
addWorkflows :: ![Workflow] -> Task [Workflow] addWorkflows :: ![Workflow] -> Task [Workflow]
......
...@@ -11,8 +11,6 @@ from System.FilePath import :: FilePath ...@@ -11,8 +11,6 @@ from System.FilePath import :: FilePath
* *
* @return The imported content * @return The imported content
* @throws FileException * @throws FileException
*
* @gin-icon page_white_csv
*/ */
importCSVFile :: !FilePath -> Task [[String]] importCSVFile :: !FilePath -> Task [[String]]
importCSVDocument :: !Document -> Task [[String]] importCSVDocument :: !Document -> Task [[String]]
...@@ -27,8 +25,6 @@ importCSVDocument :: !Document -> Task [[String]] ...@@ -27,8 +25,6 @@ importCSVDocument :: !Document -> Task [[String]]
* *
* @return The imported content * @return The imported content
* @throws FileException * @throws FileException
*
* @gin False
*/ */
importCSVFileWith :: !Char !Char !Char !FilePath -> Task [[String]] importCSVFileWith :: !Char !Char !Char !FilePath -> Task [[String]]
importCSVDocumentWith :: !Char !Char !Char !Document -> Task [[String]] importCSVDocumentWith :: !Char !Char !Char !Document -> Task [[String]]
...@@ -40,8 +36,6 @@ importCSVDocumentWith :: !Char !Char !Char !Document -> Task [[String]] ...@@ -40,8 +36,6 @@ importCSVDocumentWith :: !Char !Char !Char !Document -> Task [[String]]
* @param Cells: The content to export as a list of rows of lists of fields * @param Cells: The content to export as a list of rows of lists of fields
* *
* @return The exported content as a document * @return The exported content as a document
*
* @gin-icon page_white_csv
*/ */
createCSVFile :: !String ![[String]] -> Task Document createCSVFile :: !String ![[String]] -> Task Document
/** /**
...@@ -52,8 +46,6 @@ createCSVFile :: !String ![[String]] -> Task Document ...@@ -52,8 +46,6 @@ createCSVFile :: !String ![[String]] -> Task Document
* *
* @return The exported content * @return The exported content
* @throws FileException * @throws FileException
*
* @gin-icon page_white_csv
*/ */
exportCSVFile :: !FilePath ![[String]] -> Task [[String]] exportCSVFile :: !FilePath ![[String]] -> Task [[String]]
/** /**
...@@ -68,7 +60,5 @@ exportCSVFile :: !FilePath ![[String]] -> Task [[String]] ...@@ -68,7 +60,5 @@ exportCSVFile :: !FilePath ![[String]] -> Task [[String]]
* *
* @return The exported content * @return The exported content
* @throws FileException * @throws FileException
*
* @gin False
*/ */
exportCSVFileWith :: !Char !Char !Char !FilePath ![[String]] -> Task [[String]] exportCSVFileWith :: !Char !Char !Char !FilePath ![[String]] -> Task [[String]]
...@@ -36,8 +36,6 @@ derive class iTask FileException ...@@ -36,8 +36,6 @@ derive class iTask FileException
* *
* @return The imported document * @return The imported document
* @throws FileException * @throws FileException
*
* @gin-icon page_white
*/ */
importDocument :: !FilePath -> Task Document importDocument :: !FilePath -> Task Document
...@@ -49,8 +47,6 @@ importDocument :: !FilePath -> Task Document ...@@ -49,8 +47,6 @@ importDocument :: !FilePath -> Task Document
* *
* @return The exported document * @return The exported document
* @throws FileException * @throws FileException
*
* @gin-icon page_white
*/ */
exportDocument :: !FilePath !Document -> Task Document exportDocument :: !FilePath !Document -> Task Document
...@@ -14,8 +14,6 @@ instance toString JSONParseException ...@@ -14,8 +14,6 @@ instance toString JSONParseException
* *
* @return The imported content * @return The imported content
* @throws FileException * @throws FileException
*
* @gin-icon page_white_json
*/ */
importJSONFile :: !FilePath -> Task a | iTask a importJSONFile :: !FilePath -> Task a | iTask a
importJSONDocument :: !Document -> Task a | iTask a importJSONDocument :: !Document -> Task a | iTask a
...@@ -28,8 +26,6 @@ importJSONDocument :: !Document -> Task a | iTask a ...@@ -28,8 +26,6 @@ importJSONDocument :: !Document -> Task a | iTask a
* *
* @return The imported content * @return The imported content
* @throws FileException * @throws FileException
*
* @gin False
*/ */
importJSONFileWith :: !(JSONNode -> Maybe a) !FilePath -> Task a | iTask a importJSONFileWith :: !(JSONNode -> Maybe a) !FilePath -> Task a | iTask a
/** /**
...@@ -48,8 +44,6 @@ createJSONFile :: !String a -> Task Document | iTask a ...@@ -48,8 +44,6 @@ createJSONFile :: !String a -> Task Document | iTask a
* @param Value: The content to encode as JSON using the generic JSON encoder * @param Value: The content to encode as JSON using the generic JSON encoder
* *
* @return The exported content * @return The exported content
*
* @gin-icon page_white_json
*/ */
exportJSONFile :: !FilePath a -> Task a | iTask a exportJSONFile :: !FilePath a -> Task a | iTask a
/** /**
...@@ -61,7 +55,5 @@ exportJSONFile :: !FilePath a -> Task a | iTask a ...@@ -61,7 +55,5 @@ exportJSONFile :: !FilePath a -> Task a | iTask a
* *
* @return The exported content * @return The exported content
* @throws FileException * @throws FileException
*
* @gin False
*/ */
exportJSONFileWith :: !(a -> JSONNode) !FilePath a -> Task a | iTask a exportJSONFileWith :: !(a -> JSONNode) !FilePath a -> Task a | iTask a
...@@ -35,9 +35,6 @@ instance toString CallException ...@@ -35,9 +35,6 @@ instance toString CallException
* @param Run with pseudo terminal options * @param Run with pseudo terminal options
* @return return-code of the process * @return return-code of the process
* @throws CallException * @throws CallException
*
* @gin-title Start executable
* @gin-icon executable
*/ */
callProcess :: ![ViewOption ProcessInformation] !FilePath ![String] !(Maybe FilePath) (Maybe ProcessPtyOptions) -> Task ProcessInformation callProcess :: ![ViewOption ProcessInformation] !FilePath ![String] !(Maybe FilePath) (Maybe ProcessPtyOptions) -> Task ProcessInformation
......
...@@ -11,8 +11,6 @@ from iTasks.Extensions.Document import :: Document ...@@ -11,8 +11,6 @@ from iTasks.Extensions.Document import :: Document
* *
* @return The imported content * @return The imported content
* @throws FileException * @throws FileException
*
* @gin-icon page_white_text
*/ */
importTextFile :: !FilePath -> Task String importTextFile :: !FilePath -> Task String
...@@ -34,7 +32,5 @@ importTextDocument :: !Document -> Task String ...@@ -34,7 +32,5 @@ importTextDocument :: !Document -> Task String
* *
* @return The exported content * @return The exported content
* @throws FileException * @throws FileException
*
* @gin-icon page_white_text
*/ */
exportTextFile :: !FilePath !String -> Task String exportTextFile :: !FilePath !String -> Task String
...@@ -98,8 +98,6 @@ workAs :: !User !(Task a) -> Task a | iTask a ...@@ -98,8 +98,6 @@ workAs :: !User !(Task a) -> Task a | iTask a
* @param Task: The task that is to be delegated * @param Task: The task that is to be delegated
* *
* @return The combined task * @return The combined task
*
* @gin False
*/ */
assign :: !TaskAttributes !(Task a) -> Task a | iTask a assign :: !TaskAttributes !(Task a) -> Task a | iTask a
...@@ -110,10 +108,6 @@ assign :: !TaskAttributes !(Task a) -> Task a | iTask a ...@@ -110,10 +108,6 @@ assign :: !TaskAttributes !(Task a) -> Task a | iTask a
* @param Task: The task that is to be delegated. * @param Task: The task that is to be delegated.
* *
* @return The combined task * @return The combined task
*
* @gin-title Assign to user
* @gin-icon user
* @gin-shape assign
*/ */
(@:) infix 3 :: !worker !(Task a) -> Task a | iTask a & toUserConstraint worker (@:) infix 3 :: !worker !(Task a) -> Task a | iTask a & toUserConstraint worker
......
definition module iTasks.Extensions.Web definition module iTasks.Extensions.Web
import iTasks import iTasks
from Internet.HTTP import :: HTTPMethod, :: HTTPRequest, :: HTTPResponse from Internet.HTTP import :: HTTPMethod, :: HTTPRequest, :: HTTPResponse
from Text.URI import :: URI from Text.URI import :: URI
from Text.HTML import class html from Text.HTML import class html
/** /**
* This module provides support for building web applications. * This module provides support for building web applications.
*/ */
//* Uniform resource locators //* Uniform resource locators
:: URL = URL !String :: URL = URL !String
...@@ -19,24 +21,32 @@ derive JSONDecode URL ...@@ -19,24 +21,32 @@ derive JSONDecode URL
derive gDefault URL derive gDefault URL
derive gEq URL derive gEq URL
//Simple web server task //* Simple web server task
serveWebService :: Int (HTTPRequest -> Task HTTPResponse) -> Task () serveWebService :: Int (HTTPRequest -> Task HTTPResponse) -> Task ()
//Task for serving a static file //* Task for serving a static file
serveFile :: [FilePath] HTTPRequest -> Task HTTPResponse serveFile :: [FilePath] HTTPRequest -> Task HTTPResponse
/** /**
* Calls an external HTTP webservice. * Calls an external HTTP webservice.
* *
* @param HTTP Method: the HTTP method (GET or POST) to use * @param HTTP Method: the HTTP method (GET or POST) to use
* @param URL: The URL of the webservice * @param URL: The URL of the webservice
* @param Parameters: A list of name/value pairs * @param Data: The body of the request
* @param Response handler: A parse function that parses the response * @param Response handler: A parse function that parses the response
* *
* @return The parsedd value * @return The parsed value
* */
* @gin-title Call web service
* @gin-icon webservice
*/
callHTTP :: !HTTPMethod !URI !String !(HTTPResponse -> (MaybeErrorString a)) -> Task a | iTask a callHTTP :: !HTTPMethod !URI !String !(HTTPResponse -> (MaybeErrorString a)) -> Task a | iTask a
/**
* Calls an external HTTP webservice.
*
* @param HTTP Method: the HTTP method (GET or POST) to use
* @param URL: The URL of the webservice
* @param Parameters: A list of name/value pairs
* @param Response handler: A parse function that parses the response
*
* @return The parsed value
*/
callRPCHTTP :: !HTTPMethod !URI ![(String,String)] !(HTTPResponse -> a) -> Task a | iTask a callRPCHTTP :: !HTTPMethod !URI ![(String,String)] !(HTTPResponse -> a) -> Task a | iTask a
implementation module iTasks.Extensions.Web implementation module iTasks.Extensions.Web
import iTasks import iTasks
import iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers import iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers
import Internet.HTTP, Text, Text.HTML, Text.URI, Text.Encodings.MIME, Text.Encodings.UrlEncoding, StdArray, Data.Either import Internet.HTTP, Text, Text.HTML, Text.URI, Text.Encodings.MIME, Text.Encodings.UrlEncoding, StdArray, Data.Either
...@@ -14,7 +15,6 @@ import qualified Data.Map as DM ...@@ -14,7 +15,6 @@ import qualified Data.Map as DM
import Data.Map.GenJSON import Data.Map.GenJSON
import qualified Data.List as DL import qualified Data.List as DL
//* URL
gText{|URL|} _ val = [maybe "" toString val] gText{|URL|} _ val = [maybe "" toString val]
gEditor{|URL|} = selectByMode gEditor{|URL|} = selectByMode
...@@ -215,5 +215,3 @@ callHTTP _ url _ _ ...@@ -215,5 +215,3 @@ callHTTP _ url _ _
callRPCHTTP :: !HTTPMethod !URI ![(String,String)] !(HTTPResponse -> a) -> Task a | iTask a callRPCHTTP :: !HTTPMethod !URI ![(String,String)] !(HTTPResponse -> a) -> Task a | iTask a
callRPCHTTP method url params transformResult callRPCHTTP method url params transformResult
= callHTTP method url (urlEncodePairs params) (Ok o transformResult) = callHTTP method url (urlEncodePairs params) (Ok o transformResult)
...@@ -55,12 +55,6 @@ derive gDefault TIMeta ...@@ -55,12 +55,6 @@ derive gDefault TIMeta
= TIValue !(TaskValue DeferredJSON) = TIValue !(TaskValue DeferredJSON)
| TIException !Dynamic !String | TIException !Dynamic !String
// UI State
:: TIUIState
= UIDisabled //The UI is disabled (e.g. when nobody is viewing the task)
| UIEnabled !Int !UIChange //The UI is enabled, a version number and the previous task rep are stored for comparision //FIXME
| UIException !String //An unhandled exception occurred and the UI should only show the error message
:: AsyncAction = Read | Write | Modify :: AsyncAction = Read | Write | Modify
:: DeferredJSON :: DeferredJSON
......
...@@ -34,10 +34,10 @@ from Control.Applicative import class Alternative(<|>) ...@@ -34,10 +34,10 @@ from Control.Applicative import class Alternative(<|>)
import Data.GenEq import Data.GenEq
//Derives required for storage of UI definitions //Derives required for storage of UI definitions
derive JSONEncode TaskOutputMessage, TaskResult, TaskEvalInfo, TIValue, ParallelTaskState, ParallelTaskChange, TIUIState derive JSONEncode TaskOutputMessage, TaskResult, TaskEvalInfo, TIValue, ParallelTaskState, ParallelTaskChange
derive JSONEncode Queue, Event derive JSONEncode Queue, Event
derive JSONDecode TaskOutputMessage, TaskResult, TaskEvalInfo, TIValue, ParallelTaskState, ParallelTaskChange, TIUIState derive JSONDecode TaskOutputMessage, TaskResult, TaskEvalInfo, TIValue, ParallelTaskState, ParallelTaskChange
derive JSONDecode Queue, Event derive JSONDecode Queue, Event
derive gDefault InstanceFilter derive gDefault InstanceFilter
......
...@@ -7,7 +7,6 @@ from Internet.HTTP import :: HTTPRequest, :: HTTPResponse ...@@ -7,7 +7,6 @@ from Internet.HTTP import :: HTTPRequest, :: HTTPResponse
from iTasks.Engine import :: WebTask from iTasks.Engine import :: WebTask
from iTasks.Internal.IWorld import :: IWorld from iTasks.Internal.IWorld import :: IWorld
from iTasks.Internal.Task import :: Task, :: ConnectionTask from iTasks.Internal.Task import :: Task, :: ConnectionTask
from iTasks.Internal.TaskState import :: TIUIState
from iTasks.Internal.TaskStore import :: TaskOutput, :: TaskOutputMessage from iTasks.Internal.TaskStore import :: TaskOutput, :: TaskOutputMessage
import iTasks.SDS.Definition import iTasks.SDS.Definition
from iTasks.UI.Definition import :: UIChange from iTasks.UI.Definition import :: UIChange
......
...@@ -97,6 +97,7 @@ derive class iTask UIChange, UIAttributeChange, UIChildChange ...@@ -97,6 +97,7 @@ derive class iTask UIChange, UIAttributeChange, UIChildChange
| UIChoiceList // - A mutually exclusive set of radio buttons | UIChoiceList // - A mutually exclusive set of radio buttons
| UIGrid // - Grid (selecting an item in a table) | UIGrid // - Grid (selecting an item in a table)
| UITree // - Tree (selecting a node in a tree structure) | UITree // - Tree (selecting a node in a tree structure)
| UITabBar // - A tab bar (to make a selection with)
// Data elements (implemented in itasks-core.js) // Data elements (implemented in itasks-core.js)
| UIData | UIData
......
...@@ -231,6 +231,7 @@ where ...@@ -231,6 +231,7 @@ where
toString UIChoiceList = "ChoiceList" toString UIChoiceList = "ChoiceList"
toString UIGrid = "Grid" toString UIGrid = "Grid"
toString UITree = "Tree" toString UITree = "Tree"
toString UITabBar = "TabBar"
toString UIContainer = "Container" toString UIContainer = "Container"
toString UIPanel = "Panel" toString UIPanel = "Panel"
......
...@@ -194,7 +194,7 @@ ...@@ -194,7 +194,7 @@
.itasks-tabset > * { .itasks-tabset > * {
align-self: stretch; align-self: stretch;
} }
.itasks-tabset .itasks-tabbar { .itasks-tabbar {
text-align: left; text-align: left;
list-style: none; list-style: none;
margin: 0; margin: 0;
...@@ -206,7 +206,7 @@ ...@@ -206,7 +206,7 @@
background: linear-gradient(var(--panel-header-base-color-lighter2), var(--panel-header-base-color)); background: linear-gradient(var(--panel-header-base-color-lighter2), var(--panel-header-base-color));
overflow: hidden; overflow: hidden;
} }
.itasks-tabset .itasks-tabbar li { .itasks-tabbar li {
margin: 0; margin: 0;
padding: 0 10px; padding: 0 10px;
border: 1px solid var(--tab-border-color); border: 1px solid var(--tab-border-color);
...@@ -218,12 +218,12 @@ ...@@ -218,12 +218,12 @@
border-top-left-radius: 5px; border-top-left-radius: 5px;
border-top-right-radius: 5px; border-top-right-radius: 5px;
} }
.itasks-tabset .itasks-tabbar li a { .itasks-tabbar li a {
color: var(--tab-text-color); color: var(--tab-text-color);
text-decoration: none; text-decoration: none;
} }
.itasks-tabset .itasks-tabbar li:before, .itasks-tabbar li:before,
.itasks-tabset .itasks-tabbar li:after { .itasks-tabbar li:after {
position: absolute; position: absolute;
bottom: -1px; bottom: -1px;
width: 5px; width: 5px;
...@@ -231,31 +231,31 @@ ...@@ -231,31 +231,31 @@
content: " "; content: " ";
border: 1px solid var(--tab-border-color); border: 1px solid var(--tab-border-color);
} }
.itasks-tabset .itasks-tabbar li:before { .itasks-tabbar li:before {
left: -6px; left: -6px;
bord