<div dir="ltr">Thanks very much! I'll look at it in detail.<div><br></div><div>D</div></div><div class="gmail_extra"><br><div class="gmail_quote">On Thu, Aug 24, 2017 at 10:30 PM, John Wiegley <span dir="ltr"><<a href="mailto:johnw@newartisans.com" target="_blank">johnw@newartisans.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><span class="">>>>>> "DR" == Dennis Raddle <<a href="mailto:dennis.raddle@gmail.com">dennis.raddle@gmail.com</a>> writes:<br>
<br>
</span>DR> I'm an advanced beginner, and I'm finding it hard to comprehend<br>
DR> Data.Machine.Moore. Is there a way to explain more to me how this would<br>
DR> look in practice? Or is there another way to organize it that is less<br>
DR> "computer-sciency" and I could work with more easily?<br>
<br>
Thinks of a Moore machine as a packaged up State function, where you have an<br>
initial state, and the type of that state is hidden within the machine.  For<br>
example:<br>
<br>
    {-# LANGUAGE ExistentialQuantification #-}<br>
<br>
    data Moore i m o = forall s. Moore<br>
        { mooreInit :: s<br>
        , mooreFunc :: i -> StateT s m o<br>
        }<br>
<br>
This machine is really just a packaged function, yielding outputs from inputs,<br>
while dependent on an internal state that may vary at each call.<br>
<br>
Since the state is "existential" (or private to Moore), it can be changed<br>
freely when you combine machines:<br>
<br>
    instance (Monad m, Monoid o) => Monoid (Moore i m o) where<br>
        mempty = Moore () (const (return mempty))<br>
        Moore s1 f1 `mappend` Moore s2 f2 = Moore (s1, s2) go<br>
          where<br>
            go ev = StateT $ \(st1, st2) -> do<br>
                (mres, st1')  <- runStateT (f1 ev) st1<br>
                (mres', st2') <- runStateT (f2 ev) st2<br>
                return (mres <> mres', (st1', st2'))<br>
<br>
Something like this could serve your needs, without needing an external<br>
package like 'machines'. I've used it to do almost just what you described<br>
initially.<br>
<div class="HOEnZb"><div class="h5"><br>
--<br>
John Wiegley                  GPG fingerprint = 4710 CF98 AF9B 327B B80F<br>
<a href="http://newartisans.com" rel="noreferrer" target="_blank">http://newartisans.com</a>                          60E1 46C4 BD1A 7AC1 4BA2<br>
</div></div></blockquote></div><br></div>