GADTs for simple protocol

gistfile1.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S

-- States
data Listening
data Disconnected
data Ready
data Closing

data Protocol start end where
    Accept :: Protocol Ready Closing -> Protocol Listening Disconnected
    Send :: ByteString -> Protocol Ready x -> Protocol Ready x
    Recv :: (ByteString -> Protocol Ready x) -> Protocol Ready x
    Close :: Protocol Ready Closing

proto :: Protocol Listening Disconnected
proto = Accept $ Send "Hi." $ Recv (\x -> if x == "Hi." then Close else Send "Jerk." Close)

interpIO :: Protocol start end -> IO ()
interpIO (Accept k) = S.putStrLn "Connected" >> interpIO k
interpIO (Send payload k) = S.putStrLn payload >> interpIO k
interpIO (Recv k) = S.getLine >>= interpIO . k
interpIO Close = S.putStrLn "Disconnected"

main :: IO ()
main = interpIO proto