Commit 68be56f5 authored by Mart Lubbers's avatar Mart Lubbers Committed by Camil Staps

reduce strictness ignored warnings

parent 36c25972
Pipeline #27569 passed with stage
in 5 minutes and 5 seconds
......@@ -149,8 +149,8 @@ editDeviceToDevice dev
:: EditDeviceType =
{ kind :: !DeviceKind
, requires :: ![(!CableType, !Capacity)]
, produces :: ![(!CableType, !Capacity)]
, requires :: ![(CableType, Capacity)]
, produces :: ![(CableType, Capacity)]
}
:: EditDevice =
......
......@@ -64,9 +64,9 @@ from C2.Apps.ShipAdventure.Images import :: RenderMode
// physical devices
:: Network =
{ devices :: !Map Coord3D [DeviceId] // [Coord3D |-> DeviceIds]
, cables :: !IntMap Cable // [CableId |-> Cable]
, cableMapping :: !IntMap [(!Operational, !Coord3D)] // [CableId |-> Coord3Ds]
{ devices :: !Map Coord3D [DeviceId] // [Coord3D |-> DeviceIds]
, cables :: !IntMap Cable // [CableId |-> Cable]
, cableMapping :: !IntMap [(Operational, Coord3D)] // [CableId |-> Coord3Ds]
}
:: Device =
{ description :: !String
......@@ -95,8 +95,8 @@ from C2.Apps.ShipAdventure.Images import :: RenderMode
:: PPDeviceType =
{ kind :: !DeviceKind
, requires :: ![(!CableType, !Capacity)]
, produces :: ![(!CableType, !Capacity)]
, requires :: ![(CableType, Capacity)]
, produces :: ![(CableType, Capacity)]
}
:: CommandAim =
......@@ -169,8 +169,8 @@ cablesInSectionShare :: SDSLens Coord3D [Cable] [Cable]
cablesForSection :: !Coord3D !Network -> [Cable]
allActiveAlarms :: SDSLens () [(!Coord3D, !SectionStatus)] ()
allAvailableActors :: SDSLens () [(!Coord3D, !MyActor)] ()
allActiveAlarms :: SDSLens () [(Coord3D, SectionStatus)] ()
allAvailableActors :: SDSLens () [(Coord3D, MyActor)] ()
// setting and resetting of the detection systems:
......@@ -203,7 +203,7 @@ allImperiledCommandAims :: !(IntMap Device) !CapabilityToDeviceKindMap ![Command
deviceIsDisabledInSection :: !Coord3D !Device !(IntMap Device) !Network -> Bool
isOperational :: !CableId !(IntMap [(!Operational, !Coord3D)]) -> Bool
isOperational :: !CableId !(IntMap [(Operational, Coord3D)]) -> Bool
devicesForCable :: !Cable !(IntMap Device) !Network -> [Device]
......
......@@ -224,7 +224,7 @@ toPPDeviceType { DeviceType | kind, requires, produces } = { PPDeviceType
, produces = 'DM'.toList produces
}
isOperational :: !CableId !(IntMap [(!Operational, !Coord3D)]) -> Bool
isOperational :: !CableId !(IntMap [(Operational, Coord3D)]) -> Bool
isOperational cableId cableMapping = and [b \\ (b, _) <- fromMaybe [] ('DIS'.get cableId cableMapping)]
smokeDetector :: DeviceType
......@@ -383,22 +383,22 @@ patchCable roomNo cableId network = { network & cableMapping = 'DIS'.alter (fmap
inventoryInSectionShare :: FocusedSectionInventoryShare ObjectType
inventoryInSectionShare = mapLens "inventoryInSectionShare" myInventoryMap (Just 'DIS'.newMap)
allAvailableActors :: SDSLens () [(!Coord3D, !MyActor)] ()
allAvailableActors :: SDSLens () [(Coord3D, MyActor)] ()
allAvailableActors
= /*toReadOnly */ (sdsProject (SDSLensRead readActors) (SDSBlindWrite \_. Ok Nothing) Nothing (sectionUsersShare |*| myUserActorMap))
where
readActors :: !(SectionUsersMap, UserActorMap ObjectType ActorStatus) -> MaybeError TaskException [(!Coord3D, !MyActor)]
readActors :: !(SectionUsersMap, UserActorMap ObjectType ActorStatus) -> MaybeError TaskException [(Coord3D, MyActor)]
readActors (sectionUsersMap, userActorMap)
= Ok [(c3d, a) \\ us <- 'DM'.elems sectionUsersMap
, u <- us
, Just (c3d, a) <- [findUser u sectionUsersMap userActorMap]
| a.actorStatus.occupied === Available]
allActiveAlarms :: SDSLens () [(!Coord3D, !SectionStatus)] ()
allActiveAlarms :: SDSLens () [(Coord3D, SectionStatus)] ()
allActiveAlarms
= /*toReadOnly */ (sdsProject (SDSLensRead readAlarms) (SDSBlindWrite \_. Ok Nothing) Nothing myStatusMap)
where
readAlarms :: !MySectionStatusMap -> MaybeError TaskException [(!Coord3D, !SectionStatus)]
readAlarms :: !MySectionStatusMap -> MaybeError TaskException [(Coord3D, SectionStatus)]
readAlarms statusMap = Ok [ (number, status) \\ (number, status) <- 'DM'.toList statusMap
| isHigh status]
......
......@@ -29,7 +29,7 @@ import Data.GenLexOrd
:: MapID :== String // identification of one map
:: Border = Open | Door | Wall
:: Size2D :== (!Real, !Real) // width and height
:: Shape2D :== [(!Real, !Real)] // outline in terms of Map2D.size coordinates (origin at left-top, max at right-bottom)
:: Shape2D :== [(Real, Real)] // outline in terms of Map2D.size coordinates (origin at left-top, max at right-bottom)
:: Maps2DIndex :== Int // index in Maps2D (0..length Maps2D-1)
:: Coord2D = { col :: !Int // x-coordinate (0.., identifies column)
, row :: !Int // y-coordinate (0.., identifies row)
......@@ -37,7 +37,7 @@ import Data.GenLexOrd
:: Coord3D :== (!Maps2DIndex, !Coord2D) // (index in Maps2D, {col,row} in map)
:: Dir = N | E | W | S // north, east, west, south
:: Graph :== Map Coord3D [(!Maybe Dir, !Coord3D)]
:: Graph :== Map Coord3D [(Maybe Dir, Coord3D)]
/********************************************************************************************************************
*
......@@ -145,7 +145,7 @@ moveAround :: !(DrawMapForActor r o a) !User
// finds all actors currently walking on the map, find all objects in the map
findAllObjects :: !(SectionInventoryMap o) -> [(!Coord3D, !Object o)] | iTask o
findAllObjects :: !(SectionInventoryMap o) -> [(Coord3D, Object o)] | iTask o
findUser :: !User !SectionUsersMap !(UserActorMap o a) -> Maybe (!Coord3D, !Actor o a) | iTask o & iTask a
// update the status of an actor, unique username is used as identification
......
......@@ -132,7 +132,7 @@ colToGraph floorIdx rowIdx (graph, colIdx) section
#! graph = 'DM'.put (floorIdx, currCoord2D) (getCoord3Ds section floorIdx currCoord2D section.borders) graph
= (graph, colIdx + 1)
getCoord3Ds :: !Section !Int !Coord2D !Borders -> [(!Maybe Dir, !Coord3D)]
getCoord3Ds :: !Section !Int !Coord2D !Borders -> [(Maybe Dir, Coord3D)]
getCoord3Ds section floorIdx currCoord2D borders
#! acc = []
#! acc = addOnOpening floorIdx borders.n N currCoord2D acc
......@@ -142,7 +142,7 @@ getCoord3Ds section floorIdx currCoord2D borders
#! acc = acc ++ map (\h -> (Nothing, h)) section.hops
= acc
where
addOnOpening :: !Int !Border !Dir !Coord2D ![(!Maybe Dir, !Coord3D)] -> [(!Maybe Dir, !Coord3D)]
addOnOpening :: !Int !Border !Dir !Coord2D ![(Maybe Dir, Coord3D)] -> [(Maybe Dir, Coord3D)]
addOnOpening _ Wall _ _ acc = acc
addOnOpening floorIdx b dir coord2D acc = [(Just dir, (floorIdx, twin dir coord2D)) : acc]
......@@ -683,7 +683,7 @@ doorIsLocked roomNo exit lockMap
// utility functions to find things located in the map
findAllObjects :: !(SectionInventoryMap o) -> [(!Coord3D, !Object o)] | iTask o
findAllObjects :: !(SectionInventoryMap o) -> [(Coord3D, Object o)] | iTask o
findAllObjects objectMap = [ (roomNo, object)
\\ (roomNo, objects) <- 'DM'.toList objectMap
, object <- 'DIS'.elems objects
......
......@@ -23,7 +23,7 @@ filterDirs _ = True
seq [] = tuple (Ok [])
seq [e:es] = e >>= \a->seq es >>= \as->tuple (Ok [a:as])
recurse :: FilePath -> .(*World -> *(MaybeError OSError [FilePath], !*World))
recurse :: FilePath -> .(*World -> *(MaybeError OSError [FilePath], *World))
recurse root
| endsWith ".dcl" root = tuple (Ok [root])
= getFileInfo root >>= \fi->if fi.directory
......
......@@ -43,7 +43,7 @@ queueServiceWriteRequest :: !(SDSRemoteService p r w) !p !w !TaskId !*IWorld ->
* Queue that a task on a remote service should refresh itself.
* @param Remote notify requests
*/
queueRemoteRefresh :: ![(!TaskId, !RemoteNotifyOptions)] !*IWorld -> *IWorld
queueRemoteRefresh :: ![(TaskId, RemoteNotifyOptions)] !*IWorld -> *IWorld
/**
* Queue a write operation to a remote sds.
......
......@@ -229,7 +229,7 @@ where
buildRequest True iworld=:{options}= (SDSRegisterRequest sds p reqSDSId (sdsIdentity rsds) taskId options.sdsPort, iworld)
buildRequest False iworld = (SDSReadRequest sds p, iworld)
queueRemoteRefresh :: ![(!TaskId, !RemoteNotifyOptions)] !*IWorld -> *IWorld
queueRemoteRefresh :: ![(TaskId, RemoteNotifyOptions)] !*IWorld -> *IWorld
queueRemoteRefresh [] iworld = iworld
queueRemoteRefresh [(reqTaskId, remoteOpts) : reqs] iworld=:{options}
# (symbols, iworld) = case read symbolsShare EmptyContext iworld of
......
......@@ -16,7 +16,7 @@ import Text
from Data.Map import newMap, member
everyTick :: (*IWorld -> *(!MaybeError TaskException (), !*IWorld)) -> Task ()
everyTick :: (*IWorld -> *(MaybeError TaskException (), *IWorld)) -> Task ()
everyTick f = Task eval
where
eval DestroyEvent evalOpts tree iworld
......
......@@ -95,7 +95,7 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
| IODestroyed !(Map ConnectionId (!Dynamic,!Bool)) // Bool: stability
| IOException !String
:: SDSEvalStates :== Map TaskId (*IWorld -> *(MaybeError TaskException Dynamic, !*IWorld))
:: SDSEvalStates :== Map TaskId (*IWorld -> *(MaybeError TaskException Dynamic, *IWorld))
:: *Resource = Resource | .. //Extensible resource type for caching database connections etc...
......
......@@ -71,18 +71,18 @@ instance Registrable SDSDebug
createReadWriteSDS ::
!String
!String
!(p *IWorld -> *(!MaybeError TaskException r, !*IWorld))
!(p w *IWorld -> *(!MaybeError TaskException (SDSNotifyPred p), !*IWorld))
!(p *IWorld -> *(MaybeError TaskException r, *IWorld))
!(p w *IWorld -> *(MaybeError TaskException (SDSNotifyPred p), *IWorld))
->
SDSSource p r w
createReadOnlySDS ::
!(p *IWorld -> *(!r, !*IWorld))
!(p *IWorld -> *(r, *IWorld))
->
SDSSource p r ()
createReadOnlySDSError ::
!(p *IWorld -> *(!MaybeError TaskException r, !*IWorld))
!(p *IWorld -> *(MaybeError TaskException r, *IWorld))
->
SDSSource p r ()
......@@ -139,4 +139,4 @@ flushDeferredSDSWrites :: !*IWorld -> (!MaybeError TaskException (), !*IWorld)
// Used to turn any read/write/modified operation (with all arguments except the environment
// curried in) into one which returns a dynamic. Use to store sdsEvalStates in the environment.
dynamicResult :: (*IWorld -> (MaybeError TaskException a, !*IWorld)) !*IWorld -> (MaybeError TaskException Dynamic, !*IWorld) | TC a
dynamicResult :: (*IWorld -> (MaybeError TaskException a, *IWorld)) !*IWorld -> (MaybeError TaskException Dynamic, !*IWorld) | TC a
......@@ -23,22 +23,22 @@ from Text import instance + String
createReadWriteSDS ::
!String
!String
!(p *IWorld -> *(!MaybeError TaskException r, !*IWorld))
!(p w *IWorld -> *(!MaybeError TaskException (SDSNotifyPred p), !*IWorld))
!(p *IWorld -> *(MaybeError TaskException r, *IWorld))
!(p w *IWorld -> *(MaybeError TaskException (SDSNotifyPred p), *IWorld))
->
SDSSource p r w
createReadWriteSDS ns id read write
= createSDS ns id read write
createReadOnlySDS ::
!(p *IWorld -> *(!r, !*IWorld))
!(p *IWorld -> *(r, *IWorld))
->
SDSSource p r ()
createReadOnlySDS read
= createReadOnlySDSError (\p iworld -> appFst Ok (read p iworld))
createReadOnlySDSError ::
!(p *IWorld -> *(!MaybeError TaskException r, !*IWorld))
!(p *IWorld -> *(MaybeError TaskException r, *IWorld))
->
SDSSource p r ()
createReadOnlySDSError read
......@@ -47,8 +47,8 @@ createReadOnlySDSError read
createSDS ::
!String
!String
!(p *IWorld -> *(!MaybeError TaskException r, !*IWorld))
!(p w *IWorld -> *(!MaybeError TaskException (SDSNotifyPred p), !*IWorld))
!(p *IWorld -> *(MaybeError TaskException r, *IWorld))
!(p w *IWorld -> *(MaybeError TaskException (SDSNotifyPred p), *IWorld))
->
SDSSource p r w
createSDS ns id read write = SDSSource
......@@ -134,7 +134,7 @@ checkRegistrations sdsId pred iworld
= (match,nomatch,iworld)
where
//Find all notify requests for the given share id
lookupRegistrations :: String !*IWorld -> (![(!SDSNotifyRequest, !Timespec)], !*IWorld)
lookupRegistrations :: String !*IWorld -> (![(SDSNotifyRequest, Timespec)], !*IWorld)
lookupRegistrations sdsId iworld=:{sdsNotifyRequests} =
('DM'.toList $ 'DM'.findWithDefault 'DM'.newMap sdsId sdsNotifyRequests, iworld)
......@@ -224,7 +224,7 @@ where
# (errors,iworld) = flushAll rest iworld
= ([e:errors],iworld)
dynamicResult :: (*IWorld -> (MaybeError TaskException a, !*IWorld)) !*IWorld -> (MaybeError TaskException Dynamic, !*IWorld) | TC a
dynamicResult :: (*IWorld -> (MaybeError TaskException a, *IWorld)) !*IWorld -> (MaybeError TaskException Dynamic, !*IWorld) | TC a
dynamicResult f iworld = case f iworld of
(Error e, iworld) = (Error e, iworld)
(Ok a, iworld) = (Ok (dynamic a), iworld)
......
......@@ -29,13 +29,13 @@ derive gEq Task
//Version of connection handlers with IWorld side-effects that is still necessary for built-in framework handlers
:: ConnectionHandlersIWorld l r w =
{ onConnect :: !(ConnectionId String r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, onData :: !( String l r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, onShareChange :: !( l r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, onTick :: !( l r *IWorld -> *(!MaybeErrorString l, Maybe w, ![String], !Bool, !*IWorld))
, onDisconnect :: !( l r *IWorld -> *(!MaybeErrorString l, Maybe w, !*IWorld))
, onDestroy :: !( l *IWorld -> *(!MaybeErrorString l, ![String], !*IWorld))
}
{ onConnect :: !(ConnectionId String r *IWorld -> *(MaybeErrorString l, Maybe w, [String], Bool, *IWorld))
, onData :: !( String l r *IWorld -> *(MaybeErrorString l, Maybe w, [String], Bool, *IWorld))
, onShareChange :: !( l r *IWorld -> *(MaybeErrorString l, Maybe w, [String], Bool, *IWorld))
, onTick :: !( l r *IWorld -> *(MaybeErrorString l, Maybe w, [String], Bool, *IWorld))
, onDisconnect :: !( l r *IWorld -> *(MaybeErrorString l, Maybe w, *IWorld))
, onDestroy :: !( l *IWorld -> *(MaybeErrorString l, [String], *IWorld))
}
/**
* Wraps a set of connection handlers and a shared source as a connection task
......@@ -46,5 +46,5 @@ wrapIWorldConnectionTask :: (ConnectionHandlersIWorld l r w) (sds () r w) -> Con
/**
* Create a task that finishes instantly
*/
mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -> Task a | iTask a
mkInstantTask :: (TaskId *IWorld -> (MaybeError (Dynamic,String) a,*IWorld)) -> Task a | iTask a
......@@ -111,7 +111,7 @@ where
= (toDyn <$> mbl, out, env)
onDestroy` l env = abort ("onDestroy does not match with type l=" +++ toString (typeCodeOfDynamic l))
mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -> Task a | iTask a
mkInstantTask :: (TaskId *IWorld -> (MaybeError (Dynamic,String) a,*IWorld)) -> Task a | iTask a
mkInstantTask iworldfun = Task (evalOnce iworldfun)
where
evalOnce f DestroyEvent _ _ iworld = (DestroyedResult,iworld)
......
......@@ -20,7 +20,7 @@ from iTasks.Internal.Task import :: ConnectionTask, :: TaskException
from iTasks.Engine import :: StartupTask
//Core task server loop
serve :: ![StartupTask] ![(!Int,!ConnectionTask)] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
serve :: ![StartupTask] ![(Int,ConnectionTask)] (*IWorld -> (Maybe Timeout,*IWorld)) *IWorld -> *IWorld
//Dynamically add a listener
addListener :: !TaskId !Int !Bool !(ConnectionTask) !*IWorld -> (!MaybeError TaskException (),!*IWorld)
......
......@@ -26,11 +26,11 @@ import iTasks.WF.Definition
= ListenerInstanceDS !ListenerInstanceOpts
| ConnectionInstanceDS !ConnectionInstanceOpts !*TCP_SChannel
serve :: ![StartupTask] ![(!Int,!ConnectionTask)] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
serve :: ![StartupTask] ![(Int,ConnectionTask)] (*IWorld -> (Maybe Timeout,*IWorld)) *IWorld -> *IWorld
serve its cts determineTimeout iworld
= loop determineTimeout (init its cts iworld)
init :: ![StartupTask] ![(!Int,!ConnectionTask)] !*IWorld -> *IWorld
init :: ![StartupTask] ![(Int,ConnectionTask)] !*IWorld -> *IWorld
init its cts iworld
# iworld = installSignalHandlers iworld
// Check if the initial tasks have been added already
......@@ -55,7 +55,7 @@ where
Ok (ReadingDone index) = foldl (\w (instanceNo,_,_,_) -> queueEvent instanceNo ResetEvent w) iworld index
_ = iworld
connectAll :: ![(!Int,!ConnectionTask)] !*World -> *(![*IOTaskInstance],!*World)
connectAll :: ![(Int,ConnectionTask)] !*World -> *(![*IOTaskInstance],!*World)
connectAll [] world = ([],world)
connectAll [(port,ct):cts] world
# (l,world) = connect port ct world
......@@ -76,7 +76,7 @@ where
(Error (_, e), world) = abort ("Couldn't install SIGINT: " +++ e)
(Ok h2, world) = {iworld & signalHandlers=[h1,h2:signalHandlers], world=world}
loop :: !(*IWorld -> (!Maybe Timeout,!*IWorld)) !*IWorld -> *IWorld
loop :: !(*IWorld -> (Maybe Timeout,*IWorld)) !*IWorld -> *IWorld
loop determineTimeout iworld=:{ioTasks,sdsNotifyRequests,signalHandlers}
// Also put all done tasks at the end of the todo list, as the previous event handling may have yielded new tasks.
# (mbTimeout,iworld=:{IWorld|ioTasks={todo},world}) = determineTimeout {iworld & ioTasks = {done=[], todo = ioTasks.todo ++ (reverse ioTasks.done)}}
......@@ -139,7 +139,7 @@ toSelectSet [i:is]
In the same pass also update the indices in the select result to match the
correct indices of the main loop instance list.
*/
fromSelectSet :: !*[*TCP_Listener] !*[*TCP_RChannel] !*[*IOTaskInstanceDuringSelect] ![(!Int,!SelectResult)] -> *(![*IOTaskInstance],![(!Int,!SelectResult)])
fromSelectSet :: !*[*TCP_Listener] !*[*TCP_RChannel] !*[*IOTaskInstanceDuringSelect] ![(Int,SelectResult)] -> *(![*IOTaskInstance],![(Int,SelectResult)])
fromSelectSet ls rs is chList
# (numListeners,ls) = ulength ls
# sortedChList = sortBy (\(x,_) (y,_) -> (x < y)) chList //The single-pass algorithm expects a sorted select result
......@@ -175,7 +175,7 @@ where
= (n + 1,[x:xs])
//TODO: Use share notification to trigger task re-evaluation based on io events
process :: !Int [(!Int,!SelectResult)] !*IWorld -> *IWorld
process :: !Int [(Int,SelectResult)] !*IWorld -> *IWorld
process i chList iworld=:{ioTasks={done,todo=[]}} = iworld
process i chList iworld=:{ioTasks={done,todo=[ListenerInstance lopts listener:todo]},ioStates,world}
# taskId=:(TaskId instanceNo _) = lopts.ListenerInstanceOpts.taskId
......@@ -266,13 +266,14 @@ process i chList iworld=:{ioTasks={done,todo=[t:todo]}}
// Definitions of IO tasks (tcp connections)
:: IOTaskOperations ioChannels readData closeInfo =
{ readData :: !(Int [(Int, SelectResult)] *(!ioChannels, !*IWorld) -> *(!IOData readData closeInfo, !ioChannels, !*IWorld))
, writeData :: !(String *(!ioChannels, !*IWorld) -> *(!ioChannels, !*IWorld))
{ readData :: !(Int [(Int, SelectResult)] *(!ioChannels, !*IWorld) -> *(IOData readData closeInfo, ioChannels, *IWorld))
, writeData :: !(String *(!ioChannels, !*IWorld) -> *(ioChannels, *IWorld))
, closeIO :: !( *(!ioChannels, !*IWorld) -> *IWorld)
}
:: IOData data closeInfo = IODClosed closeInfo
| IODNoData
| IODData !data & TC data
:: IOData data closeInfo
= IODClosed closeInfo
| IODNoData
| IODData !data & TC data
tcpConnectionIOOps :: IOTaskOperations *TCP_DuplexChannel String ()
tcpConnectionIOOps = {readData = readData, writeData = writeData, closeIO = closeIO}
......@@ -309,11 +310,11 @@ processIOTask :: !Int
!Bool
!(SimpleSDSLens Dynamic)
!(IOTaskOperations .ioChannels readData closeInfo)
!(closeInfo Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, !*IWorld))
!(readData Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(Dynamic Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(Dynamic *IWorld -> (!MaybeErrorString Dynamic, ![String], !*IWorld))
!(closeInfo Dynamic Dynamic *IWorld -> (MaybeErrorString Dynamic, Maybe Dynamic, *IWorld))
!(readData Dynamic Dynamic *IWorld -> (MaybeErrorString Dynamic, Maybe Dynamic, [String], Bool, *IWorld))
!(Dynamic Dynamic *IWorld -> (MaybeErrorString Dynamic, Maybe Dynamic, [String], Bool, *IWorld))
!(Dynamic Dynamic *IWorld -> (MaybeErrorString Dynamic, Maybe Dynamic, [String], Bool, *IWorld))
!(Dynamic *IWorld -> (MaybeErrorString Dynamic, [String], *IWorld))
!(.ioChannels -> *IOTaskInstance)
!.ioChannels
!*IWorld
......@@ -507,9 +508,9 @@ where
addIOTask :: !TaskId
!(Shared sds Dynamic)
!(*IWorld -> (!MaybeErrorString (!initInfo, !.ioChannels), !*IWorld))
!(*IWorld -> (MaybeErrorString (!initInfo, !.ioChannels), *IWorld))
!(IOTaskOperations .ioChannels readData closeInfo)
!(ConnectionId initInfo Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(ConnectionId initInfo Dynamic *IWorld -> (MaybeErrorString Dynamic, Maybe Dynamic, [String], Bool, *IWorld))
!(ConnectionId initInfo .ioChannels -> *IOTaskInstance)
!*IWorld
-> (!MaybeError TaskException (ConnectionId, Dynamic), !*IWorld) | Readable sds
......@@ -555,7 +556,7 @@ where
maxListInc [] = zero
maxListInc list = inc (maxList list)
checkSelect :: !Int ![(!Int,!SelectResult)] -> (!Maybe SelectResult,![(!Int,!SelectResult)])
checkSelect :: !Int ![(Int,SelectResult)] -> (!Maybe SelectResult,![(Int,SelectResult)])
checkSelect i chList =:[(who,what):ws] | (i == who) = (Just what,ws)
checkSelect i chList = (Nothing,chList)
......
......@@ -71,7 +71,7 @@ derive gDefault TIMeta
| TCAwait !AsyncAction !TaskId !TaskTime !TaskTree
| TCInteract !TaskId !TaskTime !DeferredJSON !DeferredJSON !EditState !Bool
| TCStep !TaskId !TaskTime !(Either (!TaskTree, ![String]) (!DeferredJSON, !Int, !TaskTree))
| TCParallel !TaskId !TaskTime ![(!TaskId,!TaskTree)] ![String] //Subtrees of embedded tasks and enabled actions
| TCParallel !TaskId !TaskTime ![(TaskId,TaskTree)] ![String] //Subtrees of embedded tasks and enabled actions
| TCShared !TaskId !TaskTime !TaskTree
| TCAttach !TaskId !TaskTime !AttachmentStatus !String !(Maybe String)
| TCStable !TaskId !TaskTime !DeferredJSON
......
......@@ -65,7 +65,7 @@ taskInstanceValue :: SDSLens InstanceNo (Maybe TIValue) (Maybe TIVal
taskInstanceShares :: SDSLens InstanceNo (Maybe (Map TaskId DeferredJSON)) (Maybe (Map TaskId DeferredJSON))
taskInstanceParallelTaskLists :: SDSLens InstanceNo (Maybe (Map TaskId [ParallelTaskState])) (Maybe (Map TaskId [ParallelTaskState]))
topLevelTaskList :: SDSLens TaskListFilter (!TaskId,![TaskListItem a]) [(!TaskId,!TaskAttributes)]
topLevelTaskList :: SDSLens TaskListFilter (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)]
taskInstanceIO :: SDSLens InstanceNo (Maybe (!String,!Timespec)) (Maybe (!String,!Timespec))
allInstanceIO :: SimpleSDSLens (Map InstanceNo (!String,Timespec))
......@@ -89,7 +89,7 @@ taskInstanceParallelTaskListItem :: SDSLens (TaskId,TaskId,Bool) ParallelTask
taskInstanceEmbeddedTask :: SDSLens TaskId (Task a) (Task a) | iTask a
//Public interface used by parallel tasks
parallelTaskList :: SDSSequence (!TaskId,!TaskId,!TaskListFilter) (!TaskId,![TaskListItem a]) [(!TaskId,!TaskAttributes)] | iTask a
parallelTaskList :: SDSSequence (!TaskId,!TaskId,!TaskListFilter) (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)] | iTask a
//=== Task instance output: ===
......@@ -157,7 +157,7 @@ queueEvent :: !InstanceNo !Event !*IWorld -> *IWorld
/**
* Convenience function for queueing multiple refresh multiple refresh events at once
*/
queueRefresh :: ![(!TaskId, !String)] !*IWorld -> *IWorld
queueRefresh :: ![(TaskId, String)] !*IWorld -> *IWorld
/**
* Dequeue a task event
......
......@@ -351,7 +351,7 @@ where
notify no _ = const ((==) no)
//Top list share has no items, and is therefore completely polymorphic
topLevelTaskList :: SDSLens TaskListFilter (!TaskId,![TaskListItem a]) [(!TaskId,!TaskAttributes)]
topLevelTaskList :: SDSLens TaskListFilter (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)]
topLevelTaskList = sdsLens "topLevelTaskList" param (SDSRead read) (SDSWrite write) (SDSNotifyConst notify) (Just reducer)
((sdsFocus filter filteredInstanceIndex) >*| currentInstanceShare)
where
......@@ -375,7 +375,7 @@ where
notify _ _ _ _ = True
reducer :: TaskListFilter [InstanceData] -> MaybeError TaskException [(!TaskId,!TaskAttributes)]
reducer :: TaskListFilter [InstanceData] -> MaybeError TaskException [(TaskId,TaskAttributes)]
reducer p ws = Ok (map ff ws)
where
ff (i, _, _, Just attr) = (TaskId i 0, attr)
......@@ -471,7 +471,7 @@ where
notify taskId _ = const ((==) taskId)
reducer p reduct = read p reduct
parallelTaskList :: SDSSequence (!TaskId,!TaskId,!TaskListFilter) (!TaskId,![TaskListItem a]) [(!TaskId,!TaskAttributes)] | iTask a
parallelTaskList :: SDSSequence (!TaskId,!TaskId,!TaskListFilter) (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)] | iTask a
parallelTaskList
= sdsSequence "parallelTaskList" id param2 (\_ _ -> Right read) (SDSWriteConst write1) (SDSWriteConst write2) filteredTaskStates filteredInstanceIndex
where
......@@ -531,7 +531,7 @@ where
((\front` -> ('DQ'.Queue front` back)) <$> queueWithMergedRefreshEventList front) <|>
((\back` -> ('DQ'.Queue front back`)) <$> queueWithMergedRefreshEventList back)
where
queueWithMergedRefreshEventList :: [(!InstanceNo, !Event)] -> Maybe [(!InstanceNo, !Event)]
queueWithMergedRefreshEventList :: [(InstanceNo, Event)] -> Maybe [(InstanceNo, Event)]
queueWithMergedRefreshEventList [] = Nothing
queueWithMergedRefreshEventList [hd=:(instanceNo`, event`) : tl] = case event` of
RefreshEvent refreshTasks` reason` | instanceNo` == instanceNo =
......@@ -543,7 +543,7 @@ where
mergeReason x y = concat [x , "; " , y]
_ = Nothing
queueRefresh :: ![(!TaskId, !String)] !*IWorld -> *IWorld
queueRefresh :: ![(TaskId, String)] !*IWorld -> *IWorld
queueRefresh [] iworld = iworld
queueRefresh tasks iworld
//Clear the instance's share change registrations, we are going to evaluate anyway
......
......@@ -54,9 +54,9 @@ instance == TLit
| TSel !TExpr ![TExpr]
| TRecUpd !VarName !TExpr ![TExpr]
| TNoBind
| TLet ![(!Pattern, !TExpr)] !TExpr
| TLet ![(Pattern, TExpr)] !TExpr
| TIf !ExprId !TExpr !TExpr !TExpr
| TCase !ExprId !TExpr ![(!Pattern, !TExpr)]
| TCase !ExprId !TExpr ![(Pattern, TExpr)]
| TExpand ![TExpr] !TonicFunc
| TAugment !TExpr !TExpr
......
......@@ -28,7 +28,7 @@ doAction :: !(a (ActionState a s) -> b) !(TaskValue (ActionState a s)) -> Maybe
:: TaskAppRenderer :== Bool Bool Bool Bool Bool Bool Bool ExprId ModuleName FuncName
ModuleName FuncName [Image ModelTy] [Image ModelTy] *TagSource
-> *(!Maybe (Image ModelTy), !*TagSource)
-> *(Maybe (Image ModelTy), *TagSource)
mkStaticImage :: ![TaskAppRenderer] !BlueprintIdent !Bool !ModelTy *TagSource
-> Image ModelTy
......
......@@ -402,7 +402,7 @@ tIf inh eid cexpr texpr eexpr tsrc
= tCaseOrIf inh cexpr [ (Just (TLit (TBool True)), texpr, True, ut)
, (Just (TLit (TBool False)), eexpr, True, ue)] tsrc
tCase :: !(InhMkImg i) !ExprId !TExpr ![(!Pattern, !TExpr)] !*TagSource -> *(!SynMkImg, !*TagSource) | BlueprintLike i
tCase :: !(InhMkImg i) !ExprId !TExpr ![(Pattern, TExpr)] !*TagSource -> *(!SynMkImg, !*TagSource) | BlueprintLike i
tCase inh eid texpr pats tsrc
#! mbranch = case inh.inh_bpinst of
Just bpi -> 'DM'.get eid (getBranches bpi)
......@@ -447,7 +447,7 @@ tCaseDiamond inh exprImg [(diamondTag, uDiamondTag) : tsrc]
#! img = overlay (repeat (AtMiddleX, AtMiddleY)) [] [diamond, exprImg] NoHost
= (img, tsrc)
tLet :: !(InhMkImg i) ![(!Pattern, !TExpr)] !TExpr !*TagSource -> *(!SynMkImg, *TagSource) | BlueprintLike i
tLet :: !(InhMkImg i) ![(Pattern, TExpr)] !TExpr !*TagSource -> *(!SynMkImg, *TagSource) | BlueprintLike i
tLet inh pats expr [(txttag, uTxtTag) : tsrc]
#! inh = {inh & inh_in_let = True}
= case expr of
......@@ -611,7 +611,7 @@ ppCompId xs = "[" +++ ppCompId` xs +++ "]"
ppCompId` [x] = toString x
ppCompId` [x:xs] = toString x +++ ", " +++ ppCompId` xs
tTaskDef :: !(InhMkImg i) !String !String !TExpr ![(!TExpr, !TExpr)] ![TExpr] !(Image ModelTy) !*TagSource
tTaskDef :: !(InhMkImg i) !String !String !TExpr ![(TExpr, TExpr)] ![TExpr] !(Image ModelTy) !*TagSource
-> *(!Image ModelTy, !*TagSource) | BlueprintLike i
tTaskDef inh moduleName taskName resultTy args argvars tdbody [(nameTag, uNameTag) : (argsTag, uArgsTag) : (bdytag, uBodyTag) : tsrc]
#! userImg = case inh.inh_bpinst of
......@@ -1084,8 +1084,8 @@ addAction _ _ _ = empty (px 0.0) (px 0.0)
hasValueFilter :: Image ModelTy
hasValueFilter = beside (repeat AtMiddleY) [] Nothing [] [ tStableBox, tUnstableBox, text ArialBold10px " Has value"] NoHost
tBranches :: !(InhMkImg i) !((InhMkImg i) TExpr *TagSource -> *(!SynMkImg, !*TagSource))
!Bool !Bool ![(!Maybe Pattern, !TExpr, !Bool, !Bool)] !ImageTag !*TagSource
tBranches :: !(InhMkImg i) !((InhMkImg i) TExpr *TagSource -> *(SynMkImg, *TagSource))
!Bool !Bool ![(Maybe Pattern, TExpr, Bool, Bool)] !ImageTag !*TagSource
-> *(!SynMkImg, !*TagSource) | BlueprintLike i
tBranches inh mkBranch needAllDone inclVertConns exprs contextTag tsrc
#! (allTags, nonUTags, tsrc) = takeNTags (length exprs) tsrc
......@@ -1215,35 +1215,35 @@ tUnstableBox = overlay (repeat (AtMiddleX, AtMiddleY)) [] [ rect (px 8.0) (px 8.
, text ArialBold6px "U" ] NoHost
strictTRMapSt :: !(.a -> .(.st -> .(!b, !.st))) ![.a] !.st -> .(![b], !.st)
strictTRMapSt :: !(.a -> .(.st -> .(b, .st))) ![.a] !.st -> .(![b], !.st)
strictTRMapSt f xs st
#! (rs, st) = strictTRMapStAcc f xs [] st
= (reverseTR rs, st)
strictTRMapStAcc :: !(.a -> .(.st -> .(!b, !.st))) ![.a] ![b] !.st -> .(![b], !.st)
strictTRMapStAcc :: !(.a -> .(.st -> .(b, .st))) ![.a] ![b] !.st -> .(![b], !.st)
strictTRMapStAcc f [] acc st = (acc, st)
strictTRMapStAcc f [x:xs] acc st
#! (r, st) = f x st
= strictTRMapStAcc f xs [r : acc] st
strictTRZip2 :: ![a] ![b] -> [(!a, !b)]
strictTRZip2 :: ![a] ![b] -> [(a, b)]
strictTRZip2 as bs = reverseTR (strictTRZip2Rev as bs)
strictTRZip2Rev :: ![a] ![b] -> [(!a, !b)]
strictTRZip2Rev :: ![a] ![b] -> [(a, b)]
strictTRZip2Rev as bs = strictTRZip2Acc as bs []
strictTRZip2Acc :: ![a] ![b] ![(!a, !b)] -> [(!a, !b)]
strictTRZip2Acc :: ![a] ![b] ![(a, b)] -> [(a, b)]
strictTRZip2Acc [a:as] [b:bs] acc
= strictTRZip2Acc as bs [(a, b):acc]
strictTRZip2Acc _ _ acc = acc
strictTRZip3 :: ![.a] ![.b] ![.c] -> [(!.a, !.b, !.c)]
strictTRZip3 :: ![.a] ![.b] ![.c] -> [(.a, .b, .c)]
strictTRZip3 as bs cs = reverseTR (strictTRZip3Rev as bs cs)
strictTRZip3Rev :: ![.a] ![.b] ![.c] -> [(!.a, !.b, !.c)]
strictTRZip3Rev :: ![.a] ![.b] ![.c] -> [(.a, .b, .c)]
strictTRZip3Rev as bs cs = strictTRZip3Acc as bs cs []
strictTRZip3Acc :: !u:[v:a] !w:[x:b] !y:[z:c] !u0:[v0:(!v:a, !x:b, !z:c)] -> w0:[x0:(!v:a, !x:b, !z:c)], [x0 u <= v,x0 w <= x,x0 y <= z,u0 <= v0,u0 <= w0,w0 v0 <= x0]
strictTRZip3Acc :: !u:[v:a] !w:[x:b] !y:[z:c] !u0:[v0:(v:a, x:b, z:c)] -> w0:[x0:(v:a, x:b, z:c)], [x0 u <= v,x0 w <= x,x0 y <= z,u0 <= v0,u0 <= w0,w0 v0 <= x0]
strictTRZip3Acc [a:as] [b:bs] [c:cs] acc
= strictTRZip3Acc as bs cs [(a, b, c):acc]
strictTRZip3Acc _ _ _ acc = acc
......
......@@ -38,7 +38,7 @@ ppTExpr` d (TExpand _ tt) = ppTExpr` d tt.tf_body
ppTExpr` d TNoBind = ""
ppTExpr` _ _ = "ppTExpr: encountered more complex expression than we would like to pretty-print here..."
ppCases :: !Int ![(!Pattern, !TExpr)] -> String
ppCases :: !Int ![(Pattern, TExpr)] -> String
ppCases d xs = ppIntersperse (\(pat, expr) -> ppTExpr` d pat +++ " -> " +++ ppTExpr` d expr) "; " xs
ppTExprList :: !TExpr -> String
......
......@@ -32,14 +32,14 @@ from System.Time import :: Timespec
| WSPing String //A ping frame was received
:: WebService r w =
{ urlMatchPred :: !(String -> Bool) // checks whether the URL is served by this service
, completeRequest :: !Bool // wait for complete request before start serving request
, onNewReq :: !(HTTPRequest r *IWorld -> *(!HTTPResponse,!Maybe ConnectionState, !Maybe w, !*IWorld)) // is called for each new request
, onData :: !(HTTPRequest r String ConnectionState *IWorld -> *(![{#Char}], !Bool, !ConnectionState, !Maybe w, !*IWorld)) // on new data from client
, onShareChange :: !(HTTPRequest r ConnectionState *IWorld -> *(![{#Char}], !Bool, !ConnectionState, !Maybe w, !*IWorld)) // on shared change
, onTick :: !(HTTPRequest r ConnectionState *IWorld -> *(![{#Char}], !Bool, !ConnectionState, !Maybe w, !*IWorld)) // called on each iteration of main loop
, onDisconnect :: !(HTTPRequest r ConnectionState *IWorld -> *(!Maybe w, !*IWorld)) // is called on disconnect
}
{ urlMatchPred :: !(String -> Bool) // checks whether the URL is served by this service
, completeRequest :: !Bool // wait for complete request before start serving request
, onNewReq :: !(HTTPRequest r *IWorld -> *(HTTPResponse,Maybe ConnectionState, Maybe w, *IWorld)) // is called for each new request
, onData :: !(HTTPRequest r String ConnectionState *IWorld -> *([{#Char}], Bool, ConnectionState, Maybe w, *IWorld)) // on new data from client
, onShareChange :: !(HTTPRequest r ConnectionState *IWorld -> *([{#Char}], Bool, ConnectionState, Maybe w, *IWorld)) // on shared change
, onTick :: !(HTTPRequest r ConnectionState *IWorld -> *([{#Char}], Bool, ConnectionState, Maybe w, *IWorld)) // called on each iteration of main loop
, onDisconnect :: !(HTTPRequest r ConnectionState *IWorld -> *(Maybe w, *IWorld)) // is called on disconnect
}
httpServer :: !Int !Timespec ![WebService r w] (sds () r w) -> ConnectionTask | TC r & TC w & RWShared sds
......
......@@ -412,7 +412,7 @@ where
uiUrl matchUrl = (if (endsWith "/" matchUrl) matchUrl (matchUrl +++ "/")) +++ "gui-wsock"
dequeueOutput :: ![InstanceNo] !(Map InstanceNo TaskOutput) -> (![(!InstanceNo,!TaskOutputMessage)],!Map InstanceNo TaskOutput)
dequeueOutput :: ![InstanceNo] !(Map InstanceNo TaskOutput) -> (![(InstanceNo,TaskOutputMessage)],!Map InstanceNo TaskOutput)
dequeueOutput [] states = ([],states)
dequeueOutput [i:is] states
# (output,states) = dequeueOutput is states
......
......@@ -38,7 +38,7 @@ sdsTranslate name param sds = sdsLens name param
(Just \p ws. Ok (ws))
sds
sdsSplit :: !String !(p -> (ps,pn)) !(pn rs -> r) !(pn rs w -> (ws,SDSNotifyPred pn)) !(Maybe (!SDSReducer p ws w)) !(sds ps rs ws) -> SDSLens p r w | gText{|*|} ps & TC ps & gText{|*|} pn & TC pn & TC rs & TC ws & RWShared sds
sdsSplit :: !String !(p -> (ps,pn)) !(pn rs -> r) !(pn rs w -> (ws,SDSNotifyPred pn)) !(Maybe (SDSReducer p ws w)) !(sds ps rs ws) -> SDSLens p r w | gText{|*|} ps & TC ps & gText{|*|} pn & TC pn & TC rs & TC ws & RWShared sds
sdsSplit name param read write reducer sds = sdsLens name param` (SDSRead read`) (SDSWrite write`) (SDSNotify notify`) reducer sds
where
param` p = fst (param p)
......
......@@ -169,8 +169,8 @@ instance toString (WebServiceShareOptions p r w)
:: SDSSourceOptions p r w =
{ name :: !String
, read :: !p *IWorld -> *(!MaybeError TaskException r, !*IWorld)
, write :: !p w *IWorld -> *(!MaybeError TaskException (SDSNotifyPred p), !*IWorld)
, read :: !p *IWorld -> *(MaybeError TaskException r, *IWorld)
, write :: !p w *IWorld -> *(MaybeError TaskException (SDSNotifyPred p), *IWorld)
}
/**
......@@ -254,7 +254,7 @@ required type w. The reducer has the job to turn this ws into w.
:: SDSParallelOptions p1 r1 w1 p2 r2 w2 p r w =
{ name :: !String
, param :: !p -> (!p1, !p2)
, param :: !p -> (p1, p2)
, read :: !(!r1, !r2) -> r
, writel :: !SDSLensWrite p w r1 w1
, writer :: !SDSLensWrite p w r2 w2
......@@ -290,7 +290,7 @@ required type w. The reducer has the job to turn this ws into w.
:: SDSCache p r w = E. sds: SDSCache !(SDSSource p r w) !(SDSCacheOptions p r w) & gText{|*|}, TC p & TC r & TC w
:: SDSCacheOptions p r w =
{ write :: !p (Maybe r) (Maybe w) w -> (!Maybe r, !SDSCacheWrite)
{ write :: !p (Maybe r) (Maybe w) w -> (Maybe r, SDSCacheWrite)
}
:: SDSCacheWrite = WriteNow | WriteDelayed | NoWrite
......@@ -322,7 +322,7 @@ required type w. The reducer has the job to turn this ws into w.
{ host :: !String
, port :: !Int
, createMessage :: !p -> String
, fromTextResponse :: !String p Bool -> MaybeErrorString (!Maybe r, !Maybe String)
, fromTextResponse :: !String p Bool -> MaybeErrorString (Maybe r, Maybe String)
, writeMessageHandlers :: !Maybe (!p w -> String, !p String -> MaybeErrorString (Maybe (SDSNotifyPred p)))
}
......
......@@ -32,9 +32,9 @@ derive class iTask UITreeNode
//Representation of a collection of changes that need to be applied to an existing UI
:: UIChange
= NoChange //No changes are needed
| ReplaceUI !UI //Replace the entire UI with a new version
| ChangeUI [UIAttributeChange] [(!Int,!UIChildChange)] //Change the current UI and/or its children
= NoChange //No changes are needed
| ReplaceUI !UI //Replace the entire UI with a new version
| ChangeUI [UIAttributeChange] [(Int,UIChildChange)] //Change the current UI and/or its children
:: UIAttributeChange = SetAttribute !String !JSONNode //A change to a user interface attribute
| DelAttribute !String //Remove an attribute
......
......@@ -26,13 +26,13 @@ from Control.GenBimap import generic bimap, :: Bimap
:: Editor a =
//Generating the initial UI
{ genUI :: !UIAttributes DataPath *(EditMode a) *VSt ->
*(!MaybeErrorString (!UI, !EditState), !*VSt)
*(MaybeErrorString (!UI, !EditState), *VSt)
//React to edit events
, onEdit :: !DataPath (!DataPath, !JSONNode) EditState *VSt ->
*(!MaybeErrorString (!UIChange, !EditState), !*VSt)
*(MaybeErrorString (!UIChange, !EditState), *VSt)
//React to a new model value
, onRefresh :: !DataPath a EditState *VSt ->
*(!MaybeErrorString (!UIChange, !EditState), !*VSt)
*(MaybeErrorString (!UIChange, !EditState), *VSt)
//Get the typed value from the editor state, if the state represents a valid value
, valueFromState :: !EditState -> *Maybe a
}
......@@ -44,13 +44,13 @@ from Control.GenBimap import generic bimap, :: Bimap