Making a choice from a list in Haskell, Vty (part 5, the last one)

The time has come for the final installment of this series of “discussions of a refactoring”. These are the earlier installments. This is where I finally add the ability to collapse a list item. This is a rather terse description of the changes, since I feel all of them are fairly obvious, and hence require no lengthy explanation.

First the Option type has to be changed to keep track of whether an item is collapsed or not:

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

Next the rendering of an item has to be changed, so that collapsed items really appear collapsed. I thought displaying a collapsed item as its first line, with “…” added to the end would be acceptable for a first version:

instance Pretty Option where
    pretty (Option _ False s1 s2) = string s1 <> line <> indent 2 (string s2)
    pretty (Option _ True s1 _) = string s1 <> string "..."

Later on I’ll need to update the range of an item. For the forgetful, the range of an item is the starting and ending line. Obviously the range changes when an item is collapsed:

optionUpdateRange o = let
        (b, _) = optionRange o
        l = length $ lines $ show $ pretty o
    in o { optionRange = (b, b + l - 1) }

The implementation of optionsIsInRange has to change due to adding the optionCollapsed field. It’ll also be useful to have a few functions for manipulating the collapsed state of an item:

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

optionIsCollapsed (Option _ c _ _) = c
optionToggleCollapse o = o { optionCollapsed = not (optionCollapsed o) }
optionCollapse o = o { optionCollapsed = True }
optionExpand o = o { optionCollapsed = False }

One thing that I didn’t think about until after doing some manual testing was that moving the cursor up in the list should always put the cursor on the line above, even when moving from one item to the previous. This was a bug in the previous version :-)

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 ozJumpToCursorBottom $ ozLeft o

I also have to change ozCursorMod due to adding the new field:

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

It turns out the be useful to be able to jump to the top and bottom of an item (there’s already an example of the latter above):

ozJumpToCursorTop o@(OptionZipper _ _ (r:rs)) = let
        (newIdx, _) = optionRange r
    in o { ozIdx = newIdx }

ozJumpToCursorBottom o@(OptionZipper _ _ (r:rs)) = let
        (_, newIdx) = optionRange r
    in o { ozIdx = newIdx }

Creating the list of items need a slight modification as well:

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

The last change is adding actually collapsing of an item in the UI controller code:

_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 (KASCII ' ') [] -> let
                    newOpts = ozJumpToCursorTop $ ozCursorMod (optionUpdateRange . optionToggleCollapse) opts
                in _getChoice vt newOpts sx sy
            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

That’s it.

Leave a comment