wxhaskell: Updating a statusField using "on click" of a panel

Question

I would like some advice on how to update a "statusField" after clicking on a "panel".

The following program demonstrates the problem. The program draws two frames. You can imagine the left frame to be some kind of drawing area and the right frame contains the buttons "Red" and "Green". After clicking on the button labeled "Red" the text of the statusField is updated to "Current color: Red". The button labeled "Green" updates the text to "Current color: Green".

How to change the text of the statusField after the user clicked on the left panel? E.g. change it to "You successfully clicked on the drawing panel."

Why can't I do it in "on click" the same way as in "on command" for the buttons? (See annotation in the source below.)

Thank you very much.

module Main where

import Graphics.UI.WX

-- | NOP (= No Operation)
data Command = Nop
             | Red
             | Green
               deriving (Eq)

main :: IO ()
main
  = start hello


hello :: IO ()
hello 
    = do  currentCommand <- varCreate $ Nop               -- current command performed on next click on "pDrawingarea"

          status <- statusField    [text := "Welcome."]

          -- Frames and Panels
          f            <- frame   [ text := "Demo"
                                  , bgcolor := lightgrey ]

          pButtons     <- panel f [ bgcolor := lightgrey]
          pDrawingarea <- panel f [ on paint := draw
                                  , bgcolor := lightgrey
                                  ]

          set pDrawingarea [on click :=  do drawingAreaOnClick status currentCommand pDrawingarea
                                            -- set status [text := "User clicked on the panel."]
                                            -- Problem: uncommenting the line above shows the problem
                           ]

          bRed <- button pButtons [text := "Red",  on command := do varSet currentCommand Red
                                                                    set status [text := "Current color: Red"]
                                 ]

          bGreen <- button pButtons [text := "Green",  on command := do varSet currentCommand Green
                                                                        set status [text := "Current color: Green"]
                                    ]

          set pButtons [ layout := column 1 [ hstretch.expand $ widget bRed
                                            , hstretch.expand $ widget bGreen
                                            ]
                       ]

          set f [ statusBar := [status]
                , layout := row 3 [
                                    minsize (sz 600 500) $ stretch.expand $  widget pDrawingarea
                                  , vstretch.expand $ rule 3 500
                                  , minsize (sz 200 500) $ vstretch.expand $ widget pButtons
                                  ]    
                ]

          return ()

draw ::  DC a -> Rect -> IO ()
draw  dc viewArea
    = do putStrLn "Imagine some code to repaint the screen."


drawingAreaOnClick :: statusField -> Var Command -> Panel () -> Point -> IO ()
drawingAreaOnClick sf command panel pt
    = do c <- varGet command
         case c of 
            Red   -> do putStrLn "Imagine some code to do red painting"
            Green -> do putStrLn "Imagine some code to do green painting"

Answer 1

After spending lots of time on this problem I found a solution.

The solution is to change the definition of

drawingAreaOnClick :: statusField -> Var Command -> Panel () -> Point -> IO ()

to

drawingAreaOnClick :: Textual x =>  x -> Var Command -> Panel () -> Point -> IO ()

Because "statusField" itself is a member of the class "Textual" I don't understand the problem.

For the sake of completeness I will mention that I also switched GHC verions.The original problem occurred with GHC 7.8.4 and the solution I found works with GHC 7.10.3. I can't say if the GHC version affects the problem.

For reference the complete working code:

module Main where

import Graphics.UI.WX

-- | NOP (= No Operation)
data Command = Nop
             | Red
             | Green
               deriving (Eq)

main :: IO ()
main
  = start hello


hello :: IO ()
hello 
    = do  currentCommand <- varCreate Nop               -- current command performed on next click on "pDrawingarea"


          status <- statusField    [text := "Welcome."]

          -- not needed:     currentStatus <- varCreate status


          -- Frames and Panels
          f            <- frame   [ text := "Demo"
                                  , bgcolor := lightgrey ]

          pButtons     <- panel f [ bgcolor := lightgrey]
          pDrawingarea <- panel f [ on paint := draw
                                  , bgcolor := lightgrey
                                  ]

          set pDrawingarea [on click :=  do drawingAreaOnClick status currentCommand pDrawingarea
                                            -- set status [text := "User clicked on the panel."]
                                            -- Problem: uncommenting the line above shows the problem
                           ]

          bRed <- button pButtons [text := "Red",  on command := do varSet currentCommand Red
                                                                    set status [text := "Current color: Red"]
                                 ]

          bGreen <- button pButtons [text := "Green",  on command := do varSet currentCommand Green
                                                                        set status [text := "Current color: Green"]
                                                                        --sf <- varGet currentStatus
                                                                        -- set sf [text := "yyy"]

                                    ]

          set pButtons [ layout := column 1 [ hstretch.expand $ widget bRed
                                            , hstretch.expand $ widget bGreen
                                            ]
                       ]

          set f [ statusBar := [status]
                , layout := row 3 [
                                    minsize (sz 600 500) $ stretch.expand $  widget pDrawingarea
                                  , vstretch.expand $ rule 3 500
                                  , minsize (sz 200 500) $ vstretch.expand $ widget pButtons
                                  ]    
                ]

          return ()

draw ::  DC a -> Rect -> IO ()
draw  dc viewArea
    = do putStrLn "Imagine some code to repaint the screen."


drawingAreaOnClick ::  Textual x =>  x -> Var Command -> Panel () -> Point -> IO ()
drawingAreaOnClick sf command panel pt
    = do c <- varGet command
         set sf [text := "Drawing on the screen."]
         case c of 
            Red   -> do putStrLn "Imagine some code to do red painting"
            Green -> do putStrLn "Imagine some code to do green painting"