{-# LANGUAGE GADTs, StandaloneDeriving, EmptyDataDecls, KindSignatures #-}

module Test5 where

import Control.Concurrent

class (Show a) => Packet a where

data AnyPacket :: * where
  AnyPacket :: Packet i => i -> AnyPacket
data NoPacket

deriving instance Show (AnyPacket)

data LineConductive
data LineNotConductive

data Line :: * -> * -> * -> * where -- Line, type of channel elements, type of elements possible to get from the channel, is line conductive
  Line :: Packet i => Chan i -> Line (Chan i) i LineConductive
  LineAny :: Chan AnyPacket -> Line (Chan i) AnyPacket LineConductive
  NoLine :: Line (Chan i) NoPacket LineNotConductive

data TwoWay :: * -> * -> * -> * -> * -> * -> * where
  TwoWay :: Line a a' b -> Line c c' d -> TwoWay a a' b c c' d

sendFromFirstLine :: Packet i => TwoWay (Chan i) i' b c c' d -> i -> IO ()
sendFromFirstLine (TwoWay (Line chan) _) i = writeChan chan i
sendFromFirstLine (TwoWay (LineAny chan) _) i = writeChan chan $ AnyPacket i
sendFromFirstLine (TwoWay NoLine _) _ = return () -- we allow sending but ignore so that same producer defintion can be used on all kinds of TwoWays

getFromFirstLine :: TwoWay (Chan i) i' LineConductive c c' d -> IO (Maybe i')
getFromFirstLine (TwoWay (Line chan) _) = maybeReadChan chan
getFromFirstLine (TwoWay (LineAny chan) _) = maybeReadChan chan

maybeReadChan :: Chan a -> IO (Maybe a)
maybeReadChan chan = do
  empty <- isEmptyChan chan
  if empty
    then return Nothing
    else do
      c <- readChan chan
      return $ Just c

data FooBar = FooBar deriving Show
instance Packet FooBar where

main :: IO ()
main = do
  chan <- newChan :: IO (Chan AnyPacket)
  let way = TwoWay (LineAny chan) NoLine
  sendFromFirstLine way FooBar
  packet <- getFromFirstLine way
  case packet of
    Just p  -> print p
    Nothing -> return ()