{-# LANGUAGE GADTs, StandaloneDeriving #-}

module Test2 where

import Control.Concurrent

class (Show a) => Packet a where

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

deriving instance Show (AnyPacket)

data MaybePacket i = Packet i => JustPacket i | JustAnyPacket AnyPacket | NoPacket

data Line i = Packet i => Line (Chan i) | LineAny (Chan AnyPacket) | NoLine

data TwoWay a b where
  TwoWay :: Line a -> Line b -> TwoWay a b

sendFromFirstLine :: (Packet a, Packet b) => (TwoWay a b) -> a -> IO ()
sendFromFirstLine (TwoWay (Line chan) _) i = writeChan chan i
sendFromFirstLine (TwoWay (LineAny chan) _) i = writeChan chan $ AnyPacket i
sendFromFirstLine (TwoWay NoLine _) _ = return ()

getFromFirstLine :: (TwoWay a b) -> IO (MaybePacket a)
getFromFirstLine (TwoWay (Line chan) _) = do
  empty <- isEmptyChan chan
  if empty
    then return NoPacket
    else do
      i <- readChan chan
      return $ JustPacket i
getFromFirstLine (TwoWay (LineAny chan) _) = do
  empty <- isEmptyChan chan
  if empty
    then return NoPacket
    else do
      i <- readChan chan
      return $ JustAnyPacket  i
getFromFirstLine (TwoWay NoLine _) = return NoPacket

data FooBar = FooBar deriving Show

instance Packet FooBar where

main :: IO ()
main = do
  chan <- newChan :: IO (Chan AnyPacket)
  -- Create packets producer
  packet <- getFromFirstLine (TwoWay (LineAny chan) NoLine)
  case packet of
    JustAnyPacket p -> print p
    NoPacket        -> return ()
    JustPacket _    -> return () -- This is impossible, how to make Haskell know this at compile time?