{- | C-style null-terminated data.

I mix string and bytestring terminology here, due to bad C influences. This
module is specifically interested in bytestrings and their encoding. String/text
encoding is handled in 'Binrep.Type.Text'.
-}

{-# LANGUAGE OverloadedStrings #-} -- for refined errors

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 )

-- | Null-terminated data. Arbitrary length terminated with a null byte.
--   Permits no null bytes inside the data.
data NullTerminate
type NullTerminated = Refined NullTerminate

-- | Null-terminated data may not contain any null bytes.
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 #-}

-- | Serialization of null-terminated data may be defined generally using the
--   data's underlying serializer.
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

-- | We may parse any null-terminated data using a special flatparse combinator.
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")

{-
I don't know how to do @[a]@. Either I nullterm each element, which is weird
because it's not required in all cases, or I don't, in which case the general
Put doesn't work. Nullterming every element feels weird anyway -- what about
[Word8]?

instance NullCheck a => NullCheck [a] where
    {-# INLINE hasNoNulls #-}
    hasNoNulls = all hasNoNulls
instance NullCheck Word8 where
    {-# INLINE hasNoNulls #-}
    hasNoNulls = \case 0x00 -> False
                       _    -> True
-}