{-# LANGUAGE OverloadedStrings #-}
module Binrep.Type.NullTerminated where
import Binrep
import FlatParse.Basic qualified as FP
import Refined
import Refined.Unsafe
import Data.Typeable ( typeRep )
import Data.ByteString qualified as B
import Data.Word ( Word8 )
data NullTerminate
type NullTerminated = Refined NullTerminate
instance NullCheck a => Predicate NullTerminate a where
validate :: Proxy NullTerminate -> a -> Maybe RefineException
validate Proxy NullTerminate
p a
a
| a -> Bool
forall a. NullCheck a => a -> Bool
hasNoNulls a
a = TypeRep -> Text -> Maybe RefineException
throwRefineOtherException (Proxy NullTerminate -> TypeRep
forall {k} (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy NullTerminate
p) (Text -> Maybe RefineException) -> Text -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$
Text
"null byte not permitted in null-terminated data"
| Bool
otherwise = Maybe RefineException
success
class NullCheck a where hasNoNulls :: a -> Bool
instance NullCheck B.ByteString where
{-# INLINE hasNoNulls #-}
hasNoNulls :: ByteString -> Bool
hasNoNulls = (Word8 -> Bool) -> ByteString -> Bool
B.any (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00)
instance BLen a => BLen (NullTerminated a) where
blen :: NullTerminated a -> Int
blen NullTerminated a
ra = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. BLen a => a -> Int
blen (NullTerminated a -> a
forall {k} (p :: k) x. Refined p x -> x
unrefine NullTerminated a
ra)
{-# INLINE blen #-}
instance Put a => Put (NullTerminated a) where
{-# INLINE put #-}
put :: NullTerminated a -> Putter
put NullTerminated a
a = a -> Putter
forall a. Put a => a -> Putter
put (NullTerminated a -> a
forall {k} (p :: k) x. Refined p x -> x
unrefine NullTerminated a
a) Putter -> Putter -> Putter
forall a. Semigroup a => a -> a -> a
<> forall a. Put a => a -> Putter
put @Word8 Word8
0x00
instance Get a => Get (NullTerminated a) where
{-# INLINE get #-}
get :: Getter (NullTerminated a)
get = a -> NullTerminated a
forall {k} x (p :: k). x -> Refined p x
reallyUnsafeRefine (a -> NullTerminated a)
-> ParserT PureMode E a -> Getter (NullTerminated a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E a -> EBase -> ParserT PureMode E a
forall a. Getter a -> EBase -> Getter a
getEBase (ParserT PureMode E a -> ParserT PureMode E a
forall (st :: ZeroBitType) e a. ParserT st e a -> ParserT st e a
FP.isolateToNextNull ParserT PureMode E a
forall a. Get a => Getter a
get) (String -> EBase
EFailNamed String
"cstring")