title: ArrowLoop instance for Control.Foldl-like datatype
body: <p>I am working on a modification of <a href="https://hackage.haskell.org/package/foldl-1.3.0/docs/Control-Foldl.html" rel="nofollow noreferrer">Control.Foldl</a> datatype that provides instances of <code>Category</code> and <code>Arrow</code>.
  My definition is as follows:</p>
  
  <pre><code>data FoldlCat a b = forall x c. FoldlCat (x -&gt; a -&gt; c) x (c -&gt; x) (c -&gt; b)
  </code></pre>
  
  <p>where the first argument stands for a "step" function (<code>savedState -&gt; newInput -&gt; intermediateValue</code>), second is for initial <code>savedState</code>, third is a "save" function (<code>intermediateValue -&gt; savedState</code>) and the last one is an "extract" function (<code>intermediateValue -&gt; newOutput</code>).</p>
  
  <p>So something like <code>map (*10) . scanl (+) 0</code> can be expressed as <code>FoldlCat (+) 0 id (*10)</code>.</p>
  
  <p>The main purpose of a save function is to facilitate definitions of <code>id</code> and <code>arr</code> like so:</p>
  
  <pre><code>id = FoldlCat (\_ x -&gt; x) () (const ()) id
  </code></pre>
  
  <p>Now I am unsuccessfully trying to come up with an instance of <code>ArrowLoop</code>. I can not see any reason for it not being possible, however, I am not comfortable enough with <code>fix</code>-like concepts. My best attempt so far typechecks but loops forever.</p>
  
  <pre><code>instance ArrowLoop FoldlCat where
    loop (FoldlCat s b a d) = FoldlCat step b (a . snd) fst where
      step x = loop' d (s x)
      loop' f g x = let ~(v, ~(c,d)) = let ~v = g (x,d) in (v, f v)
                    in (c, v)
  </code></pre>
  
  <p>I would be grateful if someone could share their approach on defining such an instance (extra kudos if it would work with a strict tuple in accumulator inside of <code>(.)</code>) or explain why that is not possible or advice on a better structure for FoldlCat.</p>
  
  <pre><code>{-# LANGUAGE ExistentialQuantification #-}
  {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE Arrows #-}
  
  import Data.List (unfoldr)
  import Prelude hiding (id, (.))
  import Control.Category
  import Control.Arrow
  
  -- | FoldlCat  step init save export
  data FoldlCat a b = forall x c. FoldlCat (x -&gt; a -&gt; c) x (c -&gt; x) (c -&gt; b)
  
  mapCat :: (a -&gt; b) -&gt; FoldlCat a b
  mapCat f = FoldlCat (\_ x -&gt; x) () (const ()) f
  
  evalList :: FoldlCat t b -&gt; [t] -&gt; [b]
  evalList (FoldlCat s b a d) ys = unfoldr stepan (b, ys) where
      stepan (accVal, (x:xs))  = Just (nexVal, (newAcc, xs)) where
        newMeta = s accVal x
        newAcc  = a newMeta
        nexVal  = d newMeta
      stepan (accVal, [])      = Nothing
  
  delay :: b -&gt; FoldlCat b b
  delay def = FoldlCat (,) def snd fst
  
  instance Category FoldlCat where
    id = mapCat id
  
    (.) (FoldlCat step2 begin2 acc2 done2) (FoldlCat step1 begin1 acc1 done1) =
        let step = \(a, b) y -&gt; let !a' = step1 a y
                                    !b' = step2 b (done1 a') in (a', b')
            begin = (begin1, begin2)
            acc   = \(x, y) -&gt; ((acc1 x), (acc2 y))
            done = \(a, b) -&gt; done2 b
        in
          FoldlCat step begin acc done
  
  instance Arrow FoldlCat where
    arr f = mapCat f
  
    first (FoldlCat s b a d) = FoldlCat step b (a . fst) extF where
      step = (\a (x, y) -&gt; (s a x, y))
      extF = (\(ok, y) -&gt; (d ok, y))
  
  instance ArrowLoop FoldlCat where
    loop (FoldlCat s b a d) = FoldlCat step b (a . snd) fst where
      step x = loop' d (s x)
      loop' f g x = let ~(v, ~(c,d)) = let ~v = g (x,d) in (v, f v)
                    in (c, v)
  
  chaseFromZero = proc target -&gt; do
    rec let step = signum (target - x)
        x &lt;- FoldlCat (+) 0 id id &lt;&lt;&lt; delay 0 -&lt; step
    id -&lt; x
  
  main = print $ evalList chaseFromZero [1..5]
  </code></pre>
  
  <p><strong>EDIT</strong> Although I am not sure how and why it works, fixing strictness of <code>step</code> in <code>(.)</code> (i.e. removing bang in <code>let !a' = step1 a y</code>) seems to make this example work.</p>