-- | A module containing interleaving behaviour combinators. See the 'engage' -- function for some details and examples. A much fuller explanation of this -- entire library is provided in the forthcoming article in Issue 17 of The Monad -- Reader which will be published at <http://themonadreader.wordpress.com/>. module Control.Alternative.Interleave ( InterleaveT, engage, engageMany, alongside, alongside_, alongsideMerge, endAfter, endWhen, once, once_, upTo, upTo_, inOrder, inOrder_, unlimited, unlimited_, unlimitedRecurse, unlimitedRecurse_) where import Control.Applicative ((<$>), (<$), Alternative(..), Applicative(..)) import Data.Monoid (Monoid(mappend)) import Data.Traversable (sequenceA) -- | This data-type represents potentially-many actions in the @f@ -- 'Monad' / 'Alternative' that will result in returning a value of type @a@. -- See 'engage' for more details. -- -- The 'Functor' instance is straightforward. The '<*>' operator in the 'Applicative' instance -- runs the left-hand side and right-hand side 'alongside' each other, and afterwards -- it applies the left-hand function to the right-hand value. data InterleaveT f a = Terminate { result :: a } | NoMore { result :: a } | Continue { result :: a, _rest :: f (InterleaveT f a) } instance Functor f => Functor (InterleaveT f) where fmap f (Terminate x) = Terminate (f x) fmap f (NoMore x) = NoMore (f x) fmap f (Continue x m) = Continue (f x) (fmap f <$> m) instance Alternative f => Applicative (InterleaveT f) where pure = NoMore (<*>) a b = uncurry ($) <$> (a `alongside` b) -- | Acts like the given item, but when it has no more actions to take, ends the entire call to 'engage'. -- So this code: -- -- > engage $ unlimited p `alongside` endAfter (once q) -- -- Will terminate after @q@ occurs. In contrast, this code: -- -- > engage $ unlimited p `alongside` once q -- -- will never terminate because it can always offer to perform q. endAfter :: Functor f => InterleaveT f a -> InterleaveT f a endAfter (NoMore x) = Terminate x endAfter (Terminate x) = Terminate x endAfter (Continue x m) = Continue x (endAfter <$> m) -- | Acts like the given item, but when the current result value satisfies the -- given function (i.e. applying the function yields 'True'), ends the entire call -- to 'engage'. endWhen :: Functor f => (a -> Bool) -> InterleaveT f a -> InterleaveT f a endWhen _ (Terminate x) = Terminate x endWhen f (NoMore x) = if f x then Terminate x else NoMore x endWhen f (Continue x m) = if f x then Terminate x else Continue x (endWhen f <$> m) -- | Offers the given behaviour, and when it occurs, does not offer it again. -- Returns @Just@ the result if the behaviour happens, otherwise gives @Nothing@. -- -- @once m@ is equivalent to @listToMaybe \<$\> upTo 1 m@ (and thus also @listToMaybe -- \<$\> inOrder [m]@). once :: Functor f => f a -> InterleaveT f (Maybe a) once m = Continue Nothing (NoMore . Just <$> m) -- | Like 'once' but discards the result. once_ :: Functor f => f a -> InterleaveT f () once_ m = Continue () (NoMore () <$ m) -- | Offers the given behaviour up to the given number of times, returning a list -- of the results (in chronological order, earliest first). -- -- @upTo n@ is equivalent to @inOrder . replicate n@. upTo :: Functor f => Int -> f a -> InterleaveT f [a] upTo n = inOrder . replicate n -- | Like 'upTo', but discards the results. upTo_ :: Functor f => Int -> f a -> InterleaveT f () upTo_ n = inOrder_ . replicate n -- | Offers the given list of items, in order. inOrder :: Functor f => [f a] -> InterleaveT f [a] inOrder [] = NoMore [] inOrder (m:ms) = Continue [] ((\x -> (x:) <$> inOrder ms) <$> m) -- | Like 'inOrder', but discards the results. inOrder_ :: Functor f => [f a] -> InterleaveT f () inOrder_ [] = NoMore () inOrder_ (m:ms) = Continue () (inOrder_ ms <$ m) -- | Repeatedly offers the given behaviour. A list is returned (in chronological order, -- earliest first) of the results of each occurrence of the behaviour. If you -- don't want these results, it is better to use 'unlimited_' to avoid a space -- leak. -- -- @unlimited@ is equivalent to @inOrder . repeat@. unlimited :: Functor f => f a -> InterleaveT f [a] unlimited m = let b = Continue [] ((\x -> (x:) <$> b) <$> m) in b -- | Like 'unlimited', but discards the output. Useful if the event is likely -- to occur many times, and you don't need the results. unlimited_ :: Functor f => f a -> InterleaveT f () unlimited_ m = let b = Continue () (b <$ m) in b -- | Like 'unlimited', but allows some state (of type @a@) to be passed from one -- subsequent call to another, as well as generating the results of type @b@. -- To begin with the function (first parameter) will be called with the initial -- state (second parameter). If chosen, it will return the new state, and a result -- to be accumulated into the list. The second call to the function will be passed -- the new state, to then return the even newer state and a second result, and -- so on. -- -- If you want to use this with the StateT monad transformer from the mtl library, -- you can call: -- -- > unlimitedRecurse (runStateT myStateAction) initialState -- > where -- > myStateAction :: StateT s m a -- > initialState :: s unlimitedRecurse :: Functor f => (a -> f (b, a)) -> a -> InterleaveT f [b] unlimitedRecurse f = let b x = Continue [] ((\(r, y) -> (r :) <$> b y) <$> f x) in b -- | Like 'unlimitedRecurse', but does not accumulate a list of results. -- -- If you want to use this with the StateT monad transformer from the mtl library, -- you can call: -- -- > unlimitedRecurse (execStateT myStateAction) initialState -- > where -- > myStateAction :: StateT s m a -- > initialState :: s unlimitedRecurse_ :: Functor f => (a -> f a) -> a -> InterleaveT f () unlimitedRecurse_ f = let b x = Continue () (b <$> f x) in b -- | Offers one behaviour alongside another. -- -- This operation is semantically associative and commutative. alongside :: Alternative f => InterleaveT f a -> InterleaveT f b -> InterleaveT f (a, b) alongside oa@(Continue a fa) ob@(Continue b fb) = Continue (a, b) ((flip alongside ob <$> fa) <|> (alongside oa <$> fb)) alongside (NoMore a) ob = (,) a <$> ob alongside oa (NoMore b) = flip (,) b <$> oa alongside oa ob = Terminate (result oa, result ob) -- | Like 'alongside' but merges the results with 'mappend' afterwards. -- -- @alongsideMerge a b@ is equivalent to @uncurry mappend \<$\> (a \`alongside\` b)@ -- and @liftA2 mappend a b@. alongsideMerge :: (Alternative f, Monoid a) => InterleaveT f a -> InterleaveT f a -> InterleaveT f a alongsideMerge a b = uncurry mappend <$> alongside a b -- | Like 'alongside' but discards the results. alongside_ :: Alternative f => InterleaveT f a -> InterleaveT f b -> InterleaveT f () alongside_ (Continue _ fa) (Continue _ fb) = Continue () ((blank <$> fa) <|> (blank <$> fb)) alongside_ (NoMore _) b = blank b alongside_ a (NoMore _) = blank a alongside_ _ _ = Terminate () blank :: Functor f => f a -> f () blank = (() <$) infixr `alongside` infixr `alongside_` infixr `alongsideMerge` -- | Offers the given behaviour until either the finite set of actions is exhausted, -- or one of the explicit termination constructs is triggered. -- -- For example: -- -- > engage $ unlimited p `alongside` unlimited q -- -- will repeatedly offer @p@ and @q@ without ever terminating. -- -- > engage $ upTo 3 p `alongside` upTo 5 q -- -- will do @p@ three times and @q@ 5 times (in any mixed order) then finish. -- -- > engage $ unlimited p `alongside` unlimited q `alongside` endAfter (once r) -- -- will offer p repeatedly and q repeatedly and r, until r happens, at which point -- the behaviour will end. -- -- > engage $ once p `alongside` endAfter (once q) -- -- will offer p and q; if p happens first it will wait for q, but if q happens -- first it will finish. -- -- > engage $ once p `alongside` endAfter (once q) `alongside` endAfter (once r) -- -- permits p to happen at most once, while either of q or r happening will finish -- the call. -- -- All sorts of combinations are possible, but it is important to note that you -- need at least one 'endAfter' or 'endWhen' event if you ever intend a call involving -- 'unlimited' (or similar) to finish. Some -- laws involving 'engage' (ignoring the types and return values) are: -- -- > engage (unlimited p) == forever p -- > engage (once p) == Just <$> p -- > engage (endAfter (once p)) == engage (once p) -- > engage (endAfter (once p) `alongside` endAfter (once q)) == p <|> q -- -- Most other uses of 'engage' and 'alongside' do not reduce down to simple -- programs, which is of course the attraction of the combinators. engage :: Monad f => InterleaveT f a -> f a engage (Terminate x) = return x engage (NoMore x) = return x engage (Continue _ m) = m >>= engage -- | Offers all the given behaviours together, and gives back a list of the outcomes. -- -- This is roughly a shorthand for @engage . foldr1 alongside@, except that if you -- pass the empty list, you simply get the empty list returned (rather than an -- error) engageMany :: (Monad f, Alternative f) => [InterleaveT f a] -> f [a] engageMany = engage . sequenceA