Commit b046b766 authored by Bas Lijnse's avatar Bas Lijnse

Removed intermediate serialization of layout state in the task tree

parent 11e97ff5
......@@ -12,6 +12,7 @@ import iTasks.WF.Definition
import iTasks.WF.Tasks.IO
from iTasks.WF.Combinators.Core import :: AttachmentStatus
import iTasks.UI.Editor, iTasks.UI.Editor.Common
from iTasks.UI.Layout import :: LUI, :: LUIMoves, :: LUIMoveID
from iTasks.Internal.TaskState import :: TaskTree(..), :: DeferredJSON(..), :: TIMeta(..)
from iTasks.Internal.TaskEval import :: TaskEvalInfo(..)
......
......@@ -7,6 +7,7 @@ from iTasks.WF.Definition import :: InstanceNo, :: InstanceKey, :: InstanceProgr
from iTasks.WF.Combinators.Core import :: AttachmentStatus
from iTasks.UI.Definition import :: UIChange
from iTasks.UI.Editor import :: EditMask
from iTasks.UI.Layout import :: LUI, :: LUIMoves, :: LUIMoveID
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Data.Map import :: Map
from Data.Maybe import :: Maybe
......@@ -67,7 +68,8 @@ derive JSONDecode TIMeta, TIReduct, TaskTree
| TCAttach !TaskId !TaskTime !AttachmentStatus !String !String
| TCExposedShared !TaskId !TaskTime !String !TaskTree // +URL //TODO: Remove
| TCStable !TaskId !TaskTime !DeferredJSON
| TCLayout !DeferredJSON !TaskTree
//| TCLayout !DeferredJSON !TaskTree
| TCLayout !(!LUI,!LUIMoves) !TaskTree
| TCNop
| TCDestroy !TaskTree //Marks a task state as garbage that must be destroyed (TODO: replace by explicit event
......
implementation module iTasks.Internal.TaskState
import Text.GenJSON, StdString, Data.Func, Data.GenEq, Data.Maybe, Data.Functor
import iTasks.UI.Definition
import iTasks.UI.Definition, iTasks.UI.Layout
import iTasks.WF.Definition
from iTasks.WF.Combinators.Core import :: AttachmentStatus
......@@ -15,6 +15,10 @@ import Data.Error, Data.Either
derive JSONEncode TIMeta, TIValue, TIReduct, TaskTree, ParallelTaskState, ParallelTaskChange, TaskResult, TaskEvalInfo, TonicOpts, CircularStack
derive JSONDecode TIMeta, TIValue, TIReduct, TaskTree, ParallelTaskState, ParallelTaskChange, TaskResult, TaskEvalInfo, TonicOpts, CircularStack
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
......
......@@ -20,12 +20,7 @@ from iTasks.WF.Combinators.Core import :: AttachmentStatus
import iTasks.WF.Definition
import Data.GenEq
//This type records the states of layouts applied somewhere in a ui tree
derive JSONEncode LUI, LUIChanges, LUIEffects, LUIEffectStage, LUINo, Set
derive JSONDecode LUI, LUIChanges, LUIEffects, LUIEffectStage, LUINo, Set
derive gEq LUIEffectStage, LUINo
derive gLexOrd LUIEffectStage
instance < (LUIEffectStage a) | gLexOrd{|*|} a
......
......@@ -31,6 +31,7 @@ where
tune (ApplyLayout l) task = applyLayout l task
applyLayout :: LayoutRule (Task a) -> Task a
//applyLayout rule task=:(Task evala) = task
applyLayout rule task=:(Task evala) = Task eval
where
ruleNo = LUINo [0]
......@@ -39,39 +40,37 @@ applyLayout rule task=:(Task evala) = Task eval
= evala event evalOpts (TCDestroy tt) iworld
eval event evalOpts tt=:(TCInit _ _) iworld
= eval ResetEvent evalOpts (TCLayout (DeferredJSONNode JSONNull) tt) iworld //On initialization, we need to do a reset to be able to apply the layout
//On initialization, we need to do a reset to be able to apply the layout
= eval ResetEvent evalOpts (TCLayout (initLUI (ui UIEmpty),initLUIMoves) tt) iworld
//On Reset events, we (re-)apply the layout
eval ResetEvent evalOpts (TCLayout _ tt) iworld = case evala ResetEvent evalOpts tt iworld of
(ValueResult value info (ReplaceUI ui) tt,iworld)
# (change,state) = extractResetChange (rule ruleNo (initLUI ui, initLUIMoves))
//| not (trace_tn ("STATE AFTER RESET: \n"+++toString (toJSON state))) = undef
= (ValueResult value info change (TCLayout (DeferredJSON state) tt), iworld)
= (ValueResult value info change (TCLayout state tt), iworld)
(res,iworld) = (res,iworld)
eval event evalOpts (TCLayout json tt) iworld = case evala event evalOpts tt iworld of
eval event evalOpts (TCLayout state1 tt) iworld = case evala event evalOpts tt iworld of
(ValueResult value info change tt,iworld)
= case fromDeferredJSON json of
(Just state1)
//| not (trace_tn ("UPSTREAM CHANGE: \n"+++toString (toJSON change))) = undef
//| not (trace_tn ("STATE BEFORE CHANGE: \n"+++toString (toJSON state1))) = undef
# state2 = applyUpstreamChange change state1
//| not (trace_tn ("STATE AFTER CHANGE: \n"+++toString (toJSON state2))) = undef
# state3 = rule ruleNo state2
//| not (trace_tn ("STATE AFTER RULES: \n"+++toString (toJSON state3))) = undef
# (change,state4) = extractDownstreamChange state3
//| not (trace_tn ("STATE AFTER EXTRACT: \n"+++toString (toJSON state4))) = undef
//| not (trace_tn ("DOWNSTREAM CHANGE: \n"+++toString (toJSON change))) = undef
//| not (trace_tn "=====") = undef
| not (fullyApplied_ state4)
# iworld = traceState "state-before-change.txt" state1 iworld
# iworld = traceState "state-after-change.txt" state2 iworld
# iworld = traceState "state-after-rules.txt" state3 iworld
# iworld = traceState "state-after-extract.txt" state4 iworld
= (ExceptionResult (exception ("Corrupt layout state")), iworld)
= (ValueResult value info change (TCLayout (DeferredJSON state4) tt), iworld)
Nothing
= (ExceptionResult (exception ("Corrupt layout state:" +++ toString json)), iworld)
//| not (trace_tn ("UPSTREAM CHANGE: \n"+++toString (toJSON change))) = undef
//| not (trace_tn ("STATE BEFORE CHANGE: \n"+++toString (toJSON state1))) = undef
# state2 = applyUpstreamChange change state1
//| not (trace_tn ("STATE AFTER CHANGE: \n"+++toString (toJSON state2))) = undef
# state3 = rule ruleNo state2
//| not (trace_tn ("STATE AFTER RULES: \n"+++toString (toJSON state3))) = undef
# (change,state4) = extractDownstreamChange state3
//| not (trace_tn ("STATE AFTER EXTRACT: \n"+++toString (toJSON state4))) = undef
//| not (trace_tn ("DOWNSTREAM CHANGE: \n"+++toString (toJSON change))) = undef
//| not (trace_tn "=====") = undef
| not (fullyApplied_ state4)
# iworld = traceState "state-before-change.txt" state1 iworld
# iworld = traceState "state-after-change.txt" state2 iworld
# iworld = traceState "state-after-rules.txt" state3 iworld
# iworld = traceState "state-after-extract.txt" state4 iworld
= (ExceptionResult (exception ("Corrupt layout state")), iworld)
| otherwise
= (ValueResult value info change (TCLayout state4 tt), iworld)
(res,iworld) = (res,iworld)
eval event evalOpts state iworld = evala event evalOpts state iworld //Catchall
......
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