1 files changed, 17 insertions, 1 deletions
diff --git a/Types.hs b/Types.hs
index b28713d..76a30a2 100644
--- a/Types.hs
+++ b/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric, FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric, FlexibleInstances, FlexibleContexts #-}
 
 {- | Main types for debug-me
  -
@@ -15,6 +15,9 @@ module Types (
 import Val
 import Memory
 import Serialization
+import Network.WebSockets (WebSocketsData(..))
+import qualified Data.Binary
+import qualified Data.ByteString.Lazy as L
 
 -- | Things that the developer sees.
 data Seen = Seen
@@ -191,3 +194,16 @@ instance ToJSON ControlAction where
 	toEncoding = genericToEncoding sumOptions
 instance FromJSON ControlAction where
 	parseJSON = genericParseJSON sumOptions
+
+instance WebSocketsData (Message Seen) where
+	fromLazyByteString = decodeBinaryMessage
+	toLazyByteString = Data.Binary.encode
+
+instance WebSocketsData (Message Entered) where
+	fromLazyByteString = decodeBinaryMessage
+	toLazyByteString = Data.Binary.encode
+
+decodeBinaryMessage :: Binary (Message a) => L.ByteString -> Message a
+decodeBinaryMessage b = case Data.Binary.decodeOrFail b of
+	Right (_, _, msg) -> msg
+	Left (_, _, err) -> error $ "Binary decode error: " ++ err