haskus-binary-1.5: src/lib/Haskus/Binary/Serialize/Size.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}

module Haskus.Binary.Serialize.Size
   ( GetSize (..)
   , runGetSize
   )
where

import Haskus.Binary.Serialize.Put
import Haskus.Memory.Buffer
import Control.Monad.Trans.State.Strict as S

newtype GetSize a
   = GetSize (State Word a) 
   deriving newtype (Functor, Applicative, Monad)

-- | Increment the current size
incSize :: Word -> GetSize ()
incSize x = GetSize (state (\s -> ((),s+x)))

-- | Get the total size
runGetSize :: GetSize a -> Word
runGetSize (GetSize s) = execState s 0

instance PutMonad GetSize where
   putWord8 _  = incSize 1
   putWord16 _ = incSize 2
   putWord32 _ = incSize 4
   putWord64 _ = incSize 8
   putBuffer b = incSize (bufferSize b)