[Haskell-cafe] ListT version leveraging Traversable
Juan Casanova
juan.casanova at ed.ac.uk
Sun Feb 2 20:27:40 UTC 2020
Hello haskell-cafe,
I am going to be stating a series of things about the way I understand
some things right now (both theoretical ideas and the general
consensus on the Haskell community about some topics). Please feel
free to point out to any of these assumptions if you think it is flawed.
1. ListT is deprecated as a Monad Transformer because for some monads
it is not a proper transformer.
2. (1) translates literally into the fact that the MonadTrans instace
for ListT is unlawful for some monads.
3. The fundamental concept of List as a monad is non-determinism, it
is the notion of doing operations on non-deterministic results and
generating new non-deterministic results.
4. A "correct" ListT transformer would therefore: 4.1. Be lawful. 4.2.
Represent the notion of non-deterministic results tied within the
monad they are transforming. 4.3. Be such that when applied to the
Identity monad it returns the original List monad.
5. There is no canonical and accepted by the community alternative to
ListT which fulfills both points in (4).
6. But there is no proof that (5) is a theoretically necessary thing.
I am putting this this way because what I am going to claim now is
that I have found one such transformer, that satisfies both points in
(4). Therefore, it is very likely that some of my assumptions are
flawed.
Note that I make no claim that my transformer is unique up to
isomorphism. It just seems that what I did does the job, but maybe
there are other *fundamentally distinct* ways to fulfill the two
points in (4)? Is that maybe the reason why there is no canonical
version of ListT? But then why haven't I seen any of those versions,
including the one I will present? (By the way, I already see different
versions, but which correspond to the same idea just traversing lists
in different orders. Permutations of it, so to speak).
So, onto what I've done. I am going to be using an example to explain
why I think what I did fulfills (4.2). This is not a proof, but I feel
that (4.2) is not a formal statement anyway (is there a formal way to
express this?).
The basic problem I see with implementing ListT correctly is that the
non-determinism produces non-deterministic monadic results, and
because we wish to keep the non-determinism only to the results and
not to the transformed monad itself, there is a need to choose what
monadic results we keep.
But then, I think, we have a "canonical" way of doing a collection of
monadic results: Traversals. And what a wonderful thing that lists are
the most natural version of Traversable. Therefore, what I did is to
use traverse (and concat, which relies on Foldable which is a
superclass of Traversable) to collect the monadic results and produce
something that fulfills the type signature that ListT should have.
Here's the code. The only really interesting bit is bind:
data TravListT m a = TravListT {runTravListT :: m [a]}
instance Functor m => Functor (TravListT m) where
fmap f (TravListT m) = TravListT (fmap (fmap f) m)
instance Applicative m => Applicative (TravListT m) where
pure x = TravListT (pure (pure x))
(TravListT fs) <*> (TravListT xs) = TravListT (getCompose ((Compose
fs) <*> Compose xs))
instance Monad m => Monad (TravListT m) where
return = pure
(TravListT ma) >>= f = TravListT (ma >>= (\l -> (concat <$> (traverse
(runTravListT . f) l))))
instance MonadTrans TravListT where
lift m = TravListT (return <$> m)
I also (believe) I have proof that TravListT is a lawful MonadTrans,
but I have skipped that here since this is already long enough. If you
want to talk about that, we can.
This allows me to do the things I would expect of a ListT, such as
having a stateful list [1,3,7,11], applying a stateful operation
wrapped around a Maybe monad that non-deterministically multiplies and
sums each result with the current state with a special case, and
increases the state by 1, and produce the stateful, non-deterministic
result of doing all of that:
let mposns = return [1,3,7,11] :: StateT a Maybe [Int]
let tmposns = TravListT mposns
let f = \n -> TravListT (StateT (\s -> if (s == n) then Nothing else
(Just ([s * n,s + n],s+1))))
let rr = tmposns >>= f
runStateT (runTravListT rr) 100
Just ([100,101,303,104,714,109,1133,114],104)
runStateT (runTravListT rr) 1
Nothing
So I guess my overall question is: why is this not a more standard
thing? Are any of my assumptions wrong? Is there something wrong with
this monad transformer? Is this really a new idea (I'd be surprised)?
Thanks and sorry for the long email,
Juan Casanova.
--
The University of Edinburgh is a charitable body, registered in
Scotland, with registration number SC005336.
More information about the Haskell-Cafe
mailing list