{-# LANGUAGE Arrows #-} module Arrow where import Control.Arrow import qualified Control.Category as Cat addA :: Arrow a => a b Int -> a b Int -> a b Int addA f g = proc x -> do y <- f -< x z <- g -< x returnA -< y + z newtype Circuit a b = Circuit { unCircuit :: a -> (Circuit a b, b) } instance Cat.Category Circuit where id = Circuit \$ \a -> (Cat.id, a) (.) = dot where (Circuit cir2) `dot` (Circuit cir1) = Circuit \$ \a -> let (cir1', b) = cir1 a (cir2', c) = cir2 b in (cir2' `dot` cir1', c) instance Arrow Circuit where arr f = Circuit \$ \a -> (arr f, f a) first (Circuit cir) = Circuit \$ \(b, d) -> let (cir', c) = cir b in (first cir', (c, d)) -- | Accumulator that outputs a value determined by the supplied function. accum :: acc -> (a -> acc -> (b, acc)) -> Circuit a b accum acc f = Circuit \$ \input -> let (output, acc') = input `f` acc in (accum acc' f, output) -- | Accumulator that outputs the accumulator value. accum' :: b -> (a -> b -> b) -> Circuit a b accum' acc f = accum acc (\a b -> let b' = a `f` b in (b', b')) total :: Num a => Circuit a a total = accum' 0 (+) mean3 :: Fractional a => Circuit a a mean3 = proc value -> do (t, n) <- (| (&&&) (total -< value) (total -< 1) |) returnA -< t / n