-- arrow class

class Arrow r where
  arr :: (a -> b) -> r a b
  (>>>) :: r a b -> r b c -> r a c
  first :: r a b -> r (a,c) (b,c)


-- function arrow is the first example

instance Arrow (->) where
  arr f = f
  f >>> g = g . f
  first f (a, c) = (f a, c)


-- stream functions

data ListF a b = LF ([a] -> [b])

instance Arrow ListF where
  arr f = LF (map f)
  LF lf >>> LF lg = LF (lg . lf)
  first (LF lf) = LF (\ ps -> let as = map fst ps
                                  cs = map snd ps
                              in zip (lf as) cs)

summationLF :: ListF Double Double
summationLF = LF sum
              where sum (a : as) = a : map (a +) (sum as)

differenceLF :: ListF Double Double
differenceLF = LF diff 
              where diff as = zipWith (-) as (0 : as) 


-- machines - a better way to implement stream functions

data Mach a b = M (a -> (Mach a b, b))

instance Arrow Mach where
  arr f = M (\ a -> (arr f, f a))
  M mf >>> M mg = M (\ a -> 
                              let  (mf', b) = mf a
                                   (mg', c) = mg b
                              in (mf' >>> mg', c))
  first (M mf) = M (\ (a, c) -> 
                              let (mf', b) = mf a
                              in (first mf', (b, c)))


summation :: Mach Double Double
summation = summation' 0

summation' :: Double -> Mach Double Double
summation' s = M (\ a -> let s' = s + a
                         in (summation' s', s'))        

difference :: Mach Double Double
difference = difference' 0

difference' :: Double -> Mach Double Double
difference' a' = M (\ a -> (difference' a, a - a')) 


delay :: Mach a a
delay = delay' undefined

delay' :: a -> Mach a a
delay' a' = M (\ a -> (delay' a, a')) 


switch :: Mach a (b, Maybe e) -> (e -> Mach a b) -> Mach a b
switch (M mf) g  = M (\ a -> let (mf', (b, mbe)) = mf a 
                             in case mbe of 
                                Nothing -> (switch mf' g, b)
                                Just e ->(g e, b))


-- running a machine 

runMach :: (Read a, Show b) => Mach a b -> IO ()
runMach (M mf) = 
  do a <- readLn
     let (mf', b) = mf a
     print b
     runMach mf'


 
test:: Mach Double Double
test = arr (const 1)

test1:: Mach Double Double
test1 = arr (+2)