I am working on a modification of Control.Foldl datatype that provides instances of Category and Arrow.
My definition is as follows:
data FoldlCat a b = forall x c. FoldlCat (x -> a -> c) x (c -> x) (c -> b)
where the first argument stands for a "step" function (savedState -> newInput -> intermediateValue), second is for initial savedState, third is a "save" function (intermediateValue -> savedState) and the last one is an "extract" function (intermediateValue -> newOutput).
So something like map (*10) . scanl (+) 0 can be expressed as FoldlCat (+) 0 id (*10).
The main purpose of a save function is to facilitate definitions of id and arr like so:
id = FoldlCat (\_ x -> x) () (const ()) id
Now I am unsuccessfully trying to come up with an instance of ArrowLoop. I can not see any reason for it not being possible, however, I am not comfortable enough with fix-like concepts. My best attempt so far typechecks but loops forever.
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)
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 (.)) or explain why that is not possible or advice on a better structure for FoldlCat.
{-# 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 -> a -> c) x (c -> x) (c -> b)
mapCat :: (a -> b) -> FoldlCat a b
mapCat f = FoldlCat (\_ x -> x) () (const ()) f
evalList :: FoldlCat t b -> [t] -> [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 -> 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 -> let !a' = step1 a y
!b' = step2 b (done1 a') in (a', b')
begin = (begin1, begin2)
acc = \(x, y) -> ((acc1 x), (acc2 y))
done = \(a, b) -> 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) -> (s a x, y))
extF = (\(ok, y) -> (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 -> do
rec let step = signum (target - x)
x <- FoldlCat (+) 0 id id <<< delay 0 -< step
id -< x
main = print $ evalList chaseFromZero [1..5]
EDIT Although I am not sure how and why it works, fixing strictness of step in (.) (i.e. removing bang in let !a' = step1 a y) seems to make this example work.