arrowprocess.elm

type Process a b 
  = Put b (Process a b)
  | Get (a -> Process a b)
  

put : b -> Process a b -> Process a b
put = 
  Put
  
get : (a -> Process a b) -> Process a b
get = 
  get
  
arr : (a -> b) -> Process a b 
arr f = 
  get (\a -> put (f a) (arr f))
  
  
map2 : (a -> b -> c) -> Process x a -> Process x b -> Process x c
map2 op f g = 
  (f &&& g) >>> arr (uncurry op)
  
andMap : Process x (a -> b) -> Process x a -> Process x b
andMap = 
  map2 (<|)
  
(>>>) : Process a b -> Process b c -> Process a c
(>>>) processAB processBC =
  case (processAB, processBC) of
    (_, Put c processBC') ->
      Put c (processAB >>> processBC')
      
    (Put b processAB', Get f) ->
      processAB' >>> f b
      
    (Get f, Get g) ->
      Get (\a -> f a >>> Get g)
      


first : Process a b -> Process (a, c) (b, c)
first = 
  bypass []


second : Process a b -> Process (c, a) (c, b)
second f = 
  arr swap >>> first f >>> arr swap
          
          
(***) : Process a c -> Process b d -> Process (a, b) (c, d)
(***) f g = 
  first f >>> second g
  
  
(&&&) : Process a b -> Process a c -> Process a (b, c)
(&&&) f g = 
  arr (\b -> (b,b)) >>> (f *** g)
          

   
---------------------------   
   
bypass : List c -> Process a b -> Process (a, c) (b, c)
bypass cs process = 
  case (cs, process) of 
    (_, Get f) ->
      Get (\(a,c) -> bypass (cs ++ [c]) (f a))
      
    (x :: xs, Put b sp) ->
      Put (b,x) (bypass xs sp)
      
    ([], Put b sp) ->
      Get (\(a,c) -> Put (b,c) (bypass [] sp))
      
      
swap : (a, b) -> (b, a)
swap (a, b) = (b, a)