{-# 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
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
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
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