module Dahdit.Binary
  ( Binary (..)
  , byteSizeViaPut
  ) where

import Dahdit.Free (Get, Put)
import Dahdit.Funs (getFloatBE, getFloatLE, getInt16BE, getInt16LE, getInt24BE, getInt24LE, getInt32BE, getInt32LE,
                    getInt8, getWord16BE, getWord16LE, getWord24BE, getWord24LE, getWord32BE, getWord32LE, getWord8,
                    putFloatBE, putFloatLE, putInt16BE, putInt16LE, putInt24BE, putInt24LE, putInt32BE, putInt32LE,
                    putInt8, putWord16BE, putWord16LE, putWord24BE, putWord24LE, putWord32BE, putWord32LE, putWord8)
import Dahdit.Nums (FloatBE (..), FloatLE, Int16BE (..), Int16LE, Int24BE (..), Int24LE, Int32BE (..), Int32LE,
                    Word16BE (..), Word16LE, Word24BE (..), Word24LE, Word32BE (..), Word32LE)
import Dahdit.Run (runCount)
import Dahdit.Sizes (ByteCount, ByteSized)
import Data.Int (Int8)
import Data.Word (Word8)

class ByteSized a => Binary a where
  get :: Get a
  put :: a -> Put

byteSizeViaPut :: Binary a => a -> ByteCount
byteSizeViaPut :: forall a. Binary a => a -> ByteCount
byteSizeViaPut = Put -> ByteCount
runCount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => a -> Put
put

instance Binary () where
  get :: Get ()
get = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  put :: () -> Put
put ()
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Binary Word8 where
  get :: Get Word8
get = Get Word8
getWord8
  put :: Word8 -> Put
put = Word8 -> Put
putWord8

instance Binary Int8 where
  get :: Get Int8
get = Get Int8
getInt8
  put :: Int8 -> Put
put = Int8 -> Put
putInt8

instance Binary Word16LE where
  get :: Get Word16LE
get = Get Word16LE
getWord16LE
  put :: Word16LE -> Put
put = Word16LE -> Put
putWord16LE

instance Binary Int16LE where
  get :: Get Int16LE
get = Get Int16LE
getInt16LE
  put :: Int16LE -> Put
put = Int16LE -> Put
putInt16LE

instance Binary Word24LE where
  get :: Get Word24LE
get = Get Word24LE
getWord24LE
  put :: Word24LE -> Put
put = Word24LE -> Put
putWord24LE

instance Binary Int24LE where
  get :: Get Int24LE
get = Get Int24LE
getInt24LE
  put :: Int24LE -> Put
put = Int24LE -> Put
putInt24LE

instance Binary Word32LE where
  get :: Get Word32LE
get = Get Word32LE
getWord32LE
  put :: Word32LE -> Put
put = Word32LE -> Put
putWord32LE

instance Binary Int32LE where
  get :: Get Int32LE
get = Get Int32LE
getInt32LE
  put :: Int32LE -> Put
put = Int32LE -> Put
putInt32LE

instance Binary FloatLE where
  get :: Get FloatLE
get = Get FloatLE
getFloatLE
  put :: FloatLE -> Put
put = FloatLE -> Put
putFloatLE

instance Binary Word16BE where
  get :: Get Word16BE
get = Get Word16BE
getWord16BE
  put :: Word16BE -> Put
put = Word16BE -> Put
putWord16BE

instance Binary Int16BE where
  get :: Get Int16BE
get = Get Int16BE
getInt16BE
  put :: Int16BE -> Put
put = Int16BE -> Put
putInt16BE

instance Binary Word24BE where
  get :: Get Word24BE
get = Get Word24BE
getWord24BE
  put :: Word24BE -> Put
put = Word24BE -> Put
putWord24BE

instance Binary Int24BE where
  get :: Get Int24BE
get = Get Int24BE
getInt24BE
  put :: Int24BE -> Put
put = Int24BE -> Put
putInt24BE

instance Binary Word32BE where
  get :: Get Word32BE
get = Get Word32BE
getWord32BE
  put :: Word32BE -> Put
put = Word32BE -> Put
putWord32BE

instance Binary Int32BE where
  get :: Get Int32BE
get = Get Int32BE
getInt32BE
  put :: Int32BE -> Put
put = Int32BE -> Put
putInt32BE

instance Binary FloatBE where
  get :: Get FloatBE
get = Get FloatBE
getFloatBE
  put :: FloatBE -> Put
put = FloatBE -> Put
putFloatBE