Recreating Windows as Required

It has been a while since my last post and my work on Tennis Ladders and Stats has decreased as it's stability has improved. Having said that, I have been working on implementing a number of automated tests using Hunit and ant as the build framework. I've been using the tests to prevent regressions creeping in during some code restructuring. Anyway, I've decided provide a short example outlining one of the key issues I ran into during development. It involves displaying a window which needs to customised each time it is displayed. A simple example is that of an error window which displays a customised error message provided as an argument.

When working with repetitive windows which have the same appearance throughout the duration the application is running, they can simply be created once and a handle returned so that they can be shown when required. In this case, the code for setting up a window might look like this:


{-
loadAddTeamWindow
sets up the add_team_window
-}
loadAddTeamWindow tlasGlade = do
addTeamWindow <- xmlGetWidget tlasGlade castToWindow "add_team_window"
addTeamCancelButton <- xmlGetWidget tlasGlade castToButton "add_team_cancel_button"
addTeamApplyButton <- xmlGetWidget tlasGlade castToButton "add_team_apply_button"
addTeamText <- xmlGetWidget tlasGlade castToEntry "add_team_text"

-- set maxlength of addTeamText
entrySetMaxLength addTeamText maxInputLength

onDelete addTeamWindow $ do
(\_ -> do
-- hide addTeamWindow
widgetHide addTeamWindow
return True)

onShow addTeamWindow $ do
-- clear entry field
entrySetText addTeamText ""
-- set focus to text entry
widgetGrabFocus addTeamText

onClicked addTeamApplyButton $ do
teamname <- get addTeamText entryText
let team = Team {teamClub = teamname, teamPlayers = [], teamPoints = 0,
teamNumMatches = 0, teamGamesFor = 0, teamGamesAgainst = 0}
seasonM <- getCurrentSeason
sectionM <- getCurrentSection
case (teamname == "", seasonM, sectionM, entryTextTooLong teamname) of
(_, Nothing, _, _) -> showErrorWindow "Can not add a team without selecting a season"
(_, _, Nothing, _) -> showErrorWindow "Can not add a team without selecting a section"
(True, _, _, _) -> showErrorWindow "Team name can not be empty"
(_, _, _, True) -> showErrorWindow "Team name is too long"
(False, Just season, Just section, False) -> do
existingTeamNames <- getClubNames season section
case (elem teamname existingTeamNames) of
True -> showErrorWindow ("Cannot add team " ++ teamname ++ " as it already exists")
False -> do
-- add the team
addTeam season section team
-- hide the addTeamWindow
widgetHide addTeamWindow

onClicked addTeamCancelButton $ do
-- hide the addTeamWindow
widgetHide addTeamWindow

return addTeamWindow


Unfortnately the same approach doesn't quite work when we want the window to change each time it is displayed. This time we need to recreate the window each time it is to be displayed and ensure it is destroyed when it is closed. The following code demonstrate this approach:


{-
showErrorWindow
shows the errorWindow with the given message
NOTE:
since the errorMessage changes on each invocation, the errorWindow can't
be shown and hidden as other windows are. Instead, the window must be
destroyed and created again on each invocation. If the window is not
destroyed but hidden, multiple instances of the errorWindow are active
at the same time.
-}
showErrorWindow errorMessage = do
tlasGladeM <- xmlNew "tlas.glade"
let tlasGlade = case tlasGladeM of
(Just tlasGlade) -> tlasGlade
Nothing -> error "Can't find the glade file \"tlas.glade\" in the current directory"

errorWindow <- xmlGetWidget tlasGlade castToWindow "error_window"
okButton <- xmlGetWidget tlasGlade castToButton "error_window_ok_button"
errorLabel <- xmlGetWidget tlasGlade castToLabel "error_label"

onShow errorWindow $ do
labelSetLabel errorLabel errorMessage
widgetGrabFocus okButton

onDelete errorWindow $ (\_ -> do return False)

onClicked okButton $ do
widgetDestroy errorWindow

widgetShowAll errorWindow