Stateful computation with different types of short-circuit (Maybe, Either)

Question

I am trying to find the most elegant way of converting the following stateful imperative piece of code to pure functional representation (preferably in Haskell to use abstraction that its Monad implementation offers). However I am not yet good at combining different monads using transformers and the like. It seems to me, that analyzing other's takes on such tasks helps the best when learning how to do it myself. The imperative code:

while (true) {
  while (x = get()) { // Think of this as returning Maybe something
    put1(x) // may exit and present some failure representation
  }
  put2() // may exit and present some success representation
}

When get returns Nothing we need the execution to continue with put2, when get returns Just x we want the x to get passed to put1 and short-circuit only if put1 fails or loop otherwise. Basically put1 and put2 may terminate the whole thing or move to the following statement changing the underlying state somehow. get can either succeed and invoke put1 and loop or fail and continue to put2.

My idea was something along:

forever $ do
  forever (get >>= put1)
  put2

And why I was looking for something like that is because (get >>= put1) could simply short-circuit whenever get has nothing to return or put1 terminates. Similarly put2 terminates the outer loop. However I am not sure how to mix the State with the necessary Maybe and/or Either to achieve this.

I think using transformers to combine State and the other monads is necessary and thus the code will most probably not be that succint. But I guess it as well might not be much worse.

Any suggestion how to achieve the translation elegantly is welcome. This differs from "Stateful loop with different types of breaks" in avoiding explicit control-flow using if, when, while and rather tries to encourage use of Maybe, Either, or some other handy >>= semantics. Also there is always a straight-forward way how to translate the code into a functional one, however it can hardly be considered elegant.

Surratt

You need to mix failure "powers" in, too. This will look like EitherT or MaybeT and so you'll want to look into monad transformer stacks. Or! If you just want to explore, take a look at this monad: data M e s a = M { runM :: e -> Either e (s, a) } noting that it instantiates MonadState s. – Trinatte

Try to rewrite your original piece of code so that it doesn't use exit(). Can you how to do the functional equivalent of that now? – Norbert

possible duplicate of Stateful loop with different types of breaks - where is the difference? – Norbert

it is a refined version of the original question, the difference lies in removing the control-flow and rather chaining the operations directly, allowing them to fail. Now the exchanged information is not simply True, False but Maybe something giving rise to a different chaining. The put1 and put2 do not seem to offer an easy way of being rewritten to not cause the main function to return. The answers to the original question did involve a lot of if-then-else like code, this is an attempt to use >>= of Maybe and Either instead. – Surratt

@JakubDaniel: Ah, thanks for the edits! – Norbert

When put1 fails, do you want it to exit just the inner while loop or do you want it to exit both while loops? – Obtrude

Good question, I will change this in the original post. put1 and put2 are supposed to terminate the whole computation while get may produce Nothing which skips put1 and breaks the inner loop. – Surratt

I would recommend that you start by writing the whole thing out in Haskell by hand (without funny business like exit or especially error). That will give you a better sense of what the pretty abstractions you want actually need to support. – Panteutonism

I don't understand, the exit is what makes the concept hard for me. Writing actions over State monad is something I already did. Now I realize that I have problem allowing some of the actions also behave exceptionally. – Surratt

Answer 1

You are looking for EitherT or ExceptT. It adds two ways to return to a transformer stack. The computation can either return a or throwError e. There are two differences between errors and returns. Errors are held on the Left and returns on the Right. When you >>= onto an error it short circuits.

newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) }

return :: a -> EitherT e m a
return a = EitherT $ return (Right a)

throwError :: e -> EitherT e m a
throwError e = EitherT $ return (Left a)

We will also use the names left = throwError and right = return.

Errors on the Left don't continue, we will use them to represent exiting from a loop. We will use the type EitherT r m () to represent a loop that either stops with a breaking result Left r or continues with a Right (). This is almost exactly forever, except we unwrap the EitherT and get rid of the Left around the returned value.

import Control.Monad
import Control.Monad.Trans.Either

untilLeft :: Monad m => EitherT r m () -> m r
untilLeft = liftM (either id id) . runEitherT . forever   

