Making a choice from a list in Haskell, Vty (part 3)

This is the third part, and it’s likely to be the longest one in the series. The three previous parts have been rather short, but now it’s time for a longer post because in this one I completely change the representation of the options that are rendered.

Instead of using a list and an integer I’ll use what is basically a zipper (with some extra fields for book keeping). At the same time I also add a new field to the Option type to keep track of how many lines the option renders to. At the moment it will always be one line, but the next part will actually make use of it. (Yes, that part probably should have been kept in a separate part, but this happens to be how I wrote the code.)

First some changes to the Option type and its implementation of Pretty:

data Option = Option { optionRange::(Int, Int), optionS1::String }
    deriving (Show)

instance Pretty Option where
    pretty (Option _ s) = string s

Then two functions related to the “range” of an Option. The first to update based on a new start line (new beginning), the second checks whether a line falls within the range of an Option:

optionSetRange nb o = let
        l = length $ lines $ show $ pretty o
    in o { optionRange = (nb, nb + l - 1) }

optionIsInRange (Option (b, e) _) i = b <= i && i <= e

Now it’s time to introduce the zipper that replaces the list of options. The basic idea is that there are two parts to a list, the left side (ozLS) and the right side (ozRS), and a current item. In this list zipper the current item is the first item on the right side:

data OptionZipper = OptionZipper { ozIdx::Int, ozLS::[Option], ozRS::[Option]
    deriving (Show)

Making the zipper an instance of Pretty is as simple as this:

instance Pretty OptionZipper where
    pretty = vcat . map pretty . ozToList

It’s useful to be able to both convert to and from lists (as seen just above in the Pretty instance):

ozFromList l = OptionZipper 0 [] l
ozFromListWithMod f = ozCursorMod f . ozFromList

ozToList (OptionZipper _ l r) = reverse l ++ r

The function for getting the current item is obvious. At the same time I’ll define a function that applies a function to the item at the cursor.

ozCursor (OptionZipper _ _ (r:_)) = Just r
ozCursor _ = Nothing

ozCursorMod f o@(OptionZipper _ _ (r:rs)) = o { ozRS = (f r:rs) }
ozCursorMod _ o = o

Usually a list zipper has functions to move the cursor, i.e. move items between the left and right sides. In this zipper there is some extra bookkeeping that has to be done to make sure that the index is correct and that the current item has a correct range:

ozLeft (OptionZipper _ (l:ls) rs) = let
        (newIdx, _) = optionRange l
    in OptionZipper newIdx ls (l:rs)
ozLeft o = o

ozRight (OptionZipper _ ls (r:rs)) = let
        (_, pe) = optionRange r
    in ozCursorMod (optionSetRange $ pe + 1) $ OptionZipper (pe + 1) (r:ls) rs
ozRight o = o

That’s all good and well, but what I really need is to be able to navigate based on lines. Expressing that using ozLeft and ozRight is fairly straight forward. Let’s start with shifting to the next line, ozNextLine, it has two cases, one general case and one when the cursor points to the last item:

ozNextLine o@(OptionZipper i _ [c]) =
    if optionIsInRange c (i + 1)
        then o { ozIdx = i + 1 }
        else o
ozNextLine o = let
        c = fromJust $ ozCursor o
        i = ozIdx o
    in if optionIsInRange c (i + 1)
        then o { ozIdx = i + 1 }
        else ozRight o

Anyone who pays attention will realise that this definition of ozNextLine isn’t complete. The zipper is capable of pointing to the empty spot after the last item (when ozRS is [], as would be the case for an empty list turned into a zipper). For this occasion that is all right, but this would need some attention when using this in a proper program.

The definition of ozPreviousLine also has two cases:

ozPreviousLine o@(OptionZipper 0 _ _) = o
ozPreviousLine o = let
        c = fromJust $ ozCursor o
        i = ozIdx o
    in if optionIsInRange c (i - 1)
        then o { ozIdx = i - 1 }
        else ozLeft o

Yes, this function also has some assumptions built into it, just like for ozNextLine it’s enough to just realise that for this exercise.

That’s it for the zipper, now it’s possible to create the options:

options = ozFromListWithMod (optionSetRange 0) [Option (0, 0) ((show i) ++ " Foo") | i <- [0..99]]

The introduction of the zipper requires large changes to both getChoice and _getChoice. The changes are however very straight forward and in my opinion they make both functions easier to read and understand. I’ll simply copy in the definitions without any comments in the hope that thanks to using a zipper the code is self-explanatory :-) It might be worth pointing out though that render is still passed a list of strings to render, so it requires no changes at this point.

getChoice vt opts = do
    (sx, sy) <- getSize vt
    _getChoice vt opts sx sy

_getChoice vt opts sx sy =
        _converted_opts = lines $ show $ pretty opts
        _idx = ozIdx opts
        _calcTop winHeight listLength idx = max 0 ((min listLength ((max 0 (idx - winHeight `div` 2)) + winHeight)) - winHeight)
        _top = _calcTop sy (length _converted_opts) _idx
        _visible_opts = take sy (drop _top _converted_opts)
    in do
        update vt (render _visible_opts (_idx - _top) sx)
        k <- getEvent vt
        case k of
            EvKey KDown [] -> _getChoice vt (ozNextLine opts) sx sy
            EvKey KUp [] -> _getChoice vt (ozPreviousLine opts) sx sy
            EvKey KEsc [] -> shutdown vt >> return Nothing
            EvKey KEnter [] -> shutdown vt >> return (Just $ (_idx, ozCursor opts))
            EvResize nx ny -> _getChoice vt opts nx ny
            _ -> _getChoice vt opts sx sy
Leave a comment