[Haskell-cafe] Arrow laws of Netwire
KAction at gnu.org
KAction at gnu.org
Tue Feb 13 04:39:10 UTC 2018
Hello! In process of adapting 'netwire-5.0.0' to my needs I discovered
following strange thing. Let us consider following simple program:
{-# LANGUAGE Arrows #-}
import FRP.Netwire
import Data.Monoid
-- I almost sure this is correct, since it is copied
-- from "Programming with Arrows", J. Hughes
mapA :: (ArrowChoice a) => a b c -> a [b] [c]
mapA f = proc input ->
case input of
[] -> returnA -< []
z:zs -> do y_ <- f -< z
ys_ <- mapA f -< zs
returnA -< y_:ys_
mconcatA :: (ArrowChoice a, Monoid m) => a b m -> a [b] m
mconcatA f = mapA f >>> arr mconcat
-- Note the commented line.
wire :: (Monad m, HasTime t s) => Wire s () m a Double
wire = pure (Sum 1.0)
-- >>> arr (: []) >>> mconcatA returnA
>>> arr getSum
>>> integral 10
main = testWire (countSession_ 1) wire
Problem is that, compiled with ghc-8.0.1 this program hangs if I
uncomment second line in body of ``wire`` function[1], which is wierd,
since assuming monoid and arrow laws, I believe
-- (Arrow a, Monoid e) => a e e
arr (: []) >>> mconcatA returnA = returnA
Is it false? Any suggestions?
.. [1] with that line commented program works and prints sequence of
numbers, with every next over previous.
More information about the Haskell-Cafe
mailing list