Commit 32c7c4bf authored by Bas Lijnse's avatar Bas Lijnse

More refactoring:

- Renamed record field 'world' in HSt to 'nworld'
- Renamed record field 'worldC' in NWorld to 'world'
- Moved Exception combinators to the 'TaskCombinators' directory

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@365 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 433749f0
......@@ -14,7 +14,7 @@ from StdFile import class FileSystem
, prefix :: !String // global prefix used in all generated html id's
, request :: !HTTPRequest // to enable access to the current HTTP request
, states :: !*FormStates // all form states are collected here ...
, world :: *NWorld // to enable all kinds of I/O
, nworld :: *NWorld // to enable all kinds of I/O
}
// Definitions on HSt
......
......@@ -8,32 +8,32 @@ import iDataState
// Enabling file IO on HSt
instance FileSystem HSt where
fopen string int hst=:{world}
# (bool,file,world) = fopen string int world
= (bool,file,{hst & world = world})
fopen string int hst=:{nworld}
# (bool,file,nworld) = fopen string int nworld
= (bool,file,{hst & nworld = nworld})
fclose file hst=:{world}
# (bool,world) = fclose file world
= (bool,{hst & world = world})
fclose file hst=:{nworld}
# (bool,nworld) = fclose file nworld
= (bool,{hst & nworld = nworld})
stdio hst=:{world}
# (file,world) = stdio world
= (file,{hst & world = world})
stdio hst=:{nworld}
# (file,nworld) = stdio nworld
= (file,{hst & nworld = nworld})
sfopen string int hst=:{world}
# (bool,file,world) = sfopen string int world
= (bool,file,{hst & world = world})
sfopen string int hst=:{nworld}
# (bool,file,nworld) = sfopen string int nworld
= (bool,file,{hst & nworld = nworld})
//Access to the NWorld state embedded in the HSt
appNWorldHSt :: !.(*NWorld -> *NWorld) !*HSt -> *HSt
appNWorldHSt f hst=:{world}
= {hst & world = f world}
appNWorldHSt f hst=:{nworld}
= {hst & nworld = f nworld}
accNWorldHSt :: !.(*NWorld -> *(.a,*NWorld)) !*HSt -> (.a,!*HSt)
accNWorldHSt f hst=:{world}
# (a, world) = f world
= (a, {hst & world = world})
accNWorldHSt f hst=:{nworld}
# (a, nworld) = f nworld
= (a, {hst & nworld = nworld})
// General access to the World environment on HSt:
appWorldHSt :: !.(*World -> *World) !*HSt -> *HSt
......@@ -44,7 +44,7 @@ accWorldHSt f hst = (accNWorldHSt o accWorldNWorld) f hst
// Create a new HSt
mkHSt :: String HTTPRequest *FormStates *NWorld -> *HSt
mkHSt prefix request states nworld = {cntr=0, prefix = prefix, states=states, request= request, world=nworld }
mkHSt prefix request states nworld = {cntr = 0, prefix = prefix, states = states, request = request, nworld = nworld }
// Access on the HSt structure
getHStCntr :: !*HSt -> (!Int,!*HSt)
......@@ -65,14 +65,14 @@ setHStPrefix s hst = {hst & prefix = s}
// All IData objects administrated in the state satisfying the predicate will be deleted, no matter where they are stored.
deleteIData :: !String !*HSt -> *HSt
deleteIData prefix hst=:{states,world}
# (states,world) = deleteStates prefix states world
= {hst & states = states, world = world}
deleteIData prefix hst=:{states,nworld}
# (states,nworld) = deleteStates prefix states nworld
= {hst & states = states, nworld = nworld}
changeLifespanIData :: !String !Lifespan !Lifespan !*HSt -> *HSt
changeLifespanIData prefix oldspan newspan hst=:{states,world}
# (states,world) = changeLifetimeStates prefix oldspan newspan states world
= {hst & states = states, world = world}
changeLifespanIData prefix oldspan newspan hst=:{states,nworld}
# (states,nworld) = changeLifetimeStates prefix oldspan newspan states nworld
= {hst & states = states, nworld = nworld}
getChangedId :: !*HSt -> ([String],!*HSt) // id of form that has been changed by user
getChangedId hst=:{states}
......@@ -80,9 +80,9 @@ getChangedId hst=:{states}
= (ids,{hst & states = states })
storeStates :: !*HSt -> *HSt
storeStates hst =: {states, world}
# (states,world) = storeServerStates states world
= {hst & states = states, world = world}
storeStates hst =: {states, nworld}
# (states,nworld) = storeServerStates states nworld
= {hst & states = states, nworld = nworld}
getPageStates :: !*HSt -> (![HtmlState], !*HSt)
getPageStates hst =: {states}
......
......@@ -9,7 +9,7 @@ from Gerda import :: Gerda
from DataFile import :: DataFile
from UserDB import :: UserDB
:: *NWorld = { worldC :: *World // world for any io
:: *NWorld = { world :: *World // world for any io
, gerda :: *Gerda // to read and write to a relational database
, datafile :: *DataFile // to read and write to a Clean database in a file
, userdb :: *UserDB // to retrieve identity information
......
......@@ -6,34 +6,34 @@ from DataFile import :: DataFile
from UserDB import :: UserDB
instance FileSystem NWorld where
fopen string int nworld=:{worldC}
# (bool,file,worldC) = fopen string int worldC
= (bool,file,{nworld & worldC = worldC})
fopen string int nworld=:{world}
# (bool,file,world) = fopen string int world
= (bool,file,{nworld & world = world})
fclose file nworld=:{worldC}
# (bool,worldC) = fclose file worldC
= (bool,{nworld & worldC = worldC})
fclose file nworld=:{world}
# (bool,world) = fclose file world
= (bool,{nworld & world = world})
stdio nworld=:{worldC}
# (file,worldC) = stdio worldC
= (file,{nworld & worldC = worldC})
stdio nworld=:{world}
# (file,world) = stdio world
= (file,{nworld & world = world})
sfopen string int nworld=:{worldC}
# (bool,file,worldC) = sfopen string int worldC
= (bool,file,{nworld & worldC = worldC})
sfopen string int nworld=:{world}
# (bool,file,world) = sfopen string int world
= (bool,file,{nworld & world = world})
mkNWorld :: *World *DataFile *Gerda *UserDB -> *NWorld
mkNWorld world datafile gerda userdb = {worldC = world, gerda = gerda, datafile = datafile, userdb = userdb}
mkNWorld world datafile gerda userdb = {world = world, gerda = gerda, datafile = datafile, userdb = userdb}
appWorldNWorld :: !.(*World -> *World) !*NWorld -> *NWorld
appWorldNWorld f nw=:{worldC}
= {nw & worldC=f worldC}
appWorldNWorld f nw=:{world}
= {nw & world=f world}
accWorldNWorld :: !.(*World -> *(.a,*World)) !*NWorld -> (.a,!*NWorld)
accWorldNWorld f nw=:{worldC}
# (a,worldC) = f worldC
= (a,{nw & worldC=worldC})
accWorldNWorld f nw=:{world}
# (a,world) = f world
= (a,{nw & world=world})
appUserDBNWorld :: !.(*UserDB -> *UserDB) !*NWorld -> *NWorld
appUserDBNWorld f nw=:{userdb}
......
......@@ -26,16 +26,16 @@ gPrint{|(->)|} gArg gRes _ _ = abort "functions can only be used with dynamic st
// TODO: Try to make it do just a little less :)
mkViewForm :: !(InIDataId d) !(HBimap d v) !*HSt -> (Form d,!*HSt) | iData v
mkViewForm (init,formid) bm=:{toForm, updForm, fromForm, resetForm} hst=:{prefix, request,states,world}
mkViewForm (init,formid) bm=:{toForm, updForm, fromForm, resetForm} hst=:{HSt | prefix, request,states, nworld}
| init == Const && formid.FormId.lifespan <> LSTemp
= mkViewForm (init,{FormId| formid & lifespan = LSTemp}) bm hst // constant i-data are never stored
| init == Const // constant i-data, no look up of previous value
= calcnextView False Nothing states world
# (isupdated,view,states,world) = findFormInfo vformid states world // determine current view value in the state store
= calcnextView isupdated view states world // and calculate new i-data
= calcnextView False Nothing states nworld
# (isupdated,view,states,nworld) = findFormInfo vformid states nworld // determine current view value in the state store
= calcnextView isupdated view states nworld // and calculate new i-data
where
vformid = reuseFormId formid (toForm init formid.ival Nothing)
calcnextView isupdated view states world
calcnextView isupdated view states nworld
# (changedids,states) = getUpdatedIds states
# changed = {isChanged = isupdated, changedId = changedids}
# view = toForm init formid.ival view // map value to view domain, given previous view value
......@@ -46,48 +46,48 @@ where
Just reset -> reset view
| formid.mode == NoForm // don't make a form at all
# (states,world) = replaceState` vformid view states world // store new value into the store of states
# (states,nworld) = replaceState` vformid view states nworld // store new value into the store of states
= ({ changed = False
, value = newval
, form = []
, inputs = []
}
, mkHSt prefix request states world)
, mkHSt prefix request states nworld)
# (viewform,{states,world}) // make a form for it
= mkForm (init,if (init == Const) vformid (reuseFormId formid view)) (mkHSt prefix request states world)
# (viewform,{states,nworld}) // make a form for it
= mkForm (init,if (init == Const) vformid (reuseFormId formid view)) (mkHSt prefix request states nworld)
| viewform.changed && not isupdated // important: redo it all to handle the case that a user defined specialisation is updated !!
= calcnextView True (Just viewform.Form.value) states world
= calcnextView True (Just viewform.Form.value) states nworld
# (states,world) = replaceState` vformid viewform.Form.value states world // store new value into the store of states
# (states,nworld) = replaceState` vformid viewform.Form.value states nworld // store new value into the store of states
= ( { changed = isupdated
, value = newval
, form = viewform.form
, inputs = viewform.inputs
}
,mkHSt prefix request states world)
,mkHSt prefix request states nworld)
replaceState` vformid view states world
| init <> Const = setState vformid view states world
| otherwise = (states,world)
replaceState` vformid view states nworld
| init <> Const = setState vformid view states nworld
| otherwise = (states,nworld)
findFormInfo formid formStates world
findFormInfo formid formStates nworld
# (updateids,formStates) = getUpdatedIds formStates // get list of updated id's
| not (isMember formid.id updateids)
# (bool,justcurstate,formStates,world) = getState formid formStates world // the current form is not updated
= (False,justcurstate,formStates,world)
# (bool,justcurstate,formStates,nworld) = getState formid formStates nworld // the current form is not updated
= (False,justcurstate,formStates,nworld)
# (updates,formStates) = getFormUpdates formid.id formStates // get my updates
= case (getState formid formStates world) of
(False,Just currentState,formStates,world) -> (False, Just currentState,formStates,world) // yes, but update already handled
(True, Just currentState,formStates,world) -> (updateState updates currentState formStates world) // yes, handle update
(_, Nothing,formStates,world) -> (False, Nothing,formStates,world) // cannot find previously stored state
= case (getState formid formStates nworld) of
(False,Just currentState,formStates,nworld) -> (False, Just currentState,formStates,nworld) // yes, but update already handled
(True, Just currentState,formStates,nworld) -> (updateState updates currentState formStates nworld) // yes, handle update
(_, Nothing,formStates,nworld) -> (False, Nothing,formStates,nworld) // cannot find previously stored state
updateState updates currentState formStates world
updateState updates currentState formStates nworld
# allUpdates = [(inputid, value) \\ {FormUpdate | inputid,value} <- updates]
# newState = applyUpdates (sortUpdates allUpdates) currentState
= (True, Just newState, formStates,world)
= (True, Just newState, formStates,nworld)
sortUpdates updates = sortBy (\(i1,v1) (i2,v2) -> i2 < i1) updates // updates need to be applied in descending order
// of input id's
......@@ -100,7 +100,7 @@ where
// The value might have been changed with this editor, so the value returned might differ from the value you started with!
specialize :: !((InIDataId a) *HSt -> (Form a,*HSt)) !(InIDataId a) !*HSt -> (!Form a,!*HSt) | gUpd {|*|} a
specialize editor (init,formid) hst=:{cntr = inidx,states = formStates,world}
specialize editor (init,formid) hst=:{cntr = inidx,states = formStates, nworld}
# nextidx = incrIndex inidx formid.ival // this value will be repesented differently, so increment counter
# (nv,hst) = editor (init,nformid) (setHStCntr 0 hst)
= (nv,setHStCntr nextidx hst)
......@@ -487,7 +487,7 @@ toHtml a
# (na,_) = mkForm (Set,mkFormId "__toHtml" a <@ Display) (mkHSt "" http_emptyRequest (mkFormStates [] []) dummy)
= BodyTag [] na.form
where
dummy = { worldC = abort "dummy world for toHtml!\n"
dummy = { world = abort "dummy world for toHtml!\n"
, gerda = abort "dummy gerda for toHtml!\n"
, datafile = abort "dummy datafile for toHtml!\n"
, userdb = abort "dummy userdb for toHtml!\n"
......@@ -498,7 +498,7 @@ toHtmlForm anyform
# (na,hst) = anyform (mkHSt "" http_emptyRequest (mkFormStates [] []) (abort "illegal call to toHtmlForm!\n"))
= na.form
where
dummy = { worldC = abort "dummy world for toHtmlForm!\n"
dummy = { world = abort "dummy world for toHtmlForm!\n"
, gerda = abort "dummy gerda for toHtmlForm!\n"
, datafile = abort "dummy datafile for toHtmlForm!\n"
, userdb = abort "dummy userdb for toHtmlForm!\n"
......
......@@ -5,9 +5,9 @@ import Time
import iDataWidgets
getTimeAndDate :: !*HSt -> *(!(!HtmlTime,!HtmlDate),!*HSt)
getTimeAndDate hst=:{world = world=:{worldC}}
# (tm,worldC) = localTime worldC
= ((HtmlTime tm.hour tm.min tm.sec,HtmlDate tm.mday tm.mon tm.year),{hst & world = {world & worldC = worldC}})
getTimeAndDate hst=:{HSt | nworld = nworld=:{world}}
# (tm,world) = localTime world
= ((HtmlTime tm.hour tm.min tm.sec,HtmlDate tm.mday tm.mon tm.year),{hst & nworld = {nworld & world = world}})
// converting strings to lists and backwards
......
......@@ -142,7 +142,7 @@ where
finalizeHSt :: !*HSt -> *World
finalizeHSt hst =:{world = nworld =: {worldC = world, gerda, datafile}}
finalizeHSt hst =:{HSt | nworld = nworld =: {NWorld | world = world, gerda, datafile}}
# world = closeDatabase gerda world // close the relational database if option chosen
# world = closemDataFile datafile world // close the datafile if option chosen
= world
......
......@@ -53,6 +53,6 @@ appWorld :: !String !(*World -> *(!a,!*World)) -> (Task a) | iData a
appWorld label fun = mkTask label (Task (liftWorld fun))
liftWorld :: !(*World -> *(!a,!*World)) !*TSt -> *(!a,!*TSt)
liftWorld fun tst=: {hst = hst=:{world = world=:{worldC}}}
# (fvalue,theWorld) = fun worldC
= (fvalue,{tst & hst = {hst & world = {world & worldC = theWorld}}})
liftWorld f tst=: {hst = hst=:{nworld = nworld=:{world}}}
# (a,world) = f world
= (a,{tst & hst = {hst & nworld = {nworld & world = world}}})
......@@ -190,7 +190,7 @@ where
// Trace Calculation
// ******************************************************************************************************
:: Trace = Trace !(Maybe !TraceInfo) ![Trace] // traceinfo with possibly subprocess
:: Trace = Trace !(Maybe TraceInfo) ![Trace] // traceinfo with possibly subprocess
getTraceFromTaskTree :: !UserId !String !HtmlTree -> HtmlTag
getTraceFromTaskTree userId taskNrId tree
......
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