Control.MonadPlus.Free without unnecessary distribution

I'm trying to use a free monad to build an EDSL for constructing AND/OR decision trees like Prolog, with >>= mapped to AND, and mplus mapped to OR. I want to be able to describe something like A AND (B OR C) AND (D OR E), but I don't want distributivity to turn this into (A AND B AND D) OR (A AND B AND E) OR (A AND C AND D) OR (A AND C AND E). Ultimately, I want to transform the AND/OR nodes into reified constraints in a constraint solver, without causing the combinatorial explosion in the number of alternatives that I want the solver to deal with.

In Control.MonadPlus.Free, Plus ms >>= f causes f to be applied to each of the Pure leaves under each monad in ms. This is necessary because f may yield a different value for each Pure leaf that it replaces.

However, in Plus ms >> g, g cannot be affected by any of the leaves of ms, so distributing it over the Plus seems unnecessary.

Through trial and error, I found that I could extend the Control.MonadPlus.Free monad with a new Then constructor:

data Free f a = Pure a
              | Free (f (Free f a))
              | Then [Free f ()] (Free f a)
              | Plus [Free f a]

Here, the new Then constructor holds a sequence of monads whose value we ignore, followed by the final monad that yields the actual value. The new Monad instance looks like:

instance Functor f => Monad (Free f) where
    return = Pure

    Pure a >>= f = f a
    Free fa >>= f = Free $ fmap (>>= f) fa
    Then ms m >>= f = Then ms $ m >>= f
    Plus ms >>= f = Plus $ map (>>= f) ms

    Pure a >> mb = mb
    Then ms ma >> mb = Then (ms ++ [ma >>= (const $ return ())]) mb
    ma >> mb = Then [] ma >> mb

The >> operator "caps" any existing leaves by replacing Pure a with Pure (), appends the capped monad to the list, and replaces the value monad with the new one. I'm aware of the inefficiency of appending the new monad with ++, but I figure it's as bad as >>= stitching its new monad to the end of the chain with fmap (and the whole thing can be rewritten using continuations).

Does this seem like a reasonable thing to do? Does this violate the monad laws (does this matter?), or is there a better way to use the existing Control.Monad.Free?

Solution

You may want to have a look at my operational package, which is a different take on free monads.

In particular, have a look at the BreadthFirstParsing.hs example. It features an mplus operation so that >>= does not automatically distribute over it. This allows you to implement parser combinators in a breadth-first fashion.

Translated to Control.Monad.Free, the point is that if you use the functor

data F b = MZero | MPlus b b

then Free F will automatically distribute >>= over mplus. You have to use the functor

data F b = MZero | forall a. MPlus (Free f a) (Free f a) (a -> b)

instead, if you want to implement a semantics for MPlus that does not automatically distribute >>=. (This is the main reason why I prefer my operational library over the free library.)