From 378770cde6fb9fd85983c05eab9eeff2e34398c2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 21 Apr 2017 19:45:09 -0400
Subject: working toward getting developer mode connection to server working

---
 Types.hs | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

(limited to 'Types.hs')

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
-- 
cgit v1.2.3