<div dir="ltr">Well I figured out that I should be using the State monad, but it seems not to be behaving like most of the tutorials on the web. Did the syntax change? ....<div><br></div><div><div><font face="courier new, monospace">type SankeyState = (P2,CircleFrac,Double) </font></div>
<div><font face="courier new, monospace">type SankeyPic = (Trail R2, Trail R2)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">type Sankey = State SankeyState SankeyPic</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">saBlank :: Sankey</font></div><div><font face="courier new, monospace">saBlank = return (mempty, mempty)</font></div><div>
<font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">saVia :: Double -&gt; Sankey</font></div><div><font face="courier new, monospace">saVia l = state (</font></div><div><font face="courier new, monospace">  \(p,a,w) -&gt; </font></div>
<div><font face="courier new, monospace">    ( </font></div><div><font face="courier new, monospace">      ( hrule l    # translateX 0.5 # translateY (w/2)  # rotate a</font></div><div><font face="courier new, monospace">      , hrule (-l) # translateX 0.5 # translateY (-w/2) # rotate a</font></div>
<div><font face="courier new, monospace">      ) </font></div><div><font face="courier new, monospace">      , (p .+^ (unitX # scale l # rotate a),a,w) </font></div><div><font face="courier new, monospace">    )</font></div>
<div><font face="courier new, monospace">  ) </font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">saTo :: Sankey</font></div><div><font face="courier new, monospace">saTo = state ( </font></div>
<div><font face="courier new, monospace">  \(p,a,w) -&gt;  </font></div><div><font face="courier new, monospace">    ( </font></div><div><font face="courier new, monospace">      ( hrule w    # translateX (w/2) # translateY (w/2)  # rotate (-1/8::CircleFrac) #  scale (0.7071) # rotate a # translate (origin .-. p)</font></div>
<div><font face="courier new, monospace">      , hrule (-w) # translateX (w/2) # translateY (-w/2) # rotate  (1/8::CircleFrac) #  scale (0.7071) # rotate a # translate (origin .-. p)</font></div><div><font face="courier new, monospace">      )</font></div>
<div><font face="courier new, monospace">    , (p,a,w)</font></div><div><font face="courier new, monospace">    )</font></div><div><font face="courier new, monospace">  )</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">x :: SankeyPic</font></div><div><font face="courier new, monospace">x = evalState ( saTo )              (origin, 0, 5) -- works and looks nice</font></div><div><font face="courier new, monospace">--x = evalState ( saVia 10 )          (origin, 0, 5) -- works but not much to see</font></div>
<div><font face="courier new, monospace">--x = evalState ( saVia 10 &gt;&gt;= saTo ) (origin, 0, 5) -- barfs with something unintelligible</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">pic3 = strokeT ( close ( fst x &lt;&gt; snd x)) # fc red</font></div>
</div><div><br></div><div style>The unintelligible bit is:</div><div style><br></div><div style><div><font face="courier new, monospace">    Couldn&#39;t match expected type `SankeyPic</font></div><div><font face="courier new, monospace">                                  -&gt; StateT SankeyState Data.Functor.Identity.Identity SankeyPic&#39;</font></div>
<div><font face="courier new, monospace">                with actual type `Sankey&#39;</font></div><div><font face="courier new, monospace">    In the second argument of `(&gt;&gt;=)&#39;, namely `saTo&#39;</font></div><div>
<font face="courier new, monospace">    In the first argument of `evalState&#39;, namely `(saVia 10 &gt;&gt;= saTo)&#39;</font></div><div><font face="courier new, monospace">    In the expression: evalState (saVia 10 &gt;&gt;= saTo) (origin, 0, 5)</font></div>
<div><br></div><div style>TIA,</div><div style>Adrian.</div><div style><br></div><div style><br></div></div></div><div class="gmail_extra"><br><br><div class="gmail_quote">On 31 May 2013 21:16, Adrian May <span dir="ltr">&lt;<a href="mailto:adrian.alexander.may@gmail.com" target="_blank">adrian.alexander.may@gmail.com</a>&gt;</span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr">Hi all,<div><br></div><div>Take a look at this disaster area, or just scroll down to where I come to the point...</div>
<div><br></div><div>=======================</div><div><font face="courier new, monospace"><br>
</font></div>
<div><div><font face="courier new, monospace">type SankeyBrain = (P2,CircleFrac,Double) -- like a turtle plus width</font></div><div><font face="courier new, monospace">data SankeyWorld tb = SankeyWorld ((Trail R2,Trail R2),tb) --outgoing and returning trails, plus brain</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">
emptySankey :: SankeyWorld SankeyBrain</font></div><div><font face="courier new, monospace">emptySankey = SankeyWorld ((mempty,mempty),(origin,0,0))</font></div><div><font face="courier new, monospace"><br></font></div><div>

<font face="courier new, monospace">sankeyFrom:: CircleFrac -&gt; Double -&gt; SankeyWorld SankeyBrain</font></div><div><font face="courier new, monospace">sankeyFrom a w = SankeyWorld ((mempty,mempty),(p2 (0,0),a,w)) -- kick off with an angle and width</font></div>


<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">instance Monad SankeyWorld where</font></div><div><font face="courier new, monospace">  return a = SankeyWorld ((mempty,mempty), a) --never use this</font></div>

<div><font face="courier new, monospace">  (SankeyWorld l) &gt;&gt;= f = let (SankeyWorld r) = f (snd l) in -- out = left then right, return = right then left</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap">                </span>SankeyWorld ( (((fst.fst) l &lt;&gt; (fst.fst) r),((snd.fst) r &lt;&gt; (snd.fst) l)),(snd r)   )</font></div><div><font face="courier new, monospace"><br>

</font></div><div><font face="courier new, monospace">sankeyVia :: Double -&gt; SankeyBrain -&gt; SankeyWorld SankeyBrain</font></div>
<div><font face="courier new, monospace">sankeyVia d (p,a,w) = </font></div><div><font face="courier new, monospace">  let -- draw parallel lines and move them into place</font></div><div><font face="courier new, monospace">    l1 = hrule 1 # scaleX d    # translateX (d/2) # translateY (w/2)  # rotate a # translate (origin .-. p) </font></div>

<div><font face="courier new, monospace">
    l2 = hrule 1 # scaleX (-d) # translateX (d/2) # translateY (-w/2) # rotate a # translate (origin .-. p) </font></div><div><font face="courier new, monospace">  in SankeyWorld ( ( l1 , l2 ) , ( p .+^ (unitX # scale d # rotate a), a, w) )</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">
sankeyTo :: SankeyBrain -&gt; SankeyWorld SankeyBrain</font></div><div><font face="courier new, monospace">sankeyTo (p,a,w) = SankeyWorld ( --arrow at the end of the flow</font></div><div><font face="courier new, monospace">  ( hrule w    # translateX (w/2) # translateY (w/2)  # rotate (-1/8::CircleFrac) #  scale (0.7071) # rotate a # translate (origin .-. p)</font></div>


<div><font face="courier new, monospace">  , hrule (-w) # translateX (w/2) # translateY (-w/2) # rotate  (1/8::CircleFrac) #  scale (0.7071) # rotate a # translate (origin .-. p)</font></div><div><font face="courier new, monospace">  ), (p,a,w)) </font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">sankeyTurn r a&#39; (p,a,w) = let (outr, inr, qu) = if a&#39;&gt;=0 then (r, -w-r, -0.25::CircleFrac) else (-w-r, r, 0.25::CircleFrac) in</font></div>


<div><font face="courier new, monospace">  SankeyWorld ( -- turn a corner with nice round edges</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap">        </span>( arc&#39; outr (a+qu) (a+a&#39;+qu)  # translate (unitY # rotate (a+a&#39; )# scale w)</font></div>

<div><font face="courier new, monospace">  , arc&#39; inr  (a+a&#39;+qu) (a+qu) # translate (unitY # rotate (a+a&#39; )# scale w)</font></div>
<div><font face="courier new, monospace">  ),(p,a+a&#39;,w))</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">-- bump...</font></div><div><font face="courier new, monospace">sankeySplit :: [(Double, SankeyBrain -&gt; SankeyWorld SankeyBrain)] -&gt; SankeyBrain -&gt; SankeyWorld SankeyBrain</font></div>

<div><font face="courier new, monospace">sankeySplit fs (p,a,w) = let (placed,_) = ( foldl ( \(l,t) -&gt; \(i,c) -&gt; ( l++[( ( p .+^ (unitY # rotate a # scale (((t+i/2)-0.5)*w)), a, w*i) ,c )],t+i) ) ([],0) fs ) in </font></div>


<div><font face="courier new, monospace"><span style="white-space:pre-wrap">        </span>foldl (\(SankeyWorld ((lo,lr),lb)) -&gt; \(SankeyWorld ((ro,rr),rb)) -&gt; SankeyWorld ( ( lo &lt;&gt; ro , rr &lt;&gt; lr ), rb )  ) emptySankey $ map (\(b,f)-&gt; f b) placed</font></div>


<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">SankeyWorld ((turtb,turta),_) = </font></div><div><font face="courier new, monospace">{- This is the bit that fails:</font></div>

<div><font face="courier new, monospace"><span style="white-space:pre-wrap">        </span>sankeyFrom 0 5 &gt;&gt;= sankeyVia 5 &gt;&gt;= </font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap">        </span>sankeySplit </font></div>


<div><font face="courier new, monospace"><span style="white-space:pre-wrap">                </span>[ (0.3, sankeyVia 10 )</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap">                </span>, (0.7, sankeyVia 15 )</font></div>

<div><font face="courier new, monospace"><span style="white-space:pre-wrap">                </span>]</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap">                </span>-}</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap">        </span>sankeyFrom 0 5 &gt;&gt;= sankeyVia 5 &gt;&gt;= sankeyTurn 1 (-0.125) &gt;&gt;= sankeyVia 10 &gt;&gt;= sankeyTurn 1 (0.25) &gt;&gt;= sankeyTo -- &gt;&gt;= turn 0.25 &gt;&gt;= forward 10 &gt;&gt;= turn 0.25 &gt;&gt;= forward 20 &gt;&gt;= turn 0.25 &gt;&gt;= forward 10</font></div>


<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">pic3 = (strokeT (close ( turtb&lt;&gt;turta) )) # fc red</font></div><div><br></div><div>======================</div><div>

<br></div><div>The idea is that <font face="courier new, monospace">SankeyWorld</font> is a monad containing two trails (outbound and inbound) and a turtle-like state. I bind it onto functions like <font face="courier new, monospace">SankeyBrain -&gt; SankeyWorld</font>, whereby <font face="courier new, monospace">&gt;&gt;=</font> passes the state across. <font face="courier new, monospace">&gt;&gt;=</font> draws the left hand outward trail, then the right hand outward trail, then the right hand inward trail, then the left hand inward trail, so it all makes a nice polygon and I can colour it in. </div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">sankeyFrom angle width</font> is already a monad, <font face="courier new, monospace">sankeyVia length</font> is such a function and I could have <font face="courier new, monospace">sankeyTo</font> contain <font face="courier new, monospace">()</font> in place of the brain (i.e. state) cos you&#39;re not supposed to continue from it.</div>

<div><br></div><div>The tricky bit is splitting the flow. I want a function that takes the brain, splits the width according to named shares and shoves each share into a function <font face="courier new, monospace">SankeyBrain -&gt; SankeyWorld</font> that might have lots more stages and splits downwind.</div>

<div><br></div><div>It was all going fine until I discovered that if I can say <font face="courier new, monospace">m &gt;&gt;= f</font>, then I can&#39;t say <font face="courier new, monospace">f &gt;&gt;= f.</font> So I don&#39;t know how to write the bits after the split. Silly me. But what should I do instead to model Sankey diagrams splitting? Is MonadPlus the trick? If so, am I gonna have to make <font face="courier new, monospace">[SankeyWorld]</font> a monad as well?</div>

</div><div><br></div><div>TIA,</div><div>Adrian.</div><div><br></div><div>PS: I rarely have any use for the polymorphism of the parameter to Monad. In this case, it&#39;s a SankeyBrain, end of story. Is there a simpler kind of monad that doesn&#39;t throw this complication at me?</div>

<div><br></div><div><br></div><div><br></div><div><br></div></div>
</blockquote></div><br></div>