We'll come back to how to use these loops after fleshing out your example.

Since you want to see almost all of the logic disappear, we'll use EitherT for everything else too. The computation that gets data is either Done or returns the data.

import Control.Monad.Trans.Class
import Control.Monad.Trans.State

data Done = Done       deriving Show

-- Gets numbers for a while.
get1 :: EitherT Done (State Int) Int
get1 = do
    x <- lift get
    lift . put $ x + 1
    if x `mod` 3 == 0
    then left Done
    else right x

The first computation that puts data is either a Failure or returns.

data Failure = Failure deriving Show

put1 :: Int -> EitherT Failure (State Int) ()
put1 x = if x `mod` 16 == 0
         then left Failure
         else right ()

The second computation that puts data is either a Success or returns.

data Success = Success deriving Show

put2 :: EitherT Success (State Int) ()
put2 = do 
        x <- lift get
        if x `mod` 25 == 0
        then left Success
        else right ()

For your example, we will need to combine two or more computations that both stop exceptionally in different ways. We will represent this with two nested EitherTs.

EitherT o (EitherT i m) r

The outer EitherT is the one we are currently operating over. We can convert an EitherT o m a to an EitherT o (EitherT i m) a by adding an extra EitherT layer around every m^†.

over :: (MonadTrans t, Monad m) => EitherT e m a -> EitherT e (t m) a
over = mapEitherT lift

The inner EitherT layer will be treated just like any other underlying monad in the transformer stack. We can lift an EitherT i m a to an EitherT o (EitherT i m) a

We can now build an overall computation that either succeeds or fails. Computations that would break the current loop are operated over. Computations that would break an outer loop are lifted.

example :: EitherT Failure (State Int) Success
example =
    untilLeft $ do
        lift . untilLeft $ over get1 >>= lift . put1
        over put2

Overall Failure is lifted twice into the innermost loop. This example is sufficiently interesting to see a few different results.

main = print . map (runState $ runEitherT example) $ [1..30]

---

^†If EitherT had an MFunctor instance, over would just be hoist lift, which is a pattern that is used so often it deserves its own well thought out name. Incidentally, I use EitherT over ExceptT primarily because it has a less loaded name. Whichever one provides an MFunctor instance first will, for me, finally win out as the either monad transformer.

Barnardo

except ghc complains there is no Control.Monad.Trans.Either :( – Surratt

@JakubDaniel, I think that's in the either package. Recent versions of transformers have Control.Monad.Trans.Except, which is pretty much the same. – Panteutonism

If you use ExceptT instead of EitherT replace all of the lefts with throwE, the rights with return, runEitherT with runExceptT, and mapEitherT with mapExceptT. – Barnardo

what version of ghc (I am assuming these modules come with it) do you have? Or is it the transformers? again what version should I have? – Surratt

transformers and either are both packages you can install. running cabal update and then cabal install either will install both of them. – Barnardo

Answer 2

However I am not yet good at combining different monads using transformers and the like.

You do not really need to combine different monads with combinators, you only need to explicitly embed the Maybe monad in the State monad. Once this is done, translating the snippet is straightforward, replacing loops by mutually recursive functions – the mutuality implements the branching conditions.

Let us write a solution this with OCaml and the sparkling monad library Lemonade where the State monad is called Lemonade_Success.

So, I assume that the type representing errors returned by put1 and put2 is a string, representing a diagnostic message, and we instantiate the Success monad on the String type:

Success =
  Lemonade_Success.Make(String)

Now, the Success module represents monadic computation which can fail with a diagnostic. See below for the complete signature of Success. I write the translation of the snippet above, as a functor parametrised by your data, but of course, you can shortcut this and directly uses the implementation definition. The data of your problem is described by a module Parameter having the signature P

module type P =
sig
    type t
    val get : unit -> t option
    val put1 : t -> unit Success.t
    val put2 : unit -> unit Success.t
end

A possible implementation of the snippet above would be

module M(Parameter:P) =
struct
    open Success.Infix

    let success_get () =
      match Parameter.get () with
        | Some(x) -> Success.return x
        | None -> Success.throw "Parameter.get"

    let rec innerloop () =
      Success.catch
        (success_get () >>= Parameter.put1 >>= innerloop)
        (Parameter.put2 >=> outerloop)
    and outerloop () =
      innerloop () >>= outerloop
end

The function get_success maps the Maybe monad to the Success monad, providing an ad-hoc error description. This is because you need this ad-hoc error description that you will not be able to do this transformation using only abstract monad combinators – or, to phrase this, more pedantically, there is no canonical mapping from Maybe into State because these mappings are parametrised by an error description.

Once the success_get function is written, it is pretty straightforward to translate the branching conditions you described using mutually recursive functions and the Success.catch function, used to handle error conditions.

I leave you the implementation in Haskell as an exercise. :)

---

The complete signature of the Success module is

  module Success :
  sig
    type error = String.t
    type 'a outcome =
      | Success of 'a
      | Error of error
    type 'a t
    val bind : 'a t -> ('a -> 'b t) -> 'b t
    val return : 'a -> 'a t
    val apply : ('a -> 'b) t -> 'a t -> 'b t
    val join : 'a t t -> 'a t
    val map : ('a -> 'b) -> 'a t -> 'b t
    val bind2 : 'a t -> 'b t -> ('a -> 'b -> 'c t) -> 'c t
    val bind3 : 'a t -> 'b t -> 'c t -> ('a -> 'b -> 'c -> 'd t) -> 'd t
    val bind4 :
      'a t -> 'b t -> 'c t -> 'd t -> ('a -> 'b -> 'c -> 'd -> 'e t) -> 'e t
    val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
    val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t
    val map4 :
      ('a -> 'b -> 'c -> 'd -> 'e) -> 'a t -> 'b t -> 'c t -> 'd t -> 'e t
    val dist : 'a t list -> 'a list t
    val ignore : 'a t -> unit t
    val filter : ('a -> bool t) -> 'a t list -> 'a list t
    val only_if : bool -> unit t -> unit t
    val unless : bool -> unit t -> unit t
    module Infix :
      sig
        val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
        val ( <$> ) : ('a -> 'b) -> 'a t -> 'b t
        val ( <* ) : 'a t -> 'b t -> 'a t
        val ( >* ) : 'a t -> 'b t -> 'b t
        val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
        val ( >> ) : 'a t -> (unit -> 'b t) -> 'b t
        val ( >=> ) : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t
        val ( <=< ) : ('b -> 'c t) -> ('a -> 'b t) -> 'a -> 'c t
      end
    val throw : error -> 'a t
    val catch : 'a t -> (error -> 'a t) -> 'a t
    val run : 'a t -> 'a outcome
  end

In order to stay succinct, I removed some type annotations and hid the natural transformation T from the signature.

Etan

Thank you for your reply. Honestly this is the first time I see OCaml so I cannot judge the answer. Hopefully I will decode it one day :) – Surratt

If you can read Haskell you can probably not write OCaml but could be fine reading it. (I do not know Haskell but can more or less read it). The signature expresses type constraints (IIRC this is what :: are for in Haskell). The functor is maybe new to you because it is parametrised by a module, but you can more or less forget about it – just assume it is a macro of some sort. So now, there is only the let rec… and … which needs to be explained, and this is how mutually recursive functions are defined. – Canister

I am just starting to learn Haskell so I would not say I can read it (I get lost in the level of abstraction occasionally) – Surratt

@JakubDaniel, note also that ML applies type constructors backwards, so int list is a list of ints. An option is a Maybe, with Some and None. – Panteutonism

Answer 3

Your question is a bit tricky, because you are asking an elegant way of something which is not really elegant. There is the Control.Monad.Loops to write that type of loops. You'll probably need something like whileJust' or equivalent. Usually, we don't need to write while loops like that and plain old recursion is usually easiest.

I tried to find an example of when I would need this type of code and I came with the following example. I want to build a list of list of strings entered by the user. Each line correspond to an entry in the list. An empty line starts a new list, and two empty lines stops the loop.

Example

a
b
c

d
e

f

Will give

[ ["a", "b", "c"
, ["d", "e"]
, ["f"]
]

I would probably do the following in haskell

readMat :: IO [[String]]
readMat = reverse `fmap` go [[]]
    where go sss = do
                s <- getLine
                case s of
                    "" -> case sss of
                        []:sss' -> return sss' # the end
                        _ -> go ([]:sss)       # starts a new line
                    _ -> let (ss:ss') = sss
                          in go ((ss ++ [s]):ss')

Just plain recursion.

Hectocotylus

Answer 4

This might overlap a bit with @Cirdec 's answer, but it also might help you gain a better perspective of what's going on.

The first thing to notice is that you really don't have doublely-nested loops. Without the exit statements, here is how you could write it as a simple loop:

example1 = forever $ do
  x <- getNext                -- get the next String
  if (isPrefixOf "break-" x)  -- do we break out of the "inner" loop?
    then put2 x
    else put1 x
  where
    put1 x = putStrLn $ "put1: " ++ x
    put2 x = putStrLn $ "put2: " ++ x

So now we just use the standard technique of using runEitherT for breaking out of a loop.

First some imports:

import Control.Monad
import Control.Monad.Trans.Either
import Control.Monad.State.Strict
import Data.List

and our result type and a convenience function:

data Result = Success String | Fail String deriving (Show)

exit = left

We then rewrite our loop lifting any IO actions and use exit when we want to break out of the loop:

example2 match =
  let loop = runEitherT $ forever $ do
        x <- getNext
        if isPrefixOf "break-" x
          then put2 x
          else put1 x
        where
          put1 "fail" = exit (Fail "fail encountered")
          put1 x      = liftIO $ putStrLn $ "put1: " ++ x

          put2 x      = if x == match
                          then exit (Success $ "found " ++ match)
                          else liftIO $ putStrLn $ "put2: " ++ x
  in loop

Here are some tests:

-- get next item from the state list:
getNext = do (x:xs) <- get; put xs; return x

test2a = evalStateT (example2 "break-foo") [ "a", "b", "fail" ]
test2b = evalStateT (example2 "break-foo") [ "a", "b", "break-foo", "c", "fail" ]
test2c = evalStateT (example2 "break-foo") [ "a", "b", "break-xxx", "c", "fail" ]

The output of these tests are:

ghci> test2a
put1: a
put1: b
Left (Fail "fail encountered")

ghci> test2b
put1: a
put1: b
Left (Success "found break-foo")

ghci> test2c
put1: a
put1: b
put2: break-xxx
put1: c
Left (Fail "fail encountered")

In this example the returned value of runEitherT will always be Left r where r is the Result value, so the code calling one of these examples might look like:

Left r <- test2a
case r of
  Success ... ->
  Fail    ... -> 

Note that instead of a custom Result type you could just use Either String String:

type Result = Either String String

and use Left for Fail and Right for Success.

Obtrude

What about execution along the lines (get >>= put1) >> put2? I think that is not supported by your translation into a single loop. For every invocation of put2 you seem to require to consume input with get without passing it to put1, but what if there is one entry in the input that has to trigger both put1 and put2? i.e. there is input which lets you into the first loop and put1 is executed, which modifies the state so that no other entry is discovered and put2 is executed. – Surratt

I think my answer is valid for the loop you have at the top of your question. Let me know if I am mistaken. If you have a different loop in mind let's discuss that in separate question. – Obtrude

Hmmm.. perhaps we were both confused for a moment. Here's the deal: I am assuming that put1 can exit but if it does it exits both loops. This is one of the reasons why I asked that question in the comments. If put1 can exit just the inner loop then you can have get followed by put1 followed by put2. So I think my answer is valid if put1 either exits both loops or returns back to get. – Obtrude

But still, you introduce branching. My idea was that in my case the more important thing is that there is cycle that fetches data and reacts to them in some way. It does so while there are such data. And every time we are done with this we also perform some cleanup. the exact conditions can be hidden and abstracted away. What is important for me and for the readability in my case is the chaining of actions. If that makes sense. – Surratt

You were right with the transformation, I got confused for a while. – Surratt