module Hercules.Agent.Binary where

import Data.Binary
import Data.Binary.Get
import Data.ByteString qualified as BS
import Data.ByteString.Builder.Extra qualified as BL
import System.IO (Handle)
import Prelude

-- As recommended in the binary docs, taken from https://hackage.haskell.org/package/binary-0.8.9.0/docs/src/Data.Binary.html#decodeFileOrFail

-- | Decode a value from a 'Handle'. Returning 'Left' on failure and 'Right' on success.
-- In case of failure, the unconsumed input and a human-readable error message will be returned.
decodeBinaryFromHandle :: (Binary a) => Handle -> IO (Either (BS.ByteString, ByteOffset, String) a)
decodeBinaryFromHandle :: forall a.
Binary a =>
Handle -> IO (Either (ByteString, ByteOffset, String) a)
decodeBinaryFromHandle = Decoder a
-> Handle -> IO (Either (ByteString, ByteOffset, String) a)
forall {b}.
Decoder b
-> Handle -> IO (Either (ByteString, ByteOffset, String) b)
feed (Get a -> Decoder a
forall a. Get a -> Decoder a
runGetIncremental Get a
forall t. Binary t => Get t
get)
  where
    feed :: Decoder b
-> Handle -> IO (Either (ByteString, ByteOffset, String) b)
feed (Done ByteString
_ ByteOffset
_ b
x) Handle
_ = Either (ByteString, ByteOffset, String) b
-> IO (Either (ByteString, ByteOffset, String) b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Either (ByteString, ByteOffset, String) b
forall a b. b -> Either a b
Right b
x)
    feed (Fail ByteString
unconsumed ByteOffset
pos String
str) Handle
_ = Either (ByteString, ByteOffset, String) b
-> IO (Either (ByteString, ByteOffset, String) b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString, ByteOffset, String)
-> Either (ByteString, ByteOffset, String) b
forall a b. a -> Either a b
Left (ByteString
unconsumed, ByteOffset
pos, String
str))
    feed (Partial Maybe ByteString -> Decoder b
k) Handle
h = do
      ByteString
chunk <- Handle -> Int -> IO ByteString
BS.hGetSome Handle
h Int
BL.defaultChunkSize
      case ByteString -> Int
BS.length ByteString
chunk of
        Int
0 -> Decoder b
-> Handle -> IO (Either (ByteString, ByteOffset, String) b)
feed (Maybe ByteString -> Decoder b
k Maybe ByteString
forall a. Maybe a
Nothing) Handle
h
        Int
_ -> Decoder b
-> Handle -> IO (Either (ByteString, ByteOffset, String) b)
feed (Maybe ByteString -> Decoder b
k (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
chunk)) Handle
h