{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
module Runtime.Multiplex (
  Either
  ,multiplex2
  ,multiplex3
  ,deMultiplex2
  ,deMultiplex3) where

import Reactive.Event 


moveEvent :: Either (Event a) (Event b) -> Event (Either a b)
moveEvent (Left (On a)) = On (Left a)
moveEvent (Left (Off a)) = Off (Left a)
moveEvent (Right (On a)) = On (Right a)
moveEvent (Right (Off a)) = Off (Right a)
moveEvent (Left Start) = Start
moveEvent (Left Stop) = Stop
moveEvent (Right Start) = Start
moveEvent (Right Stop) = Stop


listToMaybe :: [t] -> Maybe [t]
listToMaybe [] = Nothing
listToMaybe l = Just l
maybeToList :: Maybe [t] -> [t]
maybeToList (Just l) = l
maybeToList Nothing = []

multiplex2 :: (Maybe [Event a], Maybe [Event b]) -> Maybe [Event (Either a b)]
multiplex2 (ma,mb) = listToMaybe $ multiplex2' (maybeToList ma, maybeToList mb)

multiplex3
  :: (Maybe [Event a], Maybe [Event b], Maybe [Event c])
     -> Maybe [Event (Either a (Either b c))]
multiplex3 (ma,mb,mc) = listToMaybe $ multiplex3' (maybeToList ma
                                                  ,maybeToList mb
                                                  ,maybeToList mc)

multiplex2' :: ([Event a], [Event b]) -> [Event (Either a b)]
multiplex2' (a, b) = map moveEvent $    map Left a
                                    ++ map Right b

deMultiplex2
  :: Maybe [Event (Either a b)]
     -> (Maybe [Event a], Maybe [Event b])
deMultiplex2 l = let (a,b) = deMultiplex2' (maybeToList l)
                 in (listToMaybe a, listToMaybe b)

deMultiplex3
  :: Maybe [Event (Either a (Either b c))]
     -> (Maybe [Event a], Maybe [Event b], Maybe [Event c])
deMultiplex3 l = let (a,b,c) = deMultiplex3' (maybeToList l)
                 in (listToMaybe a, listToMaybe b, listToMaybe c)




multiplex3'
  :: ([Event a], [Event b], [Event c])
     -> [Event (Either a (Either b c))]
multiplex3' (a,b,c) = let bc = map Right $ multiplex2' (b,c)
                      in map moveEvent $ map Left a ++ bc


deMultiplex2' :: [Event (Either a b)] -> ([Event a], [Event b])
deMultiplex2' = foldl (\(la,lb) v -> case v of
                                       On (Left a) -> ((On a):la,lb)
                                       Off (Left a) -> ((Off a):la,lb)
                                       On (Right b) -> (la,(On b):lb)
                                       Off (Right b) -> (la,(Off b):lb)
                                       _ -> error "deMultiplex: Start or Stop in the event stream")
                      ([],[])

deMultiplex3' :: [Event (Either a (Either b c))]
             -> ([Event a], [Event b], [Event c])
deMultiplex3' l = let (la,lblc) = deMultiplex2' l
                      (lb,lc) = deMultiplex2' lblc
                  in (la,lb,lc)