Commit e268a192 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into 162-including-svg-throws-nomatch-in-sapl-in-some-cases

parents cf952701 1a816fff
Version: 1.0
Environment
EnvironmentName: iTasks
EnvironmentPaths
Path: {Application}/lib/StdEnv
Path: {Application}/lib/Generics
Path: {Application}/lib/Dynamics
Path: {Application}/lib/TCPIP
Path: {Application}/lib/Platform
Path: {Application}/lib/Platform/Deprecated/StdLib
Path: {Application}/lib/Sapl
Path: {Application}/lib/GraphCopy
Path: {Application}/lib/iTasks
EnvironmentCompiler: lib/exe/cocl:-dynamics -sapl
EnvironmentCodeGen: lib/exe/cg
EnvironmentLinker: /usr/bin/gcc|lib/exe/sapl-collector-linker|lib/exe/itasks-web-collector
EnvironmentDynLink: /usr/bin/gcc
EnvironmentVersion: 920
EnvironmentRedirect: False
EnvironmentCompileMethod: Pers
EnvironmentProcessor: I386
Environment64BitProcessor: True
Version: 1.0
Environment
EnvironmentName: iTasks
EnvironmentPaths
Path: {Application}/lib/StdEnv
Path: {Application}/lib/Generics
Path: {Application}/lib/Dynamics
Path: {Application}/lib/TCPIP
Path: {Application}/lib/Platform
Path: {Application}/lib/Platform/Deprecated/StdLib
Path: {Application}/lib/Sapl
Path: {Application}/lib/GraphCopy
Path: {Application}/lib/iTasks
EnvironmentCompiler: lib/exe/cocl:-dynamics -sapl
EnvironmentCodeGen: lib/exe/cg
EnvironmentLinker: /usr/bin/gcc|lib/exe/sapl-collector-linker|lib/exe/itasks-web-collector
EnvironmentDynLink: /usr/bin/gcc
EnvironmentVersion: 920
EnvironmentRedirect: False
EnvironmentCompileMethod: Pers
EnvironmentProcessor: I386
Environment64BitProcessor: True
......@@ -10,7 +10,7 @@ import Incidone.OP.Concepts, Incidone.OP.SDSs, Incidone.OP.Conversions
import Incidone.OP.IncidentManagementTasks, Incidone.OP.ContactManagementTasks, Incidone.OP.CommunicationManagementTasks
import qualified Data.Map as DM
import Data.Tuple, Data.Functor, Data.List, Text, Text.HTML
import Data.Tuple, Data.Functor, Data.List, Data.Either, Text, Text.HTML
//Extensions
import Incidone.Extensions.CrewLists
......@@ -43,7 +43,7 @@ where
filterFun contactNo (_,_,{ActionStatus|contacts}) = isMember contactNo contacts
actionStatusesOfCurrentContact :: ROShared () [(InstanceNo,InstanceNo,ActionStatus)]
actionStatusesOfCurrentContact = sdsSequence "actionStatusesOfCurrentContact" (\_ r -> r) snd writel writer currentUserContactNo actionStatusesByContact
actionStatusesOfCurrentContact = sdsSequence "actionStatusesOfCurrentContact" id (\_ r -> r) (\_ _ -> Right snd) writel writer currentUserContactNo actionStatusesByContact
where
writel = SDSWriteConst (\_ _ -> Ok Nothing)
writer = SDSWriteConst (\_ _ -> Ok Nothing)
......@@ -100,7 +100,7 @@ fromSelfActionStatus status (_,items) = case [i \\ i=:{TaskListItem|taskId,self}
[{TaskListItem|taskId,attributes}:_] = Ok (Just [(taskId,fromActionStatus status attributes)])
_ = Error (exception "Task id not found in self management share")
selfActionStatus :: (SharedTaskList a) -> Shared ActionStatus
selfActionStatus :: (SharedTaskList a) -> Shared ActionStatus | iTask a
selfActionStatus list = sdsFocus taskListFilter (mapReadWriteError (toSelfActionStatus,fromSelfActionStatus) list)
where
taskListFilter = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False
......
implementation module Incidone.ContactPosition
import iTasks, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.UI.Editor.Combinators, iTasks.UI.Definition
import iTasks, iTasks.UI.Editor, iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers, iTasks.UI.Definition
import qualified Data.Map as DM
import Data.Functor, Data.List, Text
import qualified Text.Parsers.ZParsers.ParsersKernel as PK
......@@ -15,7 +15,7 @@ import Incidone.Util.TaskPatterns
derive JSONEncode ContactPosition
derive JSONDecode ContactPosition
gEditor{|ContactPosition|} = liftEditor printPosition parsePosition (textField 'DM'.newMap)
gEditor{|ContactPosition|} = bijectEditorValue printPosition parsePosition textField
gText{|ContactPosition|} _ val = [maybe "" printPosition val]
derive gDefault ContactPosition
......
......@@ -90,7 +90,7 @@ composeEmailMessage communicationNo
>>| updateMessageMeta communicationNo
||- ((composeAndSendMessage communicationNo message transmitEmailMessage
-&&-
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs)
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
<<@ Title "Compose E-mail"
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600) ) */ //FIXME
......@@ -105,7 +105,7 @@ composeP2000Message communicationNo
>>| updateMessageMeta communicationNo
||- ((composeAndSendMessage communicationNo message transmitP2000Message
-&&-
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs)
relateMessageToIncidents communicationNo) <<@ ArrangeWithTabs True)
<<@ ArrangeWithSideBar 0 TopSide 60 False
<<@ Title "Compose P2000 message"
/* <<@ AfterLayout (uiDefSetSize (ExactSize 800) (ExactSize 600)) */ //FIXME
......@@ -290,7 +290,7 @@ manageLinkedIncidentInfo incidentNo
manageVoiceCallContent :: CommunicationType CommunicationNo -> Task ()
manageVoiceCallContent type communicationNo
= updateCallNotes -|| relateMessageToIncidents communicationNo <<@ ArrangeWithTabs
= updateCallNotes -|| relateMessageToIncidents communicationNo <<@ ArrangeWithTabs True
where
updateCallNotes
= updateSharedInformation (Title "Notes") [] (callNotes type) //<<@ FillNotes //FIXME
......
......@@ -44,4 +44,4 @@ deleteCommunicationMean :: CommunicationMeanId -> Task ()
//Check credentials for contacts that can log in
verifyContactCredentials :: Credentials -> Task (Maybe User)
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI)
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w
......@@ -7,9 +7,10 @@ import Incidone.Util.TaskPatterns
import Incidone.DeviceBased.VideoWall
import Incidone.Extensions.CrewLists //For demo
import qualified Data.Map as DM
import Text, Text.HTML, Data.Either
import iTasks.UI.Editor.Builtin
import Text, Text.HTML, Data.Either, Data.Functor
import iTasks.UI.Editor.Controls
CONVERT_BIN :== "/opt/local/bin/convert"
//CONVERT_BIN :== "/usr/bin/convert"
......@@ -23,7 +24,7 @@ selectContact = withShared Nothing
(selectContactFromLists sel <<@ Title "Browse")
-||-
(viewContactsOnMap mapContacts sel <<@ Title "Map")
<<@ ArrangeWithTabs
<<@ ArrangeWithTabs True
)
where
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |+| contactsProvidingHelpGeo)
......@@ -92,7 +93,7 @@ manageContactInformation ws contactNo
,manageContactIncidents ws contactNo
,manageContactActions False contactNo
,manageContactCrew` contactNo <<@ Title "Crew"
] <<@ ArrangeWithTabs) @! ()
] <<@ ArrangeWithTabs True) @! ()
where
viewTitle contactNo = viewSharedTitle (mapRead contactTitle (sdsFocus contactNo contactByNo))
......@@ -551,7 +552,7 @@ verifyContactCredentials credentials
= get (sdsFocus credentials contactByCredentials)
@ fmap contactUser
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI)
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w
viewContactsOnMap sharedContacts sel
= get (standardMapLayers |+| standardPerspective)
>>- \(baseLayers,perspective) ->
......@@ -567,10 +568,10 @@ where
mapState :: (Shared (Bool,ContactMapPerspective))
(ReadWriteShared [ContactGeo] w)
(Shared (Maybe (Either ContactNo MMSI))) ->
ReadWriteShared ([(Bool,ContactGeo)], Maybe (Either ContactNo MMSI), ContactMapPerspective) (Maybe (Either ContactNo MMSI), ContactMapPerspective)
mapState local contacts sel = sdsSequence "mapState" (\_ r -> r) read writel writer (local >+< sel) mapContacts
ReadWriteShared ([(Bool,ContactGeo)], Maybe (Either ContactNo MMSI), ContactMapPerspective) (Maybe (Either ContactNo MMSI), ContactMapPerspective) | iTask w
mapState local contacts sel = sdsSequence "mapState" id (\_ r -> r) (\_ _ -> Right read) writel writer (local >+< sel) mapContacts
where
mapContacts = sdsSelect "mapContacts" choose (\_ _ _ _ -> False) (\_ _ _ _ -> False) withoutAISContacts withAISContacts
mapContacts = sdsSelect "mapContacts" choose (SDSNotifyConst (\_ _ _ -> False)) (SDSNotifyConst (\_ _ _ -> False)) withoutAISContacts withAISContacts
where
choose ((withAIS,{ContactMapPerspective|bounds=Just bounds}),_) = (if withAIS (Right bounds) (Left bounds))
choose _ = (Left defaultValue)
......
......@@ -28,7 +28,7 @@ manageIncidentInformation ws incidentNo
,(Embedded, \_ -> manageIncidentActions incidentNo)
,(Embedded, \_ -> manageIncidentWeather incidentNo)
,(Embedded, \_ -> manageIncidentLog incidentNo)
] [] <<@ ArrangeWithTabs)
] [] <<@ ArrangeWithTabs False)
@! ()
//Basic incident information (title, summary, type, phase etc..)
......
......@@ -5,14 +5,14 @@ import qualified Data.Map as DM
import Incidone.Configuration
import Incidone.OP.Concepts, Incidone.OP.Conversions
import Incidone.Util.SQLSDS
import Data.Functor
import Data.Functor, Data.Either
derive class iTask ContactFilter
dbReadSDS :: String -> ROShared QueryDef [r] | mbFromSQL r
dbReadSDS :: String -> ROShared QueryDef [r] | mbFromSQL r & TC r
dbReadSDS notifyId = databaseDef >++> sqlReadSDS notifyId
dbReadWriteOneSDS :: String -> RWShared QueryDef r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
dbReadWriteOneSDS :: String -> RWShared QueryDef r r | mbFromSQL, mbToSQL r & gDefault{|*|} r & TC r
dbReadWriteOneSDS notifyId = databaseDef >++> sqlReadWriteOneSDS notifyId
dbLinkSDS :: String String String String -> RWShared (Maybe [Int]) [(Int,Int)] [(Int,Int)]
......@@ -481,7 +481,7 @@ where
query group = Just (EqualsValue ("Contact","group") (toSQL group))
contactsOfOpenIncidentsShort :: ROShared () [ContactShortWithIncidents]
contactsOfOpenIncidentsShort = sdsSequence "contactsOfOpenIncidentsShort" param read writel writer contactsOfOpenIncidentsShortBase openIncidentsByContactsShortIndexed
contactsOfOpenIncidentsShort = sdsSequence "contactsOfOpenIncidentsShort" id param (\_ _ -> Right read) writel writer contactsOfOpenIncidentsShortBase openIncidentsByContactsShortIndexed
where
writel = SDSWriteConst (\_ _ -> Ok Nothing)
writer = SDSWriteConst (\_ _ -> Ok Nothing)
......@@ -828,7 +828,8 @@ where
_ = Nothing
contactAIS :: ROShared ContactNo (Maybe AISContact)
contactAIS = sdsSequence "contactAIS" (\_ mbMMSI -> mbMMSI) snd (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w))) contactMMSI (roMaybe (toReadOnly AISContactByMMSI))
contactAIS = sdsSequence "contactAIS" id (\_ mbMMSI -> mbMMSI) (\_ _ -> Right snd) (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w)))
contactMMSI (roMaybe (toReadOnly AISContactByMMSI))
contactCommunications :: ROShared ContactNo [CommunicationDetails]
contactCommunications = sdsTranslate "contactCommunications" cond filteredCommunications
......@@ -957,7 +958,7 @@ where
= (Ok (),cur)
currentUserAvatar :: ROShared () (Maybe ContactAvatar)
currentUserAvatar = sdsSequence "userContactNo" (\_ u -> userContactNo u) snd writel writer currentUser (roMaybe (mapRead Just (toReadOnly contactAvatar)))
currentUserAvatar = sdsSequence "userContactNo" id (\_ u -> userContactNo u) (\_ _ -> Right snd) writel writer currentUser (roMaybe (mapRead Just (toReadOnly contactAvatar)))
where
writel = SDSWriteConst (\_ _ -> Ok Nothing)
writer = SDSWriteConst (\_ _ -> Ok Nothing)
......
......@@ -61,7 +61,7 @@ where
-||-
(enterChoiceWithSharedAs (Title "Recent incidents")
[ChooseFromGrid id] recentIncidentsDetails (\{IncidentDetails|incidentNo} -> incidentNo) /* <<@ AfterLayout (tweakUI fill) */) //FIXME
) <<@ ArrangeWithTabs
) <<@ ArrangeWithTabs True
browseContacts :: Workspace -> Task ()
browseContacts ws
......
......@@ -13,10 +13,12 @@ currentNotifications :: ReadOnlyShared [String]
currentNotifications = mapRead prj (currentDateTime |*| notifications)
where
prj (now,notifications) = [toString dt +++ msg \\ (dt,msg) <- notifications | limit now dt ]
limit t1 t2
# (Timestamp s1) = datetimeToTimestamp t1
limit t1 t2 = False //FIXME: We need an non-pure function to convert the datetime values, we can't do that with a mapRead...
/*
# (Timestamp s1) = datetimeToTimestamp t1
# (Timestamp s2) = datetimeToTimestamp t2
= s1 - s2 < 3
*/
addNotification :: String -> Task ()
addNotification msg
......
......@@ -56,7 +56,7 @@ toOrderBySQL :: [RowOrderDef] -> String
fromSQLWithId :: [SQLValue] -> (Int,a) | mbFromSQL a
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p & TC r & TC w
sqlReadSDS :: String -> ROShared (SQLDatabaseDef,QueryDef) [r] | mbFromSQL r
sqlReadWriteOneSDS :: String -> RWShared (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
......@@ -64,4 +64,4 @@ sqlLinkSDS :: String String String String-> RWShared (SQLDatabaseDef,Ma
groupByFst :: [(a,b)] -> Map a [b] | Eq a & Ord a
ungroupByFst :: (Map a [b]) -> [(a,b)]
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p & TC r
......@@ -147,8 +147,8 @@ fromSQLWithId :: [SQLValue] -> (Int,a) | mbFromSQL a
fromSQLWithId row = (fromSQL [last row],fromSQL (init row))
//UTIL SDS Combinators
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p
(>++>) db sds = sdsSequence ">++>" (\p db -> (db,p)) snd (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w))) (sdsFocus () db) sds
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p & TC r & TC w
(>++>) db sds = sdsSequence ">++>" id (\p db -> (db,p)) (\_ _ -> Right snd) (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w))) (sdsFocus () db) sds
sqlReadSDS :: String -> ROShared (SQLDatabaseDef,QueryDef) [r] | mbFromSQL r
sqlReadSDS notifyId = sqlShare notifyId readFun writeFun
......@@ -231,8 +231,8 @@ where
ungroupByFst :: (Map a [b]) -> [(a,b)]
ungroupByFst index = flatten [[(a,b) \\ b <- bs] \\ (a,bs) <- 'DM'.toList index]
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p
roMaybe sds = sdsSelect "roMaybe" choose (\_ _ _ _ -> False) (\_ _ _ _ -> False) (constShare Nothing) sds
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p & TC r
roMaybe sds = sdsSelect "roMaybe" choose (SDSNotifyConst (\_ _ _ -> False)) (SDSNotifyConst (\_ _ _ -> False)) (constShare Nothing) sds
where
choose Nothing = Left ()
choose (Just p) = Right p
......
......@@ -14,10 +14,10 @@ createNewIncident :: Task (Maybe IncidentNo)
createNewContact :: Task (Maybe ContactNo)
indexedStore :: String v -> RWShared k v v | Eq k & Ord k & iTask k & iTask v
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a])
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a]) | iTask p & TC a & TC b & TC c & TC x
// Information management
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v & iTask c
optionalNewOrOpen :: (String,Task ()) (String,i -> Task ()) Workspace (ReadOnlyShared (Maybe i)) -> Task () | iTask i
......
......@@ -3,7 +3,7 @@ implementation module Incidone.Util.TaskPatterns
import iTasks, iTasks.Extensions.Dashboard
import iTasks.UI.Definition
import Incidone.OP.IncidentManagementTasks, Incidone.OP.ContactManagementTasks
import Text, Data.Functor, Data.Either
import Text, Data.Functor, Data.Either, Data.Maybe
import qualified Data.Map as DM
import StdMisc
......@@ -35,25 +35,32 @@ where
read p mapping = fromMaybe def ('DM'.get p mapping)
write p mapping v = ('DM'.put p v mapping,(==) p)
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a])
sdsDeref sds1 toRef sds2 merge = sdsSequence "sdsDeref" (\_ r -> map toRef r) read writel writer sds1 sds2
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a]) | iTask p & TC a & TC b & TC c & TC x
sdsDeref sds1 toRef sds2 merge = sdsSequence "sdsDeref" paraml paramr (\_ _ -> Right read) writel writer sds1 sds2
where
paraml p = p
paramr p r1 = map toRef r1
param _ r = (\_ r -> map toRef r)
read (as,bs) = merge as bs
writel = SDSWriteConst (\_ w -> Ok (Just w))
writer = SDSWriteConst (\_ _ -> Ok Nothing)
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v
viewDetails desc sel target prj = viewSharedInformation desc [] (mapRead (fmap prj) targetShare)
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v & iTask c
viewDetails desc sel target prj = viewSharedInformation desc [] (mapRead (fmap prj) (targetShare sel target))
where
targetShare = sdsSequence "viewDetailsSeq" (\_ i -> i) snd writel writer sel valueShare
targetShare :: (RWShared () (Maybe i) ()) (RWShared i c c) -> RWShared () (Maybe c) () | iTask i & iTask c
targetShare sel target = sdsSequence "viewDetailsSeq" id (\_ i -> i) (\_ _ -> Right snd) writel writer sel (valueShare target)
where
writel = SDSWriteConst (\_ _ -> Ok Nothing)
writer = SDSWriteConst (\_ _ -> Ok Nothing)
valueShare = sdsSelect "viewDetailsValue" param (\_ _ _ _ -> False) (\_ _ _ _ -> False) (constShare Nothing) (mapRead Just (toReadOnly target))
param Nothing = Left ()
param (Just i) = Right i
valueShare :: (RWShared i c c) -> RWShared (Maybe i) (Maybe c) () | iTask i & iTask c
valueShare target = sdsSelect "viewDetailsValue" param (SDSNotifyConst (\_ _ _ -> False)) (SDSNotifyConst (\_ _ _ -> False))
(constShare Nothing) (mapRead Just (toReadOnly target))
where
param Nothing = Left ()
param (Just i) = Right i
optionalNewOrOpen :: (String,Task ()) (String,i -> Task ()) Workspace (ReadOnlyShared (Maybe i)) -> Task () | iTask i
optionalNewOrOpen (newLabel,newTask) (openLabel,openTask) ws selection
......
......@@ -88,7 +88,7 @@ where
>>* [OnAction (Action "Log out") (always (return ()))]
) <<@ ApplyLayout layoutControlDash
workOnTasks = doIndependent tasks <<@ ArrangeWithTabs
workOnTasks = doIndependent tasks <<@ ArrangeWithTabs True
layoutControlDash = foldl1 sequenceLayouts
[moveSubUIs (SelectByPath [0,0]) [] 1
......
......@@ -137,7 +137,7 @@ startEngineWithOptions initFun publishable world
where
tcpTasks serverPort keepaliveTime = [(serverPort,httpServer serverPort keepaliveTime (engineWebService publishable) allUIChanges)]
engineTasks =
[BackgroundTask updateClocks
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask removeOutdatedSessions
,BackgroundTask flushWritesWhenIdle]
......@@ -159,7 +159,7 @@ runTasksWithOptions initFun runnable world
= destroyIWorld iworld
where
systemTasks =
[BackgroundTask updateClocks
[BackgroundTask updateClock
,BackgroundTask (processEvents MAX_EVENTS)
,BackgroundTask stopOnStable]
......@@ -228,7 +228,7 @@ determineAppPath world
= (currentDirectory </> (fst o hd o sortBy cmpFileTime) (zip2 batchfiles infos), world)
where
cmpFileTime (_,Ok {FileInfo | lastModifiedTime = x})
(_,Ok {FileInfo | lastModifiedTime = y}) = mkTime x > mkTime y
(_,Ok {FileInfo | lastModifiedTime = y}) = timeGm x > timeGm y
//By default, we use the modification time of the applaction executable as version id
determineAppVersion :: !FilePath!*World -> (!String,!*World)
......
......@@ -35,7 +35,7 @@ tonic = tonicDashboard []
tonicDashboard :: [TaskAppRenderer] -> Task ()
tonicDashboard rs = ((tonicStaticBrowser rs <<@ Title "Static Blueprints")
-||- (tonicDynamicBrowser rs <<@ Title "Dynamic Blueprints")) <<@ ArrangeWithTabs
-||- (tonicDynamicBrowser rs <<@ Title "Dynamic Blueprints")) <<@ ArrangeWithTabs False
tonicStaticWorkflow :: [TaskAppRenderer] -> Workflow
tonicStaticWorkflow rs = workflow "Tonic Static Browser" "Tonic Static Browser" (tonicStaticBrowser rs)
......@@ -390,7 +390,7 @@ getModuleAndTask allbps mn tn
>>~ \mod -> case 'DM'.get mn allbps `b` 'DM'.get tn of
Just tt -> return (mod, tt)
_ -> throw "Can't get module and task"
import StdDebug
viewInstance :: ![TaskAppRenderer] !(Shared NavStack) !DynamicDisplaySettings !BlueprintInstance
!(Maybe (Either ClickMeta (ModuleName, FuncName, ComputationId, Int))) !ClickMeta
-> Task ()
......
......@@ -204,7 +204,7 @@ where
//Split the screen space
[arrangeWithSideBar 0 TopSide 200 True
//Layout all dynamically added tasks as tabs
,layoutSubUIs (SelectByPath [1]) arrangeWithTabs
,layoutSubUIs (SelectByPath [1]) (arrangeWithTabs False)
]
addNewTask :: !(SharedTaskList ()) -> Task ()
......
......@@ -56,10 +56,58 @@ derive gText Date, Time, DateTime
derive gEditor Date, Time, DateTime
//Util
timestampToGmDateTime :: !Timestamp -> DateTime
dateToTimestamp :: !Date -> Timestamp
datetimeToTimestamp :: !DateTime -> Timestamp
/*** Time & Date Conversion ***/
/**
* Converts a timestamp to UTC DateTime.
*
* @param Timestamp: The timestamp to convert.
*
* @return The resulting UTC DateTime
*/
timestampToGmDateTime :: !Timestamp -> DateTime
/**
* Converts a timestamp to local DateTime.
* This is a task, as the local time zone has to be detected.
*
* @param Timestamp: The timestamp to convert.
*
* @return The resulting local DateTime
*/
timestampToLocalDateTime :: !Timestamp -> Task DateTime
/**
* Converts a local Date to a timestamp.
* This is a task, as the local time zone has to be detected.
*
* @param Date: The date to convert
*
* @return The resulting timestamp
*/
localDateToTimestamp :: !Date -> Task Timestamp
/**
* Converts a local DateTime to a timestamp.
* This is a task, as the local time zone has to be detected.
*
* @param Date: The date & time to convert
*
* @return The resulting timestamp
*/
localDateTimeToTimestamp :: !DateTime -> Task Timestamp
/**
* Converts a UTC Date to a timestamp.
*
* @param Date: The date to convert
*
* @return The resulting timestamp
*/
utcDateToTimestamp :: !Date -> Timestamp
/**
* Converts a UTC DateTime to a timestamp.
*
* @param Date: The date & time to convert
*
* @return The resulting timestamp
*/
utcDateTimeToTimestamp :: !DateTime -> Timestamp
/*** Special wait tasks ***/
......
......@@ -7,7 +7,8 @@ import iTasks.WF.Combinators.Core
import iTasks.WF.Combinators.Common
import iTasks.WF.Combinators.Overloaded
import iTasks.SDS.Sources.System
from iTasks.Internal.Task import mkInstantTask
import iTasks.Internal.IWorld
import iTasks.UI.Definition
import iTasks.UI.Prompt
import iTasks.UI.Editor
......@@ -21,6 +22,7 @@ import Data.Maybe, Data.Error
import qualified Data.Map as DM
from iTasks.Extensions.Form.Pikaday import pikadayDateField
from iTasks.Internal.Util import tmToDateTime
//* (Local) date and time
toTime :: DateTime -> Time
......@@ -184,19 +186,34 @@ derive gEq DateTime
timestampToGmDateTime :: !Timestamp -> DateTime
timestampToGmDateTime timestamp = tmToDateTime (toGmTime timestamp)
tmToDateTime :: !Tm -> DateTime
tmToDateTime tm
= {DateTime| day = tm.Tm.mday, mon = 1 + tm.Tm.mon, year = 1900 + tm.Tm.year
,hour = tm.Tm.hour, min = tm.Tm.min, sec= tm.Tm.sec}
timestampToLocalDateTime :: !Timestamp -> Task DateTime
timestampToLocalDateTime ts = mkInstantTask timestampToLocalDateTime`
where
timestampToLocalDateTime` _ iworld=:{world}
# (tm, world) = toLocalTime ts world
= (Ok (tmToDateTime tm), {iworld & world = world})
localDateToTimestamp :: !Date -> Task Timestamp
localDateToTimestamp {Date|day,mon,year} = mkInstantTask localDateToTimestamp`
where
localDateToTimestamp` _ iworld=:{world}
# (ts, world) = mkTime {Tm|sec = 0, min = 0, hour = 0, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday = 0, isdst = -1} world
= (Ok ts, {iworld & world = world})
dateToTimestamp :: !Date -> Timestamp
dateToTimestamp {Date|day,mon,year}
= mkTime {Tm|sec = 0, min = 0, hour = 0, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday = 0, isdst = -1}
localDateTimeToTimestamp :: !DateTime -> Task Timestamp
localDateTimeToTimestamp {DateTime|day,mon,year,hour,min,sec} = mkInstantTask localDateTimeToTimestamp`
where
localDateTimeToTimestamp` _ iworld=:{world}
# (ts, world) = mkTime {Tm|sec = sec, min = min, hour = hour, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday = 0, isdst = -1} world
= (Ok ts, {iworld & world = world})
datetimeToTimestamp :: !DateTime -> Timestamp
datetimeToTimestamp {DateTime|day,mon,year,hour,min,sec}