Extract utility functions

These are later going to be used by the client too

src/Forest/Server.hs

@@ -5,41 +5,14 @@ module Forest.Server
   , serverApp
   ) where
 
-import Control.Monad
-import           Control.Concurrent.Async
 import           Control.Concurrent.Chan
-import           Data.Aeson
+import           Control.Monad
-import qualified Data.Text                as T
+import qualified Network.WebSockets      as WS
-import qualified Network.WebSockets       as WS
 
 import           Forest.Api
 import           Forest.Tree
 import           Forest.TreeModule
-
+import           Forest.Util
-{- Helper functions -}
-
-withThread :: IO () -> IO () -> IO ()
-withThread thread main = withAsync thread $ const main
-
-sendPacket :: WS.Connection -> ServerPacket -> IO ()
-sendPacket conn packet = WS.sendTextData conn $ encode packet
-
-closeWithErrorMessage :: WS.Connection -> T.Text -> IO ()
-closeWithErrorMessage conn = WS.sendCloseCode conn 1003
-
-receivePacket :: WS.Connection -> IO (Maybe ClientPacket)
-receivePacket conn = do
-  dataMessage <- WS.receiveDataMessage conn
-  closeOnErrorMessage $ case dataMessage of
-    WS.Binary _ -> Left "Invalid message format: Binary"
-    WS.Text bs _ -> case eitherDecode' bs of
-      Left errorMsg -> Left $ "Invalid packet: " <> T.pack errorMsg
-      Right packet -> Right packet
-  where
-    closeOnErrorMessage :: Either T.Text a -> IO (Maybe a)
-    closeOnErrorMessage (Right a) = pure $ Just a
-    closeOnErrorMessage (Left errorMsg) =
-      Nothing <$ closeWithErrorMessage conn errorMsg
 
 {- Thread that sends updates to the client -}
 

src/Forest/Util.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Forest.Util
+  ( withThread
+  , sendPacket
+  , receivePacket
+  , closeWithErrorMessage
+  ) where
+
+import           Control.Concurrent.Async
+import           Data.Aeson
+import qualified Data.Text                as T
+import qualified Network.WebSockets       as WS
+
+withThread :: IO () -> IO () -> IO ()
+withThread thread main = withAsync thread $ const main
+
+sendPacket :: ToJSON a => WS.Connection -> a -> IO ()
+sendPacket conn packet = WS.sendTextData conn $ encode packet
+
+closeWithErrorMessage :: WS.Connection -> T.Text -> IO ()
+closeWithErrorMessage conn = WS.sendCloseCode conn 1003
+
+receivePacket :: FromJSON a => WS.Connection -> IO (Maybe a)
+receivePacket conn = do
+  dataMessage <- WS.receiveDataMessage conn
+  closeOnErrorMessage $ case dataMessage of
+    WS.Binary _  -> Left "Invalid message format: Binary"
+    WS.Text bs _ -> case eitherDecode' bs of
+      Left errorMsg -> Left $ "Invalid packet: " <> T.pack errorMsg
+      Right packet  -> Right packet
+  where
+    closeOnErrorMessage :: Either T.Text a -> IO (Maybe a)
+    closeOnErrorMessage (Right a) = pure $ Just a
+    closeOnErrorMessage (Left errorMsg) =
+      Nothing <$ closeWithErrorMessage conn errorMsg