Trying to avoid imperative code

I’m having a hard time trying to avoid writing imperative code, when building an ImGui app. The idea is fairly simple. A node can have several fields. Each field has a non-editing and an editing variation. For example, a piece of text can be drawn as just text, or a text input box. Only one field can be edited at a time.

I have a sum type that represents which field is being edited:

data NodeField
  = ActivityField ( IORef String )
  | ServiceField String
  | IdentifierField String ( Maybe String )

Basically I need to implement this idea:

case nodeField of
  ActivityField stringRef ->
    drawActivityField_Editing stringRef
  _ ->
    drawActivityField

case nodeField of
  ServiceField str ->
    drawServiceField_Editing str
  _ ->
    drawServiceField

case nodeField of
  IdentifierField str maybeStr ->
    drawIdentifierField_Editing str maybeStr
  _ ->
    drawIdentifierField

This looks bad enough. But I can’t figure out the proper way. I thought using a sum type is the right idea.

I still don’t really understand what you’re trying to do. Usually you would write one big case expression like this:

case nodeField of
  ActivityField stringRef ->
    drawActivityField_Editing stringRef
  ServiceField str ->
    drawServiceField_Editing str
  IdentifierField str maybeStr ->
    drawIdentifierField_Editing str maybeStr

But then you don’t have non-editable fields.

I don’t see how this sum type represents the field that is being edited. Is ActivityField a field that is being edited? What is the difference between the three types of fields?

It kind of resembles this:

sc2

Where an entry can be edited or not. When not edited, it’s just text. When edited, it’s an input box. Only one entry can be edited at a time

That was easy to implement because every entry is the same. I mapped a draw function to the list of entries. If the entry’s name matches the one that’s being edited, it draws an input box. Otherwise it just draws text.

But the new situation I’m in is more complicated. Using the same picture as example, if the “Gmail” entry is being edited, it needs to draw a text input box. If the “Facebook” entry is being edited, it needs to draw a dropdown menu.

If I still use a sum type, then it’d be like

data EditingEntry = Gmail | Facebook

drawEntries =
  case editingEntry of
    Gmail -> drawInputBox "Gmail"
    _ -> drawText "Gmail"

  case editingEntry of
    Facebook -> drawDropDown "Facebook"
    _ -> drawText "Facebook"

Or equivalently:

drawEntries =
  case editingEntry of
    Gmail -> do
      drawInputBox "Gmail"
      drawText "Facebook"
    Facebook -> do
      drawText "Gmail"
      drawDropDown "Facebook"

But that’d have so much duplicate code, as the number of entries increases.

In that case I would generalize a bit and consider an arbitrary list of fields and work with that. You could have a data type that keeps track of the field that is being edited with an integer:

data Node = Node (Maybe Int) [Field]

Then you can write a draw function something like this:

drawNode :: Node -> IO ()
drawNode (Node Nothing fields) = mapM_ drawField fields
drawNode (Node (Just n) fields) = do
  mapM_ drawField before
  drawEditField x
  mapM_ drawField after
  where
    (before, x : after) = Data.List.splitAt n fields

drawField :: Field -> IO ()
drawField = _

drawEditField :: Field -> IO ()
drawEditField = _

I am not sure what is being asked here.

If there is a number of entities, each of which may be a label, a box or a menu, then we can make a sum type with these choices and put it in a collection. For example:

data Widget = Label String | Box | Menu String [String] deriving Show

type Widgets = [Widget]

renderWidgets ∷ Widgets → IO ( )
renderWidgets = traverse_ renderWidget
  where
    renderWidget (Label string) = print string
    renderWidget Box = getLine >>= print
    renderWidget (Menu selectedLine otherLines) = print selectedLine

But we may also say that this is unsafe because who knows what will end up in that list. For example, renderWidgets [Label "x", Box, Menu "y" [ ]] is technically acceptable, but it has two editable widgets at the same time — this is forbidden, so we have an error.

I see two ways to enforce the restriction of there being only one editable widget at once.

  1. Use a dimorphous zipper. Something like this:

    data DimorphousZipper α β = DimorphousZipper [α] β [α] deriving Show
    
    data EditableWidget = Box' | Menu' String [String] deriving Show
    
    type Widgets' = DimorphousZipper String EditableWidget
    
    renderWidgets' ∷ Widgets' → IO ( )
    renderWidgets' (DimorphousZipper before here after) = do
      traverse_ print (reverse before)
      renderWidget here
      traverse_ print after
      where
        renderWidget Box' = getLine >>= print
        renderWidget (Menu' selectedLine otherLines) = print selectedLine
    

    Clearly there is only one place for an editable widget to reside in. This also means that we cannot have no editable fields at all, but that is easily remedied by setting type Widgets'' = Either [String] Widgets', so in principle it is not a problem.

  2. Get fancy and write a type that can have at most one editable widget inside.

    data ProductWithSelection (isSelectedSomewhere ∷ Bool) α β where
      SelectedHere ∷ β → ProductWithSelection False α β → ProductWithSelection True α β
      SelectedSomewhere ∷ α → ProductWithSelection True α β → ProductWithSelection True α β
      NotYetSelected ∷ α → ProductWithSelection False α β → ProductWithSelection False α β
      End ∷ ProductWithSelection False α β
    
    deriving instance (Show α, Show β) ⇒ Show (ProductWithSelection isSelectedSomewhere α β)
    
    instance Bifunctor (ProductWithSelection isSelectedSomewhere) where
      bimap f g (SelectedHere β remainder) = SelectedHere (g β) (bimap f g remainder)
      bimap f g (SelectedSomewhere α remainder) = SelectedSomewhere (f α) (bimap f g remainder)
      bimap f g (NotYetSelected α remainder) = NotYetSelected (f α) (bimap f g remainder)
      bimap _ _ End = End
    
    instance Bifoldable (ProductWithSelection isSelectedSomewhere) where
      bifoldr f g z (SelectedHere β remainder) = g β (bifoldr f g z remainder)
      bifoldr f g z (SelectedSomewhere α remainder) = f α (bifoldr f g z remainder)
      bifoldr f g z (NotYetSelected α remainder) = f α (bifoldr f g z remainder)
      bifoldr _ _ z End = z
    
    type Widgets'' isSelectedSomewhere = ProductWithSelection isSelectedSomewhere String EditableWidget
    
    renderWidgets'' ∷ Widgets'' any → IO ( )
    renderWidgets'' = bitraverse_ print renderWidget
      where
        renderWidget Box' = getLine >>= print
        renderWidget (Menu' selectedLine otherLines) = print selectedLine
    

    I am not sure if this is such a good idea, but it is, in a way, the most straightforward in saying what we want.

Of course, we should also consider how this collection will change over time. For example, it may be that the number of widgets is fixed and that mutable arrays are more suitable due to the efficient random access they afford. We may still be able to ensure safety by adding some phantom types and minimizing the number of unsafe primitive operations.

Does this answer your question @techmindful?

Actually, I think we should look at this from another angle.

If you are writing a human interface, there must be a time series of state values. The purpose of an editable widget is to pass from one state value to the next. So, we have a transaction as a unit: create an editable widget → get some input → update the state. Now we can equip the steps with the side effects we like.

  • create an editable widget might have a side effects of locking all other widgets from becoming editable.
  • update the state might have a side effect of resetting every widget to a state where it is not but may become editable.

Overall, this looks like a bracket.

Between the transactions, we should use a container that cannot hold editable widgets at all, so nothing can go wrong.

Since I do not know any specifics, I cannot say if it would be easy or hard to put whatever you are doing into this frame, but I think it might be worthwhile to look into.

@jaror @kindaro
Thanks for the help! I sat on this problem for the past few days. It’s interesting to see that both of your replies had a “before-after” pattern, as well as a function overloaded with pattern matching. However I wasn’t satisfied with the result when I tried to apply those patterns. Forgot exactly why. But there just always seemed to be a lot of wrapping and unwrapping, and much indented case expressions. I was reluctant to write new data structure or class instances as well. I thought I should be able to implement this with what Haskell gives me at default. It’s just a simple imperative idea that looks like:

if ( x == ENUM_1 )
  DrawA();
else
  DrawA_Edit();

if ( x == ENUM_2 )
  DrawB();
else
  DrawB_Edit();

...

Then I realized that I couldn’t really write this code well enough in an imperative language either. But I did manage to come up with a solution that doesn’t suck. First I still have the sum type, but I tried to not bundle data into it as much as before:

data NodeField
  = ActField
  | ServField
  deriving ( Eq, Generic, Ord )

Currently there are only two kinds of fields. But the idea should scale.

Then I put the drawing functions, and their variants in a such a dictionary:

let drawMap_Partial = Map.fromList
      [ ( ActField,  ( drawAct,  drawAct_Edit  ) ) 
      , ( ServField, ( drawServ, drawServ_Edit ) ) 
      ]

Then I have a deciding function that picks the correct drawing function, based on the condition:

f_PickFunc = \( field, ( f, f_Edit ) ) ->
  if field == editingField then f_Edit else f

  fs = List.map f_PickFunc ( Map.toList drawMap )

Finally I just sequence_ the list of drawing functions.

I’m still surprised that it’s hard to write good code for a task with a simple idea like this. But I’m glad that eventually, functional programming still managed to help me out on this.

I’m still finding it hard to understand the rationale for the new design here. @kindaro’s suggestion of type Widgets = [Widget] etc. is the correct overall design. It leaves unaddressed the goal of encoding in the type system the invariant of “exactly one field should be editable”, but if you can live with that (and I strongly suggest that you try!) then that will be by far the most natural design.

2 Likes

Constructing the widget list is what I was struggling with, I guess. Constructing the list is effectively deciding whether to draw the next field as plain text, like Label String, or an input box, or a dropdown menu. This is the part where I find myself writing the subpar code of C-like if-else statements above.

I assume I still need a sum type to mark which field is being edited. For example, it can be:

data EditingField = NameField | AgeField

Both fields need to be displayed. When not edited, both fields are displayed as Label String. When editing name, the name field is displayed as Box. When editing age, the age field is displayed as Menu String [ String ].

What can be a good way to construct the list? The only one I can think of, other than what I ended up doing, is a stateful one. I assume a widget list in some app state. To construct the list, I’d still be writing code like:

case editingField of
  NameField  -> put $ appState & #widgetList <>~ Box
  _ -> put $ appState & #widgetList <>~ ( Label "" )

case editingField of
  AgeField -> put $ appState & #widgetList <>~ ( Menu "" [] )
  _ -> put $ appState & #widgetList <>~ ( Label "" )

So what do you construct the list of widgets from? What is the model? I would really like to see the remainder of the design. In your example, you put empty strings everywhere — I suppose there is actually some data structure that holds dynamically changing values for these labels? In order to decide how to get somewhere, we first need to decide where we start from.

I assume I still need a sum type to mark which field is being edited.

Where does this assumption come from?

I think I am still not seeing the picture.

My strategy is to figure out what the type of the function we want to write should be.

The theory is that, since all data structures have types, we can always figure out the function type we want a block of code to have — and then we know that whether we can write a function for this type. In imperative programming, every statement is essentially a function from state to state, so in the worst case we can say that the whole state is the source and target type for our function, but usually we can do much better since any given block of code usually accesses a small subset of the whole state.

That is to say, imperative code can be re-written functionally if we can nail down the types of the parts of the state that get read and written.

That is a good theory to know about. I will link the source code later, but I feel that’s also getting away from what I’m asking in the post. The essence of it is really simple. It has nothing to do with what program I’m writing, what data I have. To put it abstractly:

There are 3 actions. All need to be performed. Based on the value of a variable, one of the action needs to be performed slightly differently. It needs to be substituted with a variant.

data Var = A | B | C

case var of
  A -> do_A2
  _ -> do_A1

case var of
  B -> do_B2
  _ -> do_B1

case var of
  C -> do_C2
  _ -> do_C1

I was writing a GUI app when encoutering this situation. But I think this can happen when writing any app. I was unsatisfied and wanted to write better-looking code. But on retrospect, maybe:

  1. That’s not achievable.
  2. That’s not necessary, as this code isn’t that bad.
  3. The question is flawed because encountering this situation means I’m doing something wrong elsewhere in my design. I’ll need to give more context, but that is kind of out of the scope of my original post.

NodeField is the sum type representing the type of field in a node.

It resides in a NodeEdit type, which resides in the AppState. AppState is the global state containing all the necessary data. The app is very stateful so the majority of my functions are StateT AppState IO ().

This is where I applied the strategy I came up earlier for the situation I was struggling with. Up to line 90.

I cannot access your repo (techmindful/horrelate), maybe it is set to private?

As for your problem. If you are sure that you will only use this code in the context of three fixed actions then your approach looks good to me. But, I think it is often the case that you would want to add another action. With your code you would have to add a case to the algebraic data type that represents all your possible actions and you would have to add one of those case expressions.

In my suggestion I anticipated this and used a list of fields and an integer index into that list which can easily be extended without having to add additional ADT constructors and case statements. Your image that shows Gmail, Facebook and YouTube also suggests to me that you might want a varying amount of fields (e.g. if you want to add Twitter later).

1 Like

I am having a hard time thinking of a real life application with as few as three widgets, so the answer to the question as stated might be useless in the long run. At the same time, I think it is a very good question if considered in a wider sense. Looking into cases like this is an opportunity to practise in program construction and requirements discovery. But this means that we have to ask questions to the question itself.

There are 3 actions. All need to be performed. Based on the value of a variable, one of the action needs to be performed slightly differently. It needs to be substituted with a variant.

You think this is a simple statement of a simple problem. But it is not really. There are many ways to look at this description. For one, we may ask: what do we already know at compile time and what do we know only at run time? Or we may ask: are there really only 3 actions or are there actually 6 of them? Or even more?

Let us look at the first question. I am going to assume that we know at compile time what exact actions need to be performed in each of 3 cases. You correctly identify that a sum type of 3 values is an input, and the output is the execution of all actions in no particular order. This means that the type of the function we are looking for is ∀m. Applicative m ⇒ Var → m ( ). (I am choosing a constraint weaker than Monad to emphasize that all component actions are independently determined ahead of execution.) So, we want a function that chooses one of three possible composite actions.

The second question is now easy to answer. Saying that there are three component actions, each of which may be performed slightly differently, is of course a misnomer. This really means that there are 6 different component actions to choose from. But we are only interested in three specific combinations of these component actions — this is really specific! We would like to disallow any other combination. And there are 216 combinations of three from six, so we only allow about 1% of all possibilities.

This is where a Haskell programmer becomes suspicious. Like, can I actually stack the deck so that only these desirable possibilities are allowed? Observe that nothing prevents you from accidentally writing your code as:

data Var = A | B | C

case var of
  A -> do_A2
  _ -> do_B1

case var of
  B -> do_A2
  _ -> do_B1

case var of
  A -> do_C2
  _ -> do_C1

It is not immediate to spot the error (there are actually two). You are not protected by the type system in any way. So, you are right in judging that this code is not good enough!

Unfortunately, it is not trivial to design the types in such a way that correct code writes itself. I outlined some possible approaches above, such as using a zipper or a generalized algebraic type. Consider also that there is no decidable equality on IO actions — so we cannot really say that do_C2 is any different from do_A2 and so on. In the end, there has to be some code that defines these actions. The best we can do is make sure they are defined once and in the simplest possible way, so that the possibility of error is reduced. We can then add some phantom types to these component actions, so that we can distinguish actions that create editable and non-editable widgets on type level. Then we would construct a type that can only hold one editable widget at once, and three widgets total. We can also try to make sure that an editable widget of type A cannot become a non-editable widget of type B, and this refers us back to the question of how state transitions proceed. It would be interesting to see how far this project can be carried.

If you only need three widgets once and forever, the code you started with is fine — advanced type machinery begins to pay off at a larger scale, maybe at dozens of widgets, and over time. But, if your project is educational in nature, you may still want to put this effort in and try to do it now!

1 Like

This is how I would do it, which is of the same form as @kindaro was suggesting earlier

data Var = A | B | C

renderVar :: (Var, Bool) -> Whatever
renderVar = \case
  [(A, True)] -> do_A1
  [(A, False)] - do_A2
  [(B, True)] -> do_B1
  [(B, False)] -> do_B2
  [(C, True)] -> do_C1
  [(C, False)] -> do_C2

data Layout = [(Var, Bool)]

renderLayout :: Layout -> Whatever
renderLayout = mapM renderVar

Is there something wrong with this structure? Well yes, there is one thing: it doesn’t enforce the invariant that exactly one Var is enabled. That is most likely tolerable. Is there anything else wrong with it?

How about this?

import "fixed-vector" Data.Vector.Fixed.Boxed
import "fixed-vector" Data.Vector.Fixed (mk3)

data Var = A | B | C

render ∷ Var → IO ( )
render = sequence_ ∘ strategy

strategy ∷ Var → Vec 3 (IO ( ))
strategy A = mk3 do_A2 do_B1 do_C1
strategy B = mk3 do_A1 do_B2 do_C1
strategy C = mk3 do_A1 do_B1 do_C2

We already figured out that essentially we need to prescribe 3 out of 216 possible sequences of length 3 made of 6 possible actions, and then choose one of these 3 sequences at run time. So we may as well write this down plainly. For a cherry on top, we can nail the length of the sequence down on the type level — 3 it is!

I would still like to enforce that there is only one editable widget in a sequence, but it would require writing a bespoke data structure and it does not seem to worth the trouble.

How does this look to you @tomjaguarpaw?

I still don’t think I understand the problem well enough but I fear that any attempt use a sum type for this is doomed to be non-extensible and non-composable.

1 Like

My bad! I just changed the repo visibility. You can try accessing again, if you are still interested.

The code in your suggestion looks quite neat. And you are right that no extra code needs to be written, if the sum type grows. But I have to assume that the drawEditField needs to have a case expression that matches the different kinds of Fields? Because the hard part of the problem is that the editing of different fields are drawn differently. For example, editing the name draws an input box, and editing the age draws a drop down menu, etc. That’s going to make drawEditField a pretty big function, and it will have many responsibilities. Other than that, I wasn’t sure if I can maintain the integer well enough to translate it into which field is being edited.

What do you think about my current solution? First there is a dictionary here. Later on the dictionary is used here.

Hey I just noticed that the repo wasn’t public, thanks to @jaror. I changed its visibility just now. Sorry about that!

You wrote some very interesting analysis there. Your assumption about compile time knowledge looks right to me. You are right again that there is 63 possibilities, rather than 23, as shown in the incorrect code. Compiler can’t catch the mistakes there. This led me to think that the current solution I wrote here and here isn’t free of that kind of mistakes either. But hold on: The vector approach you wrote also isn’t free of that, is it?

So maybe more advanced usage of types is needed. I do need to set aside some time to study stuff like bifunctor, bifoldable, phantom types, vectors, etc. I will get back here when I’ve done that.

From another perspective, @jaror’s comment here seems to avoid the particular type of error mentioned above. But that code isn’t free of other downsides in my opinion. What do you think?

Anyway, now that the repo is accessible, maybe it’ll give more context.