From 3e44ced42eaf226d2fe0f00be02317c43253cb7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dan=20Ros=C3=A9n?= Date: Thu, 7 Feb 2013 15:12:39 +0100 Subject: [PATCH] Add the free monad instance for Tree --- Control/Concurrent/STM/Promise/Tree.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Control/Concurrent/STM/Promise/Tree.hs b/Control/Concurrent/STM/Promise/Tree.hs index a541934..0702187 100644 --- a/Control/Concurrent/STM/Promise/Tree.hs +++ b/Control/Concurrent/STM/Promise/Tree.hs @@ -39,6 +39,13 @@ data Tree a -- ^ There is a mean of recovering this computation, by returning mempty deriving (Eq, Ord, Show, Typeable, Traversable, Foldable, Functor) +-- The free monad over the underlying structure +instance Monad Tree where + return = Leaf + Leaf x >>= f = f x + Node l u v >>= f = Node l (u >>= f) (v >>= f) + Recoverable t >>= f = Recoverable (t >>= f) + -- | All of these must succeed requireAll :: [Tree a] -> Tree a requireAll = foldr1 (Node Both)