therning.org/ magnus

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 =
    let
        _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.

After part 3 in this series, which might have been the longest post I’ve ever put on this blog, follows a much short post. In fact it’s so short it’s rather silly.

In this post I’ll modify the Option type to render into multiple lines; two in fact (it’s easy to see that it would work with more lines).

So, to start off, I add a second string to Option:

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

Next the definition for Pretty is changed to render an Option on two lines:

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

Due to the change to Option I also need to modify optionIsInRange:

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

Finally the options need to be modified as well:

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

That’s all there’s to it. Short and sweet.

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 =
    let
        _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

Following on the previous part is another baby step. This just changes the options from a list of strings to a list of objects (the only requirement that they implement Pretty):

data Option = Option { optionValue::String }
    deriving (Show)
 
instance Pretty Option where
    pretty (Option s) = string s

After this it’s an easy step to replace the list of strings with a list of Option:

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

That’s it! Yes, yet another ridiculously short post, but I promise the next one will be considerably longer.

After posting the zeroth part of this series I realised I hadn’t said anything about the final goal of this exercise. The first post contained code for choosing one one-line string (String) out of a list of one-line strings ([String]). What I really want is the ability to choose one item out of a list of items, where each may render to be multiple lines. It would also be really cool if an item could be collapsed and expanded in the rendering. This is the first step in my journey towards these loosely specified requriements.

Rendering items into strings sounds like pretty-printing to me, so I played around a little with a few pretty-printing libraries. Finally I settled on the Wadler/Leijen Pretty Printer (Text.PrettyPrint.Leijen). I didn’t really have any strong reason for choosing it, beyond that it comes with its own type class whereas the pretty-printing library that ships with GHC (Text.PrettyPrint.HughesPJ) doesn’t (though there is a package on HackageDB with a class for it).

I did the smallest change I could think of to add pretty-printing. First the module needs to be imported of course:

import Text.PrettyPrint.Leijen

Then I added a function to turn a list of items into a document (Doc) where each item is pretty-printed on its own line:

myPrettyList :: Pretty a => [a] -> Doc
myPrettyList = vcat . map pretty

I then decided that _getChoice should be left unchanged and instead modified getChoice to turn the list of items into a list of strings:

getChoice vt opts = let
        _converted_opts = myPrettyList opts
    in do
        (sx, sy) <- getSize vt
        _getChoice vt (lines $ show _converted_opts) 0 sx sy

That’s it. The first step, albeit a small one.

I haven’t had much free time lately, which means I haven’t written much non-work code. The only exception is some experiments with a small piece of Haskell code using the Vty module. Many moons ago I wrote a small piece of code that let’s the user choose options from a list in a terminal. Somewhat similar to what you get using dialog --menu ..., but of course a lot more limited and less good looking.

Anyway, over the last few weeks I’ve slowly expanded it in a direction that would be useful if I ever get around to work on yet another of those projects that so far only exist in my head

I’ve kept the transformations in a stack of patches using quilt, and I thought I’d write a little about them. Not because I think they are extremely useful or even good in any way, but more because I really need to get back to writing some blog posts

This is the zeroth post containing the version I put together when I first came across Vty. It is an executable program so it starts with the familiar

module Main where

Next comes a few modules that have to be imported:

import Data.Maybe
import Graphics.Vty
import qualified Data.ByteString.Char8 as B

The options are, in this version, represented as a list of strings. For now it’s enough to have a nonsensical list of unique strings.

options = [ (show i) ++ " Foo" | i <- [0..59]]

The main function is as small as possible, two rows, the first creating an instance of Vty and the second getting the choice and feeding it into print.

main = do
    vt <- mkVty
    getChoice vt options >>= print

Of course one would think that geChoice would be the meat of the code, but it is also short. After getting the size of the terminal it calls _getChoice, which is the meat of the code. The reason for this split is the handling of resize events.

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

The main part of _getChoice is straight forward, first update the terminal, then wait for an event, and finally handle the event. Unless the user wants to exit (pressing enter choses an item, pressing escape exits without a choice) a recursive call is made to _getChoice with slightly modified arguments.

Probably the most complicated part is the calculation of the top of the list of visible items. The idea is that if the list has more items than there are lines in the terminal then the cursor moves down until the middle line, once there any down movement will result in the list scrolling up. This continues until the end of the list is visible, at that point the cursor moves down towards the last line in the terminal. I doubt that explanation makes sense, hopefully it’ll be clear to anyone who bothers running the code.

_getChoice vt opts idx sx sy =
    let
        _calcTop winHeight listLength idx = max 0 ((min listLength ((max 0 (idx - winHeight `div` 2)) + winHeight)) - winHeight)
        _top = _calcTop sy (length opts) idx
        _visible_opts = take sy (drop _top opts)
    in do
        update vt (render _visible_opts (idx - _top) sx)
        k <- getEvent vt
        case k of
            EvKey KDown [] -> _getChoice vt opts (min (length opts - 1) (idx + 1)) sx sy
            EvKey KUp [] -> _getChoice vt opts (max 0 (idx - 1)) sx sy
            EvKey KEsc [] -> shutdown vt >> return Nothing
            EvKey KEnter [] -> shutdown vt >> return (Just $ (idx, opts !! idx))
            EvResize nx ny -> _getChoice vt opts idx nx ny
            _ -> _getChoice vt opts idx sx sy

The final piece is the code that renders the list. The items of the list are zipped together with a list of integers. Each such tuple is then rendered into a line((The reason for the line rendering looking so complicated is that Vty requires each line to be of equal lenght.)), where the line of the cursor is highlighted. The resulting list of rendered lines is then folded into a full image.

render opts idx sx = pic {
    pImage = foldr1 (<->) $ map _render1 $ zip [0..] opts
    }
    where
        _render1 (i, o) = renderHFill attr ' ' 5 <|> renderBS (_attr i) (B.pack o) <|> renderHFill attr ' ' (sx - 5 - length o)
        _attr i = if i /= idx
            then attr
            else setRV attr

That’s it, that’s the starting point. It’s also likely to be the longest post in this planned series.