{-# LANGUAGE OverloadedStrings #-}

module Binrep.Type.NullPadded where

import Binrep
import Binrep.Util ( tshow )

import Refined
import Refined.Unsafe

import GHC.TypeNats
import Data.Typeable ( typeRep )
import FlatParse.Basic qualified as FP
import FlatParse.Basic ( Parser )
import Mason.Builder qualified as Mason
import Data.ByteString qualified as BS

data NullPad (n :: Natural)

type NullPadded n a = Refined (NullPad n) a

instance KnownNat n => BLen (NullPadded n a) where
    -- | The size of some null-padded data is known - at compile time!
    type CBLen (NullPadded n a) = n

instance (BLen a, KnownNat n) => Predicate (NullPad n) a where
    validate :: Proxy (NullPad n) -> a -> Maybe RefineException
validate Proxy (NullPad n)
p a
a
      | BLenT
len forall a. Ord a => a -> a -> Bool
> BLenT
n
          = TypeRep -> Text -> Maybe RefineException
throwRefineOtherException (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy (NullPad n)
p) forall a b. (a -> b) -> a -> b
$
                   Text
"too long: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow BLenT
len forall a. Semigroup a => a -> a -> a
<> Text
" > " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow BLenT
n
      | Bool
otherwise = Maybe RefineException
success
      where
        n :: BLenT
n = forall (n :: Nat). KnownNat n => BLenT
typeNatToBLen @n
        len :: BLenT
len = forall a. BLen a => a -> BLenT
blen a
a

-- TODO cleanup
instance (Put a, BLen a, KnownNat n) => Put (NullPadded n a) where
    put :: NullPadded n a -> Builder
put NullPadded n a
wrnpa =
        let npa :: a
npa = forall {k} (p :: k) x. Refined p x -> x
unrefine NullPadded n a
wrnpa
            paddingLength :: BLenT
paddingLength = BLenT
n forall a. Num a => a -> a -> a
- forall a. BLen a => a -> BLenT
blen a
npa
         in forall a. Put a => a -> Builder
put a
npa forall a. Semigroup a => a -> a -> a
<> forall s. Buildable s => ByteString -> BuilderFor s
Mason.byteString (BLenT -> Word8 -> ByteString
BS.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral BLenT
paddingLength) Word8
0x00)
      where
        n :: BLenT
n = forall (n :: Nat). KnownNat n => BLenT
typeNatToBLen @n

-- | Safety: we assert actual length is within expected length (in order to
--   calculate how much padding to parse).
--
-- Note that the consumer probably doesn't care about the content of the
-- padding, just that the data is chunked correctly. I figure we care about
-- correctness here, so it'd be nice to know about the padding well-formedness
-- (i.e. that it's all nulls).
--
-- TODO maybe better definition via isolate
instance (Get a, BLen a, KnownNat n) => Get (NullPadded n a) where
    get :: Getter (NullPadded n a)
get = do
        a
a <- forall a. Get a => Getter a
get
        let len :: BLenT
len = forall a. BLen a => a -> BLenT
blen a
a
            nullStrLen :: BLenT
nullStrLen = BLenT
n forall a. Num a => a -> a -> a
- BLenT
len
        if   BLenT
nullStrLen forall a. Ord a => a -> a -> Bool
< BLenT
0
        then forall a. EBase -> Getter a
eBase forall a b. (a -> b) -> a -> b
$ BLenT -> BLenT -> EBase
EOverlong BLenT
n BLenT
len
        else BLenT -> Parser E ()
getNNulls BLenT
nullStrLen forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} x (p :: k). x -> Refined p x
reallyUnsafeRefine a
a)
      where
        n :: BLenT
n = forall (n :: Nat). KnownNat n => BLenT
typeNatToBLen @n

getNNulls :: BLenT -> Parser E ()
getNNulls :: BLenT -> Parser E ()
getNNulls = \case BLenT
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  BLenT
n -> forall e. Parser e Word8
FP.anyWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                         Word8
0x00    -> BLenT -> Parser E ()
getNNulls forall a b. (a -> b) -> a -> b
$ BLenT
nforall a. Num a => a -> a -> a
-BLenT
1
                         Word8
nonNull -> forall a. EBase -> Getter a
eBase forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> EBase
EExpectedByte Word8
0x00 Word8
nonNull