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