implementation module ChangeDB import Types, TSt, Store import StdFunc, StdTuple, StdList import Text derive JSONEncode PersistentChange derive JSONDecode PersistentChange derive bimap Maybe, (,) instance ChangeDB IWorld where createChange :: !PersistentChange !*IWorld -> *IWorld createChange change iworld = snd (changeStore (\list -> list ++ [change]) iworld) updateChange :: !ChangeLabel !(PersistentChange -> PersistentChange) !*IWorld -> *IWorld updateChange label f iworld = snd (changeStore (\list -> [if (c.PersistentChange.label == label) (f c) c \\ c <- list]) iworld) deleteChange :: !ChangeLabel !*IWorld -> *IWorld deleteChange label iworld = snd (changeStore (\list -> [c \\ c <- list | c.PersistentChange.label <> label]) iworld) getChange :: !ChangeLabel !*IWorld -> (!Maybe PersistentChange,!*IWorld) getChange label iworld # (list,iworld) = changeStore id iworld = case [c \\ c <- list | c.PersistentChange.label == label] of [c] = (Just c,iworld) _ = (Nothing,iworld) getChanges :: !*IWorld -> (![PersistentChange],!*IWorld) getChanges iworld = changeStore id iworld getChangesForProcess :: !ProcessId !*IWorld -> (![PersistentChange],!*IWorld) getChangesForProcess processId iworld # (list,iworld) = changeStore id iworld = ([c \\ c <- list | startsWith c.PersistentChange.scope processId],iworld) changeStore :: !([PersistentChange] -> [PersistentChange]) !*IWorld -> (![PersistentChange],!*IWorld) changeStore fn iworld=:{IWorld|store,world} # (mbList,store,world) = loadValue "ChangeDB" store world # list = fn (case mbList of Nothing = []; Just list = list) # store = storeValue "ChangeDB" list store = (list, {IWorld|iworld & store = store, world = world}) instance ChangeDB TSt where createChange :: !PersistentChange !*TSt -> *TSt createChange change tst = appIWorldTSt (createChange change) tst updateChange :: !ChangeLabel !(PersistentChange -> PersistentChange) !*TSt -> *TSt updateChange label f tst = appIWorldTSt (updateChange label f) tst deleteChange :: !ChangeLabel !*TSt -> *TSt deleteChange label tst = appIWorldTSt (deleteChange label) tst getChange :: !ChangeLabel !*TSt -> (!Maybe PersistentChange,!*TSt) getChange label tst = accIWorldTSt (getChange label) tst getChanges :: !*TSt -> (![PersistentChange],!*TSt) getChanges tst = accIWorldTSt getChanges tst getChangesForProcess :: !ProcessId !*TSt -> (![PersistentChange],!*TSt) getChangesForProcess processId tst = accIWorldTSt (getChangesForProcess processId) tst