Péter Diviánszky edited this page Aug 2, 2014 · 3 revisions
Clone this wiki locally

GHCi GUI toolkit

I implemented six of the 7GUIs tasks with a minimalist GUI toolkit which runs in GHCi. I call this toolkit GHCi-GUI.

7GUIs is a project concerned with the comparison of programs for a set of seven GUI related programming tasks that represent fundamental challenges in GUI programming.

GHCi-GUI may help to focus on the interaction part of GUI programming. If you want to see GHCi-GUI in action check out this youtube video.

The Seven Tasks
 Temperature Converter
 Flight Booker
 Circle Drawer

The Seven Tasks

Below, a short description of each task followed by an example run with GHCi-GUI.

For each task I also present a possible implementation using the lensref FRP framework. I explain the source code very briefly here; I intend to give better explanations in another post. The full source code can be found here. Skip the source code parts if you don't want to read them without detailed explanation.


The task is to present a label and a button. Initially, the label value is “0” and each click of the button increases the value by one.

An illustration of the counter:

An example run of the counter in GHCi-GUI:

Running the counter gives back four callback functions with which one can interact with the counter. The interface of the counter is redrawn automatically if needed after executing the callbacks.

The meaning of the four callback functions:

  • click is used to click on widgets.
  • put is used to type into entries (not used here).
  • get is used to read labels. This is mainly useful in test cases.
  • delay is for telling the program that time has passed. Otherwise time is frozen from the program's viewpoint.

Subscript numbers help disambiguate between controls with similar names (this feature is not needed in the examples).

A possible implementation for the counter:

counter :: WidgetContext s => RefCreator s ()
counter = do
    -- model
    r <- newRef (0 :: Int)
    let inc = modRef r (+1)
    -- view
    horizontally $ do
        label  "Value" $ show <$> readRef r
        button "Count" $ pure $ Just inc

The model of the counter consists of a reference and an action which increments the reference.

The view of the counter consists of two widgets next to each-other.

The first widget is a label of a dynamically changing String value. (show <$>) converts a dynamically changing Int value to a dynamically changing String value.

The second widget is a button. pure tells that the action of the button is static (does not change). Just tells that the button is active.

Of course it is possible to separate the model and the view even further by defining a new data type for the model:

counterV2 :: WidgetContext s => RefCreator s ()
counterV2 = counterModel >>= counterView

data Counter s = Counter
    { counterValue :: RefReader s Int
    , incrementCounter :: RefWriter s ()

counterModel :: RefContext s => RefCreator s (Counter s)
counterModel = do
    r <- newRef (0 :: Int)
    return Counter
        { counterValue = readRef r
        , incrementCounter = modRef r (+1)

counterView :: WidgetContext s => Counter s -> RefCreator s ()
counterView c = horizontally $ do
    label  "Value" $ show <$> counterValue c
    button "Count" $ pure $ Just $ incrementCounter c

Note that counterModel does not depend on any GUI framework. It needs only the RefContext class constraint (which is a superclass of WidgetContext).

Note that counterView can change the model state only by the incrementCounter function (which is a nice feature).

Temperature Converter

The task is to present two textfields representing the temperature in degrees Celsius and degrees Fahrenheit. When the user enters a numerical value into one of them the corresponding value in the other one is automatically updated. When the user enters a non-numerical string into one of them the value in the other one is left intact. The formula for converting a temperature C in degrees Celsius into a temperature F in degrees Fahrenheit is C = (F - 32) * (5/9) and the dual direction is F = C * (9/5) + 32.

A illustration of the temperature converter:

An example run of the temperature convert in GHCi-GUI:

A possible implementation for the temperature converter:

type Temperature = Prec2 Double

temperatureConverter :: WidgetContext s => RefCreator s ()
temperatureConverter = do
    -- model
    celsius <- newRef (0 :: Temperature)
    let fahrenheit = multiplying 1.8 . adding 32 `lensMap` celsius
    -- view
    horizontally $ do
        void $ entryShow "Celsius" celsius
        void $ entryShow "Fahrenheit" fahrenheit

The model part creates two references for the Celsius and Fahrenheit values, respectively. They contain Temperature values. Temperature differs from Double only in its Show instance. The Fahrenheit reference is defined by applying an isomorphism to the Celsius reference thus there is a bidirectional connection between the two references. The adding and multiplying isomorphisms are defined in the lens package.

In the view part void is used to discard the return of entryShow which is not needed here.

Flight Booker

The task is to build a frame containing a combobox C with the two options “one-way flight” and “return flight”, two textfields T1 and T2 representing the start and return date, respectively, and a button B for “submitting” the selected flight. T2 is enabled iff C's value is “one-way flight”. When C has the value “return flight” and T2's date is strictly before T1's then B is disabled. When a non-disabled textfield T has an ill-formatted date then T is colored red and B is disabled. When clicking B a message is displayed informing the user of his selection (e.g. “You have booked a one-way flight on 04.04.2014.”). Initially, C has the value “one-way flight” and T1 as well as T2 have the same (arbitrary) date (it is implied that T2 is disabled).

An illustration of the flight booker:

An example run of the flight booker in GHCi-GUI:

Note that dates are replaced by non-negative integers because I did not want to have an extra dependency on the time package.

A possible implementation for the flight booker:

type Date = NonNegative Integer

flightBooker :: WidgetContext s => RefCreator s ()
flightBooker = do
    -- model
    booked       <- newRef False
    startdate    <- newRef (0 :: Date)
    maybeenddate <- newRef (Nothing :: Maybe Date)
    -- view
    void $ readRef booked `switch` \case
      True -> label "Notice" $ do
        start <- readRef startdate
        readRef maybeenddate <&> \case
            Just end -> "You have booked a return flight on " ++ show start ++ "-" ++ show end
            Nothing  -> "You have booked a one-way flight on " ++ show start
      False -> do
        -- view model
        boolenddate  <- extendRef maybeenddate maybeLens (False, 0)
        let isreturn = lensMap _1 boolenddate
            bookaction parseok = do
                ok    <- parseok
                start <- readRef startdate
                end   <- readRef maybeenddate
                return $ (ok && maybe True (start <=) end, writeRef booked True) ^. maybeLens
        -- view view
        combobox isreturn $ do
            item False "One-way"
            item True  "Return"
        startok <- entryShow "Start" startdate
        endok   <- entryShowActive "End" (readRef isreturn) $ lensMap _2 boolenddate
        button "Book" $ bookaction $ (&&) <$> startok <*> endok

The model consists of three references. booked is True if the application is in the final state. startdate contains the start date. maybeenddate contains the return date; it is Nothing in case of a one-way flight.

The view switches on the actual value of the booked reference. If it is True, a notice is shown. It if is False, the flight details can be edited. Here we define references used only in the editing phase. First we extend the state of the maybeenddate reference by turning its type from Maybe Date to (Bool, Date). This step is needed because we want to remember the end date even when the user switches between one-way and return flights several times. isreturn is a dynamically changing Bool value; it is True if the user wants a return flight. bookaction is a dynamically changing action. Its parseok parameter tells whether the parsing of the dates was successful.


The task is to build a frame containing a gauge G for the elapsed time e, a label which shows the elapsed time as a numerical value, a slider S by which the duration d of the timer can be adjusted while the timer is running and a reset button R. Adjusting S must immediately reflect on d and not only when S is released. It follows that while moving S the filled amount of G will (usually) change immediately. When e ≥ d is true then the timer stops (and G will be full). If, thereafter, d is increased such that d > e will be true then the timer restarts to tick until e ≥ d is true again. Clicking R will reset e to zero.

An illustration of the timer:

An example run of the timer in GHCi-GUI:

The argument of timer is the refresh rate. Here the refresh rate is 0.02 which means that the timer is refreshed in every 1/50 seconds.

A possible implementation for the timer:

timer :: WidgetContext s => Rational -> RefCreator s ()
timer refresh = do
    -- model
    duration <- newRef 10
    start <- newRef =<< lift currentTime
    timer <- join <$> onChange (readRef start + readRef duration) (mkTimer refresh)
    let elapsed = timer - readRef start
        ratio = per <$> elapsed <*> readRef duration where
            per _ 0 = 1
            per a b = a / b
        reset = writeRef start =<< lift currentTime
    -- view
    vertically $ do
        label "Elapsed (percent)" $ (++"%") . show . (*100) . (^. convert . prec2) <$> ratio
        label "Elapsed" $ (++"s") . show . (^. convert . prec2) <$> elapsed
        void $ entryShow "Duration" $ lensMap (convert . prec2 . nonNegative) duration
        button "Reset" $ pure $ Just reset

duration is a reference containing the duration of the timer. start is a reference containing the start time of the timer; it is initialized to the current time when the timer is created. timer is a reference which is contains the current time. It is updated after every refresh seconds until it reaches start + duration. It is re-initialized automatically if start or duration changes.

CRUD (Create, Read, Update and Delete)

The task is to build a frame containing the following elements: a textfield Tprefix, a pair of textfields Tname and Tsurname, a listbox L, buttons BC, BU and BD and the three labels as seen in the screenshot. L presents a view of the data in the database that consists of a list of names. At most one entry can be selected in L at a time. By entering a string into Tprefix the user can filter the names whose surname start with the entered prefix — this should happen immediately without having to submit the prefix with enter. Clicking BC will append the resulting name from concatenating the strings in Tname and Tsurname to L. BU and BD are enabled iff an entry in L is selected. In contrast to BC, BU will not append the resulting name but instead replace the selected entry with the new name. BD will remove the selected entry. The layout is to be done like suggested in the screenshot. In particular, L must occupy all the remaining space.

An illustration of CRUD:

An example run of CRUD in GHCi-GUI:

A possible implementation for CRUD:

crud :: WidgetContext s => RefCreator s ()
crud = do
    -- model
    names   <- newRef [("Emil", "Hans"), ("Mustermann", "Max"), ("Tisch", "Roman")]
    name    <- newRef ("Romba", "John")
    prefix  <- newRef ""
    sel     <- onChangeEq_ (readRef prefix) $ const $ return Nothing
    let create = do
            n <- readerToWriter $ readRef name
            modRef names (++ [n])
        update s i =
            modRef names $ \l -> take i l ++ [s] ++ drop (i+1) l
        delete i = do
            writeRef sel Nothing
            modRef names $ \l -> take i l ++ drop (i+1) l
            =   (readRef prefix <&> \p -> filter (isPrefixOf p . fst . snd))
            <*> (zip [0..] <$> readRef names)
    -- view
    vertically $ do
        entry "Filter prefix" prefix
        listbox sel $ map (\(i, (s, n)) -> (i, s ++ ", " ++ n)) <$> filterednames
        entry "Name" $ lensMap _2 name
        entry "Surname" $ lensMap _1 name
        horizontally $ do
            button "Create" $ pure $ Just create
            button "Update" $ fmap <$> (update <$> readRef name) <*> readRef sel
            button "Delete" $ fmap delete <$> readRef sel

Circle Drawer

The task is to build a frame containing an undo and redo button as well as a canvas area underneath. Left-clicking inside an empty area inside the canvas will create an unfilled circle with a fixed diameter whose center is the left-clicked point. The circle nearest to the mouse pointer such that the distance from its center to the pointer is less than its radius, if it exists, is filled with the color gray. The gray circle is the selected circle C. Right-clicking C will make a popup menu appear with one entry “Adjust diameter..”. Clicking on this entry will open another frame with a slider inside that adjusts the diameter of C. Changes are applied immediately. Closing this frame will mark the last diameter as significant for the undo/redo history. Clicking undo will undo the last significant change (i.e. circle creation or diameter adjustment). Clicking redo will reapply the last undoed change unless new changes were made by the user in the meantime.

An illustration of the circle drawer:

An example run of the circle drawer in GHCi-GUI:

A possible implementation for the circle drawer:

circleDrawer :: forall s . WidgetContext s => RefCreator s ()
circleDrawer = do
    -- model
    mousepos <- newRef (0, 0 :: Prec2 Double)
    circles  <- newRef [((0,2), 1), ((0,0), 2)]
    selected <- onChange_ (readRef circles) $ const $ return Nothing
    (undo, redo)  <- undoTr (==) circles
    sel <- extendRef selected maybeLens (False, (0, 1))
    let click = do
            mp <- readerToWriter $ readRef mousepos
            l  <- readerToWriter $ readRef circles
            head $ [ writeRef selected $ Just (i, d)
                   | (i, (p, d)) <- zip [0..] l
                   , distance mp p <= d + 0.01
                   ] ++
                   [ modRef circles $ insertBy (compare `on` snd) (mp, 1) ]
        view = maybe id f <$> readRef selected <*> (map ((,) False) <$> readRef circles)  where
            f (i, d) l = insertBy (compare `on` snd . snd) (True, (fst $ snd $ l !! i, d)) $ take i l ++ drop (i+1) l
        commit = readerToWriter view >>= writeRef circles . map snd
    -- view
    horizontally $ do
        button "Undo" undo
        button "Redo" redo
    horizontally $ do
        void $ entryShow "MousePos" mousepos
        button "MouseClick" $ mkMaybe click . not <$> readRef (lensMap _1 sel)
    label "Circles" $ view <&> \l -> unlines [show d ++ " at " ++ show p ++ if s then " filled" else "" | (s, (p, d)) <- l]
    void $ (readRef $ lensMap _1 sel) `switch` \case
      False -> return ()
      True  -> do
        label "Adjust diameter of circle at" $ show . fst <$> ((!!) <$> readRef circles <*> readRef (lensMap (_2 . _1) sel))
        horizontally $ do
            void $ entryShow "Diameter" $ lensMap (_2 . _2 . nonNegative) sel
            button "Done" $ pure $ Just commit

distance (x1, y1) (x2, y2)
    = sqrt $ (x2-x1)^2 + (y2-y1)^2

The undo-redo functionality is implemented with a generic construct. undoTr takes a reference, an equality decision function for the data contained in the reference, and returns two dynamically changing actions, undo and redo.