summaryrefslogtreecommitdiff
path: root/fig-bus/src/Fig/Bus/Binary/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'fig-bus/src/Fig/Bus/Binary/Utils.hs')
-rw-r--r--fig-bus/src/Fig/Bus/Binary/Utils.hs44
1 files changed, 44 insertions, 0 deletions
diff --git a/fig-bus/src/Fig/Bus/Binary/Utils.hs b/fig-bus/src/Fig/Bus/Binary/Utils.hs
new file mode 100644
index 0000000..734c7c9
--- /dev/null
+++ b/fig-bus/src/Fig/Bus/Binary/Utils.hs
@@ -0,0 +1,44 @@
+module Fig.Bus.Binary.Utils where
+
+import Fig.Prelude
+
+import Data.Word (Word8, Word32)
+import Data.Bits ((.|.), (.&.), shiftL, shiftR)
+import Data.ByteString (hPut, hGet)
+import qualified Data.ByteString as BS
+
+newtype EventType = EventType ByteString
+ deriving (Show, Eq, Ord)
+
+intFromLEBytes :: [Word8] -> Int
+intFromLEBytes [] = 0
+intFromLEBytes (x:xs) = shiftL (intFromLEBytes xs) 8 .|. fromIntegral x
+
+readLengthPrefixed :: Handle -> IO (Maybe ByteString)
+readLengthPrefixed h = do
+ n <- hGet h 4
+ case intFromLEBytes (BS.unpack n) of
+ 0 -> pure Nothing
+ len -> do
+ x <- hGet h len
+ pure $ Just x
+
+
+readEvent :: Handle -> IO (Maybe EventType)
+readEvent h = do
+ mb <- readLengthPrefixed h
+ pure $ EventType <$> mb
+
+writeLengthPrefixed :: Handle -> ByteString -> IO ()
+writeLengthPrefixed h d = do
+ let l :: Word32 = fromIntegral $ BS.length d
+ let bytes =
+ [ fromIntegral $ l .&. 0xff
+ , fromIntegral $ shiftR l 8 .&. 0xff
+ , fromIntegral $ shiftR l 16 .&. 0xff
+ , fromIntegral $ shiftR l 24 .&. 0xff
+ ]
+ hPut h $ BS.pack bytes <> d
+
+writeEvent :: Handle -> EventType -> IO ()
+writeEvent h (EventType d) = writeLengthPrefixed h d