implementation module MenuTasks from ProcessDB import qualified class ProcessDB(..) from ProcessDB import qualified instance ProcessDB TSt from ProcessDB import ::Menu(..), ::MenuItem(..), ::Process{..} from TSt import ::Task from Void import :: Void import TSt, CoreCombinators, StdMisc import StdList derive gParse Menu, MenuItem derive gPrint Menu, MenuItem derive gVisualize Menu, MenuItem derive gUpdate Menu, MenuItem derive bimap (,), Maybe getMenus :: Task (Maybe [Menu]) getMenus = mkInstantTask "getMenus" getMenus` where getMenus` tst #(pid, tst) = getCurrentProcess tst #(p, tst) = ProcessDB@getProcess pid tst = case p of Just p = (TaskFinished p.menus, tst) Nothing = abort "Cannot get current process!" setMenus :: ![Menu] -> Task Void setMenus menus = mkInstantTask "setMenus" (setMenus` (Just menus)) removeMenus :: Task Void removeMenus = mkInstantTask "removeMenus" (setMenus` Nothing) setMenus` :: !(Maybe [Menu]) !*TSt -> (!TaskResult Void,!*TSt) setMenus` menus tst #(pid, tst) = getCurrentProcess tst #(_, tst) = ProcessDB@updateProcess pid (\p -> {p & menus = menus}) tst = (TaskFinished Void, tst) setMenuItem :: !String !MenuItem -> Task Void setMenuItem updName newItem = getMenus >>= \menus. case menus of Nothing = return Void Just menus = setMenus (updateMenus menus) where updateMenus menus = map updateMenu menus updateMenu (Menu label items) = Menu label (map updateItem items) updateItem (SubMenu label items) = SubMenu label (map updateItem items) updateItem (MenuName name item) | name == updName = MenuName name newItem | otherwise = MenuName name (updateItem item) updateItem item = item getMenuItem :: !String -> Task (Maybe MenuItem) getMenuItem findName = getMenus >>= \menus. case menus of Nothing = return Nothing Just menus = return (searchMenus menus) where searchMenus [Menu _ items:menus] = case searchItems items of Nothing = searchMenus menus res = res searchMenus [] = Nothing searchItems [item:items] = case searchItem item of Nothing = searchItems items res = res searchItems [] = Nothing searchItem (SubMenu _ items) = searchItems items searchItem (MenuName name item) | name == findName = Just item | otherwise = Nothing searchItem _ = Nothing