Commit 47e4f146 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into 259-editors-need-refinement

parents a3d349db 730dec44
Pipeline #17054 passed with stage
in 3 minutes and 35 seconds
......@@ -6,7 +6,7 @@ import qualified Text.Parsers.ZParsers.ParsersKernel as PK
import qualified Text.Parsers.ZParsers.ParsersDerived as PD
import qualified Control.Applicative as CA
from Control.Applicative import class Alternative, class Applicative
from Text.Parsers.ZParsers.ParsersKernel import :: Parser, instance Alternative (Parser s t), instance Applicative (Parser s t), instance Functor (Parser s t)
from Text.Parsers.ZParsers.ParsersKernel import :: Parser, instance Alternative (Parser s t), instance pure (Parser s t), instance <*> (Parser s t), instance Functor (Parser s t)
import iTasks.Extensions.GIS.LeafletNavalIcons
import Incidone.OP.Concepts
......
......@@ -55,16 +55,19 @@ where
doAuthenticated :: (User -> Task a) -> Task a | iTask a
doAuthenticated task
= ( enterCredentials
= enterCredentials <<@ (ApplyLayout credentialsLayout)
>>* [OnAction (Action "Login")
(hasValue (\cred -> verifyCredentials cred >>- executeTask task))
] ) <<@ ApplyLayout (beforeStep (sequenceLayouts [setUIAttributes (titleAttr "Login"), frameCompact])) //Compact layout before login, full screen afterwards
]
where
enterCredentials :: Task Credentials
enterCredentials
= viewInformation () [] (DivTag [ClassAttr "identify-app",StyleAttr "width: 350px; height: 55px; margin-bottom: 5px"] [])
||- enterInformation () []
//Compact layout before login, full screen afterwards
credentialsLayout = sequenceLayouts [setUIAttributes (titleAttr "Login"), frameCompact]
verifyCredentials :: Credentials -> Task (Maybe User)
verifyCredentials credentials=:{Credentials|username,password}
| username === Username "admin"
......
......@@ -83,7 +83,6 @@ actorWithInstructions user
editor = fromSVGEditor
{ initView = \((ms2d, _), cl) -> (ms2d, cl)
, renderImage = \((_, network), _) (ms2d`, cl`) -> maps2DImage 'DS'.newSet cl` PickRoomMode ms2d` 'DM'.newMap 'DM'.newMap 'DM'.newMap 'DM'.newMap 'DM'.newMap 'DM'.newMap 'DIS'.newMap {network & devices = 'DM'.newMap}
, updView = \((ms2d, _), cl) _ -> (ms2d, cl)
, updModel = \((_, network), _) (ms2d`, cl`) -> ((ms2d`, network), cl`)
}
......@@ -411,6 +410,5 @@ mkSection
editor = fromSVGEditor
{ initView = const ([], NoAction)
, renderImage = \(((((((((mc3d, network), allDevices), statusMap), sectionUsersMap), userActorMap), invMap), exitLocks), hopLocks), ms2d) _ _ -> map2DImage 'DS'.newSet NoAction WalkAroundMode exitLocks hopLocks invMap statusMap sectionUsersMap userActorMap allDevices network (getFloorIdx mc3d, ms2d !! getFloorIdx mc3d)
, updView = \m v -> v
, updModel = \m v -> m
}
......@@ -200,7 +200,6 @@ where
, renderImage = \((_, act), ((inventoryMap, network), allDevices)) (ms2d, _) _ ->
//TODO above [] [] [margin (px 5.0, px zero) (editLayoutImage act allDevices network inventoryMap idx m2d) \\ m2d <- ms2d & idx <- [0..]] NoHost
above [] [] Nothing [] [margin (px 5.0, px zero) (editLayoutImage act allDevices network inventoryMap idx m2d) \\ m2d <- ms2d & idx <- [0..]] NoHost
, updView = \m v -> fst m
, updModel = \(_,data) newClSt -> (newClSt,data)
}
......
......@@ -157,8 +157,8 @@ sectionImage disabledSections hilite mngmnt zoomed exitLocks hopLocks inventoryM
(Host host)
where
mkStatusBadges :: !SectionStatus !Coord3D !RenderMode !Real ![SectionStatus] -> Image (a, MapAction SectionStatus)
//TODO mkStatusBadges statusMap c3d mngmnt multiplier xs = beside (repeat AtMiddleY) [] ('DL'.reverseTR ('DL'.strictFoldl (mkStatusBadge statusMap c3d mngmnt multiplier) [] xs)) NoHost
mkStatusBadges statusMap c3d mngmnt multiplier xs = beside (repeat AtMiddleY) [] Nothing [] ('DL'.reverseTR ('DL'.strictFoldl (mkStatusBadge statusMap c3d mngmnt multiplier) [] xs)) NoHost
//TODO mkStatusBadges statusMap c3d mngmnt multiplier xs = beside (repeat AtMiddleY) [] ('DL'.reverseTR (foldl (mkStatusBadge statusMap c3d mngmnt multiplier) [] xs)) NoHost
mkStatusBadges statusMap c3d mngmnt multiplier xs = beside (repeat AtMiddleY) [] Nothing [] ('DL'.reverseTR (foldl (mkStatusBadge statusMap c3d mngmnt multiplier) [] xs)) NoHost
doorFill :: !SectionExitLockMap !Coord3D !Dir -> FillAttr a
doorFill exitLocks c3d dir
......
......@@ -437,7 +437,6 @@ where
{ initView = \((((((((((_, ms2d), _), _), _), _), _), _), _), _), cl) -> (ms2d, cl)
, renderImage = \((((((((((disSects, _), exitLocks), hopLocks), inventoryMap), statusMap), sectionUsersMap), userActorMap), network), allDevices), cl) (ms2d`, cl`)
-> maps2DImage disSects cl mode ms2d` exitLocks hopLocks inventoryMap statusMap sectionUsersMap userActorMap allDevices network
, updView = \((((((((((_, ms2d), _), _), _), _), _), _), _), _), cl) _ -> (ms2d, cl)
, updModel = \((((((((((disSects, _), exitLocks), hopLocks), inventoryMap), statusMap), sectionUsersMap), userActorMap), network), allDevices), _) (ms2d`, cl`) -> ((((((((((disSects, ms2d`), exitLocks), hopLocks), inventoryMap), statusMap), sectionUsersMap), userActorMap), network), allDevices), cl`)
}
......@@ -455,7 +454,6 @@ where
{ initView = \((((((((ms2d, _), _), _), _), _), _), _), cl) -> (ms2d, cl)
, renderImage = \((((((((ms2d, exitLocks), hopLocks), inventoryMap), statusMap), actorMap), network), allDevices), cl) (ms2d`, cl`)
-> roomImage c3d exitLocks hopLocks inventoryMap statusMap actorMap allDevices network True (fromJust (getSectionFromMap c3d ms2d`)) (ms2d !! floorIdx) cl`
, updView = \((((((((ms2d, _), _), _), _), _), _), _), cl) _ -> (ms2d, cl)
, updModel = \((((((((_, exitLocks), hopLocks), inventoryMap), statusMap), actorMap), network), allDevices), _) (ms2d`, cl`)
-> ((((((((ms2d`, exitLocks), hopLocks), inventoryMap), statusMap), actorMap), network), allDevices), cl`)
}
......
......@@ -8,7 +8,7 @@ import qualified Text.Parsers.ZParsers.ParsersDerived as PD
import qualified Control.Applicative as CA
from Control.Applicative import class Alternative, class Applicative
from Text.Parsers.ZParsers.ParsersKernel import :: Parser, instance Alternative (Parser p t), instance Applicative (Parser s t), instance Functor (Parser s t)
from Text.Parsers.ZParsers.ParsersKernel import :: Parser, instance Alternative (Parser p t), instance pure (Parser s t), instance <*> (Parser s t), instance Functor (Parser s t)
import C2.Framework.GeoRoutines
import Math.Geometry
import Data.Maybe
......
......@@ -21,8 +21,8 @@ ccMain :: (User -> [User -> Task Entity])
(User -> [(String, User [Entity] -> Task ())])
-> Task ()
ccMain regEntities contBgTasks alwaysOnTasks tlist
= forever (catchAll (( enterChoiceWithShared "Select user" [] users
>>= doUserTask) <<@ ApplyLayout (beforeStep frameCompact))
= forever (catchAll (( enterChoiceWithShared "Select user" [] users <<@ ApplyLayout frameCompact
>>= doUserTask))
(\err -> viewInformation "Error" [] err >>| return ()))
where
doUserTask me = set me currentUser
......
......@@ -77,6 +77,5 @@ derive class iTask Citizen,
Address
instance == Citizen,
Address
instance < (Maybe a) | Ord a,
Citizen,
instance < Citizen,
Address
......@@ -21,7 +21,3 @@ instance == Address where == a1 a2 = a1 === a2
instance == Citizen where == a1 a2 = a1 === a2
instance < Address where < a1 a2 = a1.Address.postcode < a2.Address.postcode
instance < Citizen where < a1 a2 = a1.Citizen.ssn < a2.Citizen.ssn
instance < (Maybe a) | Ord a where < (Just a1) (Just a2) = a1 < a2
< (Just a ) _ = True
< _ (Just a) = False
< _ _ = True
......@@ -16,7 +16,6 @@ ligrettoEditor :: !Color -> UpdateOption GameSt GameSt
ligrettoEditor me = UpdateUsing id (const id) (fromSVGEditor
{ initView = id
, renderImage = const (player_perspective me)
, updView = const id
, updModel = const id
})
......@@ -24,7 +23,6 @@ accoladesEditor :: !Color -> UpdateOption GameSt GameSt
accoladesEditor me = UpdateUsing id (const id) (fromSVGEditor
{ initView = id
, renderImage = const (player_perspective me)
, updView = const id
, updModel = const id
})
......
......@@ -17,7 +17,6 @@ updateTraxEditor :: Bool -> UpdateOption TraxSt TraxSt
updateTraxEditor turn = UpdateUsing id (const id) (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage PlayMode turn
, updView = const id
, updModel = flip const
})
......@@ -25,7 +24,6 @@ viewTraxEditor :: ViewOption TraxSt
viewTraxEditor = ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage ViewMode False
, updView = const id
, updModel = flip const
})
......
......@@ -24,7 +24,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const basic_images
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -19,7 +19,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const box2
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -16,7 +16,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const boxes
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -23,7 +23,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const clean
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -21,7 +21,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const grids
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -24,7 +24,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const linears
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -14,7 +14,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const image
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -23,7 +23,6 @@ Start world
[UpdateUsing id (\_ v = v) (fromSVGEditor
{ initView = id
, renderImage = const count
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -21,7 +21,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const overlays
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -18,7 +18,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const polyline_in_host
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -22,7 +22,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const roses
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -16,7 +16,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const rotates
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -21,7 +21,6 @@ Start world
[ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = const transformed_images
, updView = \m _ = m
, updModel = \_ v = v
})] 0) world
......
......@@ -28,7 +28,6 @@ import
, iTasks.WF.Combinators.Common
// Custom task GUI's
, iTasks.UI.Tune
, iTasks.UI.Editor.Controls
, iTasks.UI.Editor.Containers
, iTasks.UI.Editor.Modifiers
......
......@@ -169,7 +169,6 @@ showBlueprintInstance rs bpi selDetail enabledSteps compact depth
editor outputs` = fromSVGEditor
{ initView = id
, renderImage = \_ -> mkTaskInstanceImage rs bpi outputs` enabledSteps selDetail compact
, updView = \_ x -> x
, updModel = \x _ -> x
}
......@@ -187,7 +186,6 @@ showStaticBlueprint rs bpref task compact depth
editor = fromSVGEditor
{ initView = id
, renderImage = \_ -> mkStaticImage rs bpref compact
, updView = \_ x -> x
, updModel = \x _ -> x
}
......
......@@ -120,8 +120,8 @@ loginAndManageWork welcome
viewInformation ("Guest access","Alternatively, you can continue anonymously as guest user") [] ()
>>| (return Nothing)
] <<@ ApplyLayout (setUIAttributes (directionAttr Horizontal)))
)
>>- browse) <<@ ApplyLayout (beforeStep layout) //Compact layout before login, full screen afterwards
) <<@ ApplyLayout layout
>>- browse) //Compact layout before login, full screen afterwards
) <<@ ApplyLayout (setUIAttributes (titleAttr welcome))
where
browse (Just {Credentials|username,password})
......
......@@ -8,7 +8,6 @@ import iTasks.UI.JS.Encoding
:: SVGEditor m v =
{ initView :: m -> v // Initialize a 'view' value that holds temporary data while editing
, renderImage :: m v *TagSource -> Image` v // Render an interactive image that
, updView :: m v -> v // When the model is externally updated, the view needs to be updated too
, updModel :: m v -> m // When the view is updated (using the image), the change needs to be merged back into the view
}
......
......@@ -7,8 +7,9 @@ from StdFunc import o
import Data.List, Data.GenEq, Data.Func
import Data.Error
import Data.MapCollection
from Data.Foldable import class Foldable (foldr`)
from Data.Map import :: Map, instance Functor (Map k)
from Data.Set import :: Set, instance == (Set a), instance < (Set a)
from Data.Set import :: Set, instance == (Set a), instance < (Set a), instance Foldable Set
import qualified Data.Map as DM
import qualified Data.Set as DS
import Text
......@@ -229,7 +230,7 @@ where
, ("x", "-10000")
, ("y", "-10000")
]
#! world = strictFoldl (\world args -> snd ((elem `setAttribute` args) world)) world fontAttrs
#! world = foldl (\world args -> snd ((elem `setAttribute` args) world)) world fontAttrs
#! (fd, world) = calcFontDescent elem fontdef.fontysize world
= ('DM'.put fontdef fd font_spans, world)
......@@ -265,8 +266,8 @@ where
, ("x", "-10000")
, ("y", "-10000")
]
#! world = strictFoldl (\world args -> snd ((elem `setAttribute` args) world)) world fontAttrs
#! (ws, world) = 'DS'.fold (calcTextLength elem) ('DM'.newMap, world) strs
#! world = foldl (\world args -> snd ((elem `setAttribute` args) world)) world fontAttrs
#! (ws, world) = foldr` (calcTextLength elem) ('DM'.newMap, world) strs
= ('DM'.alter (merge ws) fontdef text_spans, world)
where
merge :: !(Map String TextSpan) !(Maybe (Map String TextSpan)) -> Maybe (Map String TextSpan)
......
......@@ -95,11 +95,11 @@ mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -
mkInstantTask iworldfun = Task (evalOnce iworldfun)
where
evalOnce f event repOpts (TCInit taskId ts) iworld = case f taskId iworld of
(Ok a,iworld) = (ValueResult (Value a True) {lastEvent=ts,removedTasks=[],refreshSensitive=False} (rep event) (TCStable taskId ts (DeferredJSON a)), iworld)
(Ok a,iworld) = (ValueResult (Value a True) {lastEvent=ts,attributes='DM'.newMap,removedTasks=[]} (rep event) (TCStable taskId ts (DeferredJSON a)), iworld)
(Error e, iworld) = (ExceptionResult e, iworld)
evalOnce f event repOpts state=:(TCStable taskId ts enc) iworld = case fromJSONOfDeferredJSON enc of
Just a = (ValueResult (Value a True) {lastEvent=ts,removedTasks=[],refreshSensitive=False} (rep event) state, iworld)
Just a = (ValueResult (Value a True) {lastEvent=ts,attributes='DM'.newMap,removedTasks=[]} (rep event) state, iworld)
Nothing = (ExceptionResult (exception "Corrupt task result"), iworld)
evalOnce f _ _ (TCDestroy _) iworld = (DestroyedResult,iworld)
......
......@@ -3,14 +3,15 @@ definition module iTasks.Internal.TaskEval
* This module provides functions for creation, evaluation and removal of task/workflow instances.
*/
from iTasks.WF.Definition import :: Task, :: TaskResult, :: TaskException, :: TaskValue, :: Event, :: TaskId, :: InstanceNo
from iTasks.WF.Definition import :: Task, :: TaskResult, :: TaskException, :: TaskValue, :: TaskAttributes, :: Event, :: TaskId, :: InstanceNo
from iTasks.WF.Combinators.Core import :: TaskListItem
from iTasks.Internal.IWorld import :: IWorld
from iTasks.Internal.SDS import :: SDS, :: Shared, :: ReadOnlyShared
from iTasks.Internal.Tonic import :: ExprId
from iTasks.Internal.TaskState import :: DeferredJSON
from Text.GenJSON import :: JSONNode
from Data.Maybe import :: Maybe
from Data.Maybe import :: Maybe
from Data.Map import :: Map
from Data.Error import :: MaybeErrorString, :: MaybeError
from Data.CircularStack import :: CircularStack
......@@ -38,9 +39,9 @@ defaultTonicOpts :: TonicOpts
//Additional information passed up from the tree when evaluating a task
:: TaskEvalInfo =
{ lastEvent :: !TaskTime //When was the last edit, action or focus event in this task
{ lastEvent :: !TaskTime //When was the last event in this task
, attributes :: !TaskAttributes //Meta-data annotations on the task
, removedTasks :: ![(TaskId,TaskId)] //Which embedded parallel tasks were removed (listId,taskId)
, refreshSensitive :: !Bool //Can refresh events change the value or ui of this task (e.g. because shared data is read)
}
:: TaskTime :== Int
......
......@@ -59,18 +59,19 @@ derive JSONDecode TIMeta, TIReduct, TaskTree
| UIException !String //An unhandled exception occurred and the UI should only show the error message
:: TaskTree
= TCInit !TaskId !TaskTime //Initial state for all tasks
| TCBasic !TaskId !TaskTime !DeferredJSON !Bool //Encoded value and stable indicator
| 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
| TCShared !TaskId !TaskTime !TaskTree
| TCAttach !TaskId !TaskTime !AttachmentStatus !String !String
| TCExposedShared !TaskId !TaskTime !String !TaskTree // +URL //TODO: Remove
| TCStable !TaskId !TaskTime !DeferredJSON
| TCLayout !(!LUI,!LUIMoves) !TaskTree
| TCNop
| TCDestroy !TaskTree //Marks a task state as garbage that must be destroyed (TODO: replace by explicit event
= TCInit !TaskId !TaskTime //Initial state for all tasks
| TCBasic !TaskId !TaskTime !DeferredJSON !Bool //Encoded value and stable indicator
| 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
| TCShared !TaskId !TaskTime !TaskTree
| TCAttach !TaskId !TaskTime !AttachmentStatus !String !String
| TCStable !TaskId !TaskTime !DeferredJSON
| TCLayout !(!LUI,!LUIMoves) !TaskTree
| TCAttribute !TaskId !String !TaskTree
| TCNop
| TCDestroy !TaskTree //Marks a task state as garbage that must be destroyed (TODO: replace by explicit event)
| TCExposedShared !TaskId !TaskTime !String !TaskTree // +URL //TODO: Remove
taskIdFromTaskTree :: TaskTree -> MaybeError TaskException TaskId
......
......@@ -18,7 +18,6 @@ derive JSONDecode TIMeta, TIValue, TIReduct, TaskTree, ParallelTaskState, Parall
derive JSONEncode LUI, LUIChanges, LUIEffects, LUIEffectStage, LUINo, Set
derive JSONDecode LUI, LUIChanges, LUIEffects, LUIEffectStage, LUINo, Set
instance toString DeferredJSON where
toString (DeferredJSON x) = toString $ toJSON x
toString (DeferredJSONNode json) = toString json
......@@ -45,16 +44,17 @@ gEq{|DeferredJSON|} x y = toJSON x === toJSON y
gText{|DeferredJSON|} f djson = gText{|*|} f $ toJSON <$> djson
taskIdFromTaskTree :: TaskTree -> MaybeError TaskException TaskId
taskIdFromTaskTree (TCInit taskId _) = Ok taskId
taskIdFromTaskTree (TCBasic taskId _ _ _) = Ok taskId
taskIdFromTaskTree (TCInteract taskId _ _ _ _ _) = Ok taskId
taskIdFromTaskTree (TCStep taskId _ _) = Ok taskId
taskIdFromTaskTree (TCParallel taskId _ _ _) = Ok taskId
taskIdFromTaskTree (TCShared taskId _ _) = Ok taskId
taskIdFromTaskTree (TCAttach taskId _ _ _ _) = Ok taskId
taskIdFromTaskTree (TCExposedShared taskId _ _ _) = Ok taskId
taskIdFromTaskTree (TCStable taskId _ _) = Ok taskId
taskIdFromTaskTree (TCLayout _ tt) = taskIdFromTaskTree tt
taskIdFromTaskTree (TCNop) = Error (exception "Unable to obtain TaskId from TaskTree (TCNop)")
taskIdFromTaskTree (TCDestroy tt) = taskIdFromTaskTree tt
taskIdFromTaskTree (TCInit taskId _) = Ok taskId
taskIdFromTaskTree (TCBasic taskId _ _ _) = Ok taskId
taskIdFromTaskTree (TCInteract taskId _ _ _ _ _) = Ok taskId
taskIdFromTaskTree (TCStep taskId _ _) = Ok taskId
taskIdFromTaskTree (TCParallel taskId _ _ _) = Ok taskId
taskIdFromTaskTree (TCShared taskId _ _) = Ok taskId
taskIdFromTaskTree (TCAttach taskId _ _ _ _) = Ok taskId
taskIdFromTaskTree (TCExposedShared taskId _ _ _) = Ok taskId
taskIdFromTaskTree (TCStable taskId _ _) = Ok taskId
taskIdFromTaskTree (TCLayout _ tt) = taskIdFromTaskTree tt
taskIdFromTaskTree (TCAttribute taskId _ _) = Ok taskId
taskIdFromTaskTree (TCNop) = Error (exception "Unable to obtain TaskId from TaskTree (TCNop)")
taskIdFromTaskTree (TCDestroy tt) = taskIdFromTaskTree tt
......@@ -4,7 +4,7 @@ from iTasks.Internal.SDS import :: Shared, :: ReadWriteShared, :: RWShared
from iTasks.Internal.IWorld import :: IWorld
from iTasks.Internal.Task import :: TaskEvalOpts, :: TaskResult
from iTasks.WF.Definition import :: Task, :: InstanceNo, class iTask
from iTasks.UI.Tune import class tune
from iTasks.WF.Combinators.Tune import class tune
from iTasks.SDS.Definition import :: SDS
import iTasks.Internal.Tonic.AbsSyn
......
......@@ -269,7 +269,7 @@ tLam inh vars e tsrc
[] -> [ tHorizConnArr (fillColorFromStatStab (r.syn_status, r.syn_stability))
, r.syn_img]
vars -> [ tHorizConn (fillColorFromStatStab (r.syn_status, r.syn_stability))
, tTextWithGreyBackground ArialRegular10px (strictFoldr (\x xs -> x +++ " " +++ xs) "" vars)
, tTextWithGreyBackground ArialRegular10px (foldr (\x xs -> x +++ " " +++ xs) "" vars)
, tHorizConnArr (fillColorFromStatStab (r.syn_status, r.syn_stability))
, r.syn_img]
#! img = beside (repeat AtMiddleY) [] Nothing [] lineParts NoHost
......@@ -482,7 +482,7 @@ tLet inh pats expr [(txttag, uTxtTag) : tsrc]
_
#! (t, tsrc) = tExpr2Image inh expr tsrc
#! (patRhss, tsrc) = strictTRMapSt (tExpr2Image inh) (map snd pats) tsrc
#! binds = strictFoldr (\(var, expr) acc -> [text ArialRegular10px (ppTExpr var) : text ArialRegular10px " = " : expr.syn_img : acc]) [] (strictTRZip2 (strictTRMap fst pats) patRhss)
#! binds = foldr (\(var, expr) acc -> [text ArialRegular10px (ppTExpr var) : text ArialRegular10px " = " : expr.syn_img : acc]) [] (strictTRZip2 (strictTRMap fst pats) patRhss)
#! letText = tag uTxtTag ('GS'.grid (Columns 3) (RowMajor, LeftToRight, TopToBottom) [] [] [] [] binds NoHost)
#! letWidth = imagexspan txttag + px 8.0
#! letHeight = imageyspan txttag + px 8.0
......@@ -928,7 +928,7 @@ tAssign inh lhsExpr assignedTask [(assignTaskTag, uAssignTaskTag) : (headerTag,
mkUser (TFApp _ "UserWithRole" [r:_] _) = "Anyone with role " +++ ppTExpr r
mkUser (TFApp _ "SystemUser" _ _) = "System user"
mkUser (TFApp _ "AnonymousUser" _ _) = "Anonymous user"
mkUser (TFApp _ "AuthenticatedUser" [uid:rs:_] _) = ppTExpr uid +++ " with roles " +++ strictFoldr (\x xs -> ppTExpr x +++ " " +++ xs) "" (tSafeExpr2List rs)
mkUser (TFApp _ "AuthenticatedUser" [uid:rs:_] _) = ppTExpr uid +++ " with roles " +++ foldr (\x xs -> ppTExpr x +++ " " +++ xs) "" (tSafeExpr2List rs)
mkUser (TFApp _ usr _ _) = usr
mkUser (TVar _ ppe _) = ppe
mkUser (TLit (TString ppe)) = ppe
......@@ -974,7 +974,7 @@ tSafeExpr2List e = [e]
tStepCont :: ![UI] !(InhMkImg i) !TExpr !*TagSource -> *(!SynMkImg, !*TagSource) | BlueprintLike i
tStepCont actions inh (TFApp _ "OnAction" [TFApp _ "Action" [actionLit : _] _ : cont : _ ] _) tsrc
= mkStepCont inh (Just (ppTExpr actionLit, strictFoldr f False actions)) cont tsrc
= mkStepCont inh (Just (ppTExpr actionLit, foldr f False actions)) cont tsrc
where
f ui acc = (replaceSubString "\"" "" (an ui) == replaceSubString "\"" "" (ppTExpr actionLit) && enabled ui) || acc
where
......@@ -1070,7 +1070,7 @@ stepIfStableUnstableHasValue inh mact filter [TLam pats e : _] [ref : tsrc]
#! pats = filterLamVars pats
#! imgs2 = if (length pats > 0)
[ addAction mact (tHorizConn (stepArrActivity inh syn_e)) ref
, tTextWithGreyBackground ArialRegular10px (strictFoldr (\x xs -> ppTExpr x +++ " " +++ xs) "" pats)]
, tTextWithGreyBackground ArialRegular10px (foldr (\x xs -> ppTExpr x +++ " " +++ xs) "" pats)]
[addAction mact (tShortHorizConn (stepArrActivity inh syn_e)) ref]
#! imgs3 = [ tHorizConnArr (stepArrActivity inh syn_e)
, syn_e.syn_img
......@@ -1188,7 +1188,7 @@ tBranches inh mkBranch needAllDone inclVertConns exprs contextTag tsrc
| otherwise
#! firstTag = hd ts
#! lastTag = last ts
#! allYSpans = strictFoldl (\acc x -> imageyspan x + acc) (px 0.0) ts
#! allYSpans = foldl (\acc x -> imageyspan x + acc) (px 0.0) ts
#! halfFirstY = imageyspan firstTag /. 2.0
#! halfLastY = imageyspan lastTag /. 2.0
= above (repeat AtMiddleX) [] Nothing []
......@@ -1284,9 +1284,3 @@ strictTRZipWith3Acc :: !(a b c -> d) ![a] ![b] ![c] ![d] -> [d]
strictTRZipWith3Acc f [a:as] [b:bs] [c:cs] acc
= strictTRZipWith3Acc f as bs cs [f a b c : acc]
strictTRZipWith3Acc _ _ _ _ acc = acc
strictFoldl :: !(.a -> .(.b -> .a)) !.a ![.b] -> .a
strictFoldl f b [] = b
strictFoldl f b [x:xs]
#! r = f b x
= strictFoldl f r xs