module Dahdit.Midi.Pad
  ( pad32
  , staticByteSizePad32
  , byteSizePad32
  , getPad32
  , putPad32
  )
where

import Control.Monad (replicateM_, unless)
import Dahdit (Binary (..), ByteCount (..), Get, Put, getExpect, getRemainingSize)
import Data.Proxy (Proxy)
import Data.Word (Word8)

pad32 :: ByteCount -> ByteCount
pad32 :: ByteCount -> ByteCount
pad32 ByteCount
x = let y :: ByteCount
y = ByteCount -> ByteCount -> ByteCount
forall a. Integral a => a -> a -> a
rem ByteCount
x ByteCount
4 in ByteCount
x ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
+ if ByteCount
y ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCount
0 then ByteCount
0 else ByteCount
4 ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
- ByteCount
y

staticByteSizePad32 :: (Proxy a -> ByteCount) -> Proxy a -> ByteCount
staticByteSizePad32 :: forall {k} (a :: k). (Proxy a -> ByteCount) -> Proxy a -> ByteCount
staticByteSizePad32 Proxy a -> ByteCount
staticSizer Proxy a
p = ByteCount -> ByteCount
pad32 (Proxy a -> ByteCount
staticSizer Proxy a
p)

byteSizePad32 :: (a -> ByteCount) -> a -> ByteCount
byteSizePad32 :: forall a. (a -> ByteCount) -> a -> ByteCount
byteSizePad32 a -> ByteCount
sizer a
a = ByteCount -> ByteCount
pad32 (a -> ByteCount
sizer a
a)

getPad32 :: Get a -> Get a
getPad32 :: forall a. Get a -> Get a
getPad32 Get a
getter = do
  ByteCount
x <- Get ByteCount
getRemainingSize
  a
a <- Get a
getter
  ByteCount
y <- Get ByteCount
getRemainingSize
  let z :: Int
z = Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem (ByteCount -> Int
unByteCount (ByteCount
x ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
- ByteCount
y)) Int
4
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
z Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
z) (String -> Get Word8 -> Word8 -> Get ()
forall a. (Eq a, Show a) => String -> Get a -> a -> Get ()
getExpect String
"pad" (forall a. Binary a => Get a
get @Word8) Word8
0))
  a -> Get a
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

putPad32 :: (a -> ByteCount) -> (a -> Put) -> a -> Put
putPad32 :: forall a. (a -> ByteCount) -> (a -> Put) -> a -> Put
putPad32 a -> ByteCount
sizer a -> Put
putter a
a = do
  let x :: ByteCount
x = a -> ByteCount
sizer a
a
  a -> Put
putter a
a
  let y :: Int
y = Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem (ByteCount -> Int
unByteCount ByteCount
x) Int
4
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y) (forall a. Binary a => a -> Put
put @Word8 Word8
0))