{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
module Util.BinaryExtras(
hReadLtd,
initialClockTime,
) where
import System.IO
import Data.IORef
import System.Time
import Util.Binary
import Util.BinaryUtils
import Util.Computation
import Util.ExtendedPrelude
import Util.IOExtras
import Util.BinaryInstances()
hReadLtd :: HasBinary a IO =>
Int
-> Handle -> IO (WithError a)
hReadLtd :: Int -> Handle -> IO (WithError a)
hReadLtd Int
limit Handle
handle =
(BreakFn -> IO a) -> IO (WithError a)
forall a. (BreakFn -> IO a) -> IO (WithError a)
addFallOutWE (\ BreakFn
break ->
do
IORef Int
lenIORef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
let
ensure :: Int -> IO ()
ensure :: Int -> IO ()
ensure Int
i =
do
Int
len1 <- IORef Int -> (Int -> (Int, Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
simpleModifyIORef IORef Int
lenIORef
(\ Int
len0 ->
let
len1 :: Int
len1 = Int
len0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
in
(Int
len1,Int
len1)
)
if Int
len1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit
then
String -> IO ()
BreakFn
break String
"BinaryExtras.hReadLtd: limit exceeded"
else
IO ()
forall (m :: * -> *). Monad m => m ()
done
(ReadBinary {readByte :: forall (m :: * -> *). ReadBinary m -> m Byte
readByte = IO Byte
readByte1,readBytes :: forall (m :: * -> *). ReadBinary m -> Int -> m Bytes
readBytes = Int -> IO Bytes
readBytes1})
= Handle -> ReadBinary IO
toReadBinaryHandle Handle
handle
readByte2 :: IO Byte
readByte2 =
do
Int -> IO ()
ensure Int
1
IO Byte
readByte1
readBytes2 :: Int -> IO Bytes
readBytes2 Int
len =
do
Int -> IO ()
ensure Int
len
Int -> IO Bytes
readBytes1 Int
len
rb2 :: ReadBinary IO
rb2 = ReadBinary :: forall (m :: * -> *). m Byte -> (Int -> m Bytes) -> ReadBinary m
ReadBinary {readByte :: IO Byte
readByte = IO Byte
readByte2,readBytes :: Int -> IO Bytes
readBytes = Int -> IO Bytes
readBytes2}
ReadBinary IO -> IO a
forall a (m :: * -> *). HasBinary a m => ReadBinary m -> m a
readBin ReadBinary IO
rb2
)
instance Monad m => HasBinary ClockTime m where
writeBin :: WriteBinary m -> ClockTime -> m ()
writeBin = (ClockTime -> (Integer, Integer))
-> WriteBinary m -> ClockTime -> m ()
forall b (m :: * -> *) a.
HasBinary b m =>
(a -> b) -> WriteBinary m -> a -> m ()
mapWrite (\ (TOD Integer
i Integer
j) -> (Integer
i,Integer
j))
readBin :: ReadBinary m -> m ClockTime
readBin = ((Integer, Integer) -> ClockTime) -> ReadBinary m -> m ClockTime
forall (m :: * -> *) b a.
(Monad m, HasBinary b m) =>
(b -> a) -> ReadBinary m -> m a
mapRead (\ (Integer
i,Integer
j) -> Integer -> Integer -> ClockTime
TOD Integer
i Integer
j)
initialClockTime :: ClockTime
initialClockTime :: ClockTime
initialClockTime = Integer -> Integer -> ClockTime
TOD Integer
1052391874 Integer
190946000000