Commit 58059bb1 authored by Bas Lijnse's avatar Bas Lijnse

Small layout improvements:

- Created an engine option for enabling/disabling autolayouting. This makes debugging easier.
- Added a layout for creating a toolbar and moving selected actions to it.
parent 20212e15
......@@ -21,6 +21,7 @@ import iTasks.WF.Definition
, keepaliveTime :: Int
, sessionTime :: Int
, persistTasks :: Bool
, autoLayout :: Bool
, webDirPath :: FilePath // Location of public files that are served by the iTask webserver
, storeDirPath :: FilePath // Location of the application's persistent data files
, tempDirPath :: FilePath // Location for temporary files used in tasks
......@@ -91,12 +92,6 @@ runTasksWithOptions :: ([String] EngineOptions -> (!Maybe EngineOptions,![String
*/
publish :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
/**
* This function publishes a task with autolayouting turned off
* to enable testing and debugging without layout processing
*/
publishWithoutLayout :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
class Publishable a
where
publishAll :: !a -> [PublishedTask]
......
......@@ -49,11 +49,12 @@ defaultEngineOptions world
, serverUrl = "http://localhost/"
, keepaliveTime = 300 // 5 minutes
, sessionTime = 600 // 10 minutes
, persistTasks = False
, autoLayout = True
, webDirPath = appDir </> appName +++ "-www"
, storeDirPath = appDir </> appName +++ "-data" </> "stores"
, tempDirPath = appDir </> appName +++ "-data" </> "tmp"
, saplDirPath = appDir </> appName +++ "-sapl"
, persistTasks = False
}
= (options,world)
......@@ -168,12 +169,13 @@ show lines world
# console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
# (_,world) = fclose console world
= world
/*
timeout :: !*IWorld -> (!Maybe Timeout,!*IWorld)
timeout iworld = case 'SDS'.read taskEvents iworld of //Check if there are events in the queue
(Ok (Queue [] []),iworld) = (Just 10,iworld) //Empty queue, don't waste CPU, but refresh
(Ok _,iworld) = (Just 0,iworld) //There are still events, don't wait
(Error _,iworld) = (Just 500,iworld) //Keep retrying, but not too fast
*/
// The iTasks engine consist of a set of HTTP WebService
engineWebService :: publish -> [WebService (Map InstanceNo (Queue UIChange)) (Map InstanceNo (Queue UIChange))] | Publishable publish
......@@ -182,13 +184,7 @@ where
published = publishAll publishable
publish :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
publish url task = {url = url, task = WebTaskWrapper (withFinalSessionLayout task)}
withFinalSessionLayout :: (HTTPRequest -> Task a) -> (HTTPRequest -> Task a) | iTask a
withFinalSessionLayout taskf = \req -> tune (ApplyLayout defaultSessionLayout) (taskf req)
publishWithoutLayout :: String (HTTPRequest -> Task a) -> PublishedTask | iTask a
publishWithoutLayout url task = {url = url, task = WebTaskWrapper task}
publish url task = {url = url, task = WebTaskWrapper task}
instance Publishable (Task a) | iTask a
where
......
......@@ -304,7 +304,7 @@ where
= viewInformation (Title "Error") [] "Sorry, this task is no longer available in the workflow catalog"
>>| return ()
Just replacement
= replaceTask taskId (const ((unwrapWorkflowTask replacement.Workflow.task) <<@ ApplyLayout defaultSessionLayout)) topLevelTasks
= replaceTask taskId (const (unwrapWorkflowTask replacement.Workflow.task)) topLevelTasks
>>| workOnTask taskId
//Look in the catalog for an entry that has the same path as
......
......@@ -221,7 +221,7 @@ workAs asUser task
*/
assign :: !TaskAttributes !(Task a) -> Task a | iTask a
assign attr task
= parallel [(Embedded, \s -> processControl s),(Detached attr False, const (task <<@ ApplyLayout defaultSessionLayout))] []
= parallel [(Embedded, \s -> processControl s),(Detached attr False, const task)] []
@? result
where
processControl tlist
......
......@@ -130,6 +130,7 @@ createClientIWorld serverURL currentInstance
, keepaliveTime = locundef "keepaliveTime"
, sessionTime = locundef "sessionTime"
, persistTasks = False
, autoLayout = True
, webDirPath = locundef "webDirectory"
, storeDirPath = locundef "dataDirectory"
, tempDirPath = locundef "tempDirectory"
......
......@@ -11,6 +11,8 @@ import iTasks.Internal.Serialization
import iTasks.Internal.Generic.Defaults
import iTasks.Internal.Generic.Visualization
import iTasks.UI.Layout.Default
import qualified iTasks.Internal.SDS as SDS
from iTasks.SDS.Definition import :: SDSLensRead(..), :: SDSLensWrite(..), :: SDSLensNotify(..), :: SDS(SDSDynamic)
import iTasks.SDS.Combinators.Core, iTasks.SDS.Combinators.Common
......@@ -18,6 +20,7 @@ import iTasks.SDS.Sources.Store
import iTasks.Internal.SDSService
import iTasks.Internal.Client.Override
import iTasks.WF.Combinators.Core
import iTasks.WF.Combinators.Tune
import iTasks.Extensions.Document
import qualified Data.Map as DM
......@@ -132,7 +135,8 @@ createClientTaskInstance task sessionId instanceNo iworld=:{options={appVersion}
`b` \iworld -> (Ok (TaskId instanceNo 0), iworld)
createTaskInstance :: !(Task a) !*IWorld -> (!MaybeError TaskException (!InstanceNo,InstanceKey),!*IWorld) | iTask a
createTaskInstance task iworld=:{options={appVersion},current={taskTime},clocks={timestamp,localDate,localTime}}
createTaskInstance task iworld=:{options={appVersion,autoLayout},current={taskTime},clocks={timestamp,localDate,localTime}}
# task = if autoLayout (tune (ApplyLayout defaultSessionLayout) task) task
# (mbInstanceNo,iworld) = newInstanceNo iworld
# instanceNo = fromOk mbInstanceNo
# (instanceKey,iworld) = newInstanceKey iworld
......@@ -148,7 +152,8 @@ createTaskInstance task iworld=:{options={appVersion},current={taskTime},clocks=
(`b`) (Error e, st) _ = (Error e, st)
createDetachedTaskInstance :: !(Task a) !Bool !TaskEvalOpts !InstanceNo !TaskAttributes !TaskId !Bool !*IWorld -> (!MaybeError TaskException TaskId, !*IWorld) | iTask a
createDetachedTaskInstance task isTopLevel evalOpts instanceNo attributes listId refreshImmediate iworld=:{options={appVersion},current={taskTime},clocks={timestamp,localDate,localTime}}
createDetachedTaskInstance task isTopLevel evalOpts instanceNo attributes listId refreshImmediate iworld=:{options={appVersion,autoLayout},current={taskTime},clocks={timestamp,localDate,localTime}}
# task = if autoLayout (tune (ApplyLayout defaultSessionLayout) task) task
# (instanceKey,iworld) = newInstanceKey iworld
# progress = {InstanceProgress|value=None,instanceKey=instanceKey,attachedTo=[],firstEvent=Nothing,lastEvent=Nothing}
# constants = {InstanceConstants|session=False,listId=listId,build=appVersion,issuedAt=timestamp}
......
......@@ -13,7 +13,7 @@ toStubIWorld :: *World -> *IWorld
toStubIWorld world
= {IWorld
|options = {EngineOptions|appName="STUB",appPath="./",appVersion="STUB",serverPort=80,serverUrl="/127.0.0.1:80/",keepaliveTime=0,sessionTime=0
,persistTasks=False,webDirPath="./STUB/",storeDirPath="./STUB/",tempDirPath="./STUB/",saplDirPath="./STUB"}
,persistTasks=False,autoLayout=False,webDirPath="./STUB/",storeDirPath="./STUB/",tempDirPath="./STUB/",saplDirPath="./STUB"}
,clocks = {SystemClocks |timestamp = Timestamp 0,localDate=defaultValue,localTime=defaultValue,utcDate=defaultValue,utcTime=defaultValue}
,current ={TaskEvalState|taskTime= 0,taskInstance= 0,sessionInstance = Nothing,attachmentChain = [] ,nextTaskNo = 0}
,sdsNotifyRequests = [], memoryShares = 'DM'.newMap, readCache = 'DM'.newMap, writeCache = 'DM'.newMap, exposedShares = 'DM'.newMap
......
......@@ -30,7 +30,7 @@ inUISelection (SelectDescendents) [_:_] _ = True
inUISelection (SelectDescendents) _ _ = False
inUISelection (SelectByType t) _ (UI type _ _) = t === type
inUISelection (SelectByHasAttribute k) _ (UI _ attr _) = isJust ('DM'.get k attr)
inUISelection (SelectByAttribute k v) _ (UI _ attr _) = False// maybe False ((==) v) ('DM'.get k attr) //FIXME
inUISelection (SelectByAttribute k v) _ (UI _ attr _) = maybe False ((==) v) ('DM'.get k attr)
inUISelection (SelectByNumChildren num) _ (UI _ _ items) = length items == num
inUISelection (SelectByContains selection) path ui=:(UI _ _ items)
| inUISelection selection path ui = True
......
......@@ -54,6 +54,12 @@ frameCompact :: Layout
*/
beforeStep :: Layout -> Layout
/**
* Add a tool bar and move selected actions to it
*/
insertToolBar :: [String] -> Layout
//Convenient annotatation types
:: ArrangeWithTabs = ArrangeWithTabs
instance tune ArrangeWithTabs
......
......@@ -69,6 +69,13 @@ where
])
insertToolBar :: [String] -> Layout
insertToolBar actions = foldl1 sequenceLayouts
[insertChildUI 0 (ui UIToolBar)
,moveSubUIs (foldl1 SelectOR [SelectByAttribute "actionId" (JSONString action)\\ action <- actions]) [0] 0
,layoutSubUIs (SelectByPath [0]) (layoutSubUIs (SelectByType UIAction) actionToButton)
]
toEmpty :: Layout
toEmpty = setUIType UIEmpty
......
......@@ -32,18 +32,18 @@ where
layoutTestTasks :: [PublishedTask]
layoutTestTasks =
[publishWithoutLayout "/layout-tests/set-type" (const testSetTypeTask)
,publishWithoutLayout "/layout-tests/set-attributes" (const testSetAttributesTask)
,publishWithoutLayout "/layout-tests/del-attributes" (const testDelAttributesTask)
,publishWithoutLayout "/layout-tests/modify-attributes" (const testModifyAttributesTask)
,publishWithoutLayout "/layout-tests/copy-attributes" (const testCopySubAttributesTask)
,publishWithoutLayout "/layout-tests/wrap" (const testWrapTask)
,publishWithoutLayout "/layout-tests/unwrap" (const testUnwrapTask)
,publishWithoutLayout "/layout-tests/insert-sub" (const testInsertSubTask)
,publishWithoutLayout "/layout-tests/remove-subs" (const testRemoveSubsTask)
,publishWithoutLayout "/layout-tests/move-subs" (const testMoveSubsTask)
,publishWithoutLayout "/layout-tests/layout-subs" (const testLayoutSubsTask)
,publishWithoutLayout "/layout-tests/sequence-layouts" (const testSequenceLayoutsTask)
[publish "/layout-tests/set-type" (const testSetTypeTask)
,publish "/layout-tests/set-attributes" (const testSetAttributesTask)
,publish "/layout-tests/del-attributes" (const testDelAttributesTask)
,publish "/layout-tests/modify-attributes" (const testModifyAttributesTask)
,publish "/layout-tests/copy-attributes" (const testCopySubAttributesTask)
,publish "/layout-tests/wrap" (const testWrapTask)
,publish "/layout-tests/unwrap" (const testUnwrapTask)
,publish "/layout-tests/insert-sub" (const testInsertSubTask)
,publish "/layout-tests/remove-subs" (const testRemoveSubsTask)
,publish "/layout-tests/move-subs" (const testMoveSubsTask)
,publish "/layout-tests/layout-subs" (const testLayoutSubsTask)
,publish "/layout-tests/sequence-layouts" (const testSequenceLayoutsTask)
]
taskToLayout title = updateInformation () [] title @! () >>= return
......
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