{-| Newtype for manipulating length-prefixed strings.

This type is for UTF-8 'Text' that you intend to write out to a length-prefixed
bytestring. The size of the length field is static. You essentially have to
decide the maximum bytesize of the string on creation.
-}

module StreamPatch.Patch.Binary.PascalText where

import           StreamPatch.Patch.Binary ( BinRep(..) )

import qualified Data.Text.Encoding         as Text
import           Data.Text                  ( Text )
import qualified Data.ByteString            as BS
import           GHC.TypeNats
import           Data.Proxy
import           Data.Bits

newtype PascalText (n :: Nat) = PascalText { forall (n :: Nat). PascalText n -> Text
unPascalText :: Text }

instance KnownNat n => BinRep (PascalText n) where
    toBinRep :: PascalText n -> Either String Bytes
toBinRep PascalText n
t =
        case PascalText n -> Maybe Bytes
forall (n :: Nat). KnownNat n => PascalText n -> Maybe Bytes
encodePascalText PascalText n
t of
          Maybe Bytes
Nothing -> String -> Either String Bytes
forall a b. a -> Either a b
Left String
"UTF-8 encoded text too long for length prefix field"
          Just Bytes
bs -> Bytes -> Either String Bytes
forall a b. b -> Either a b
Right Bytes
bs

encodePascalText :: forall n. KnownNat n => PascalText n -> Maybe BS.ByteString
encodePascalText :: forall (n :: Nat). KnownNat n => PascalText n -> Maybe Bytes
encodePascalText PascalText n
t = do
    Bytes
lenBs <- Int -> Int -> Maybe Bytes
forall a. (Integral a, Bits a) => Int -> a -> Maybe Bytes
encodeToSizedBE (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n))) (Bytes -> Int
BS.length Bytes
bs)
    Bytes -> Maybe Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes -> Maybe Bytes) -> Bytes -> Maybe Bytes
forall a b. (a -> b) -> a -> b
$ Bytes
lenBs Bytes -> Bytes -> Bytes
forall a. Semigroup a => a -> a -> a
<> Bytes
bs
  where
    bs :: Bytes
bs = Text -> Bytes
Text.encodeUtf8 (Text -> Bytes) -> (PascalText n -> Text) -> PascalText n -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PascalText n -> Text
forall (n :: Nat). PascalText n -> Text
unPascalText (PascalText n -> Bytes) -> PascalText n -> Bytes
forall a b. (a -> b) -> a -> b
$ PascalText n
t

encodeToSizedBE :: (Integral a, Bits a) => Int -> a -> Maybe BS.ByteString
encodeToSizedBE :: forall a. (Integral a, Bits a) => Int -> a -> Maybe Bytes
encodeToSizedBE Int
byteSize a
x =
    let bs :: Bytes
bs = a -> Bytes
forall a. (Integral a, Bits a) => a -> Bytes
i2be a
x
        nulls :: Int
nulls = Int
byteSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
BS.length Bytes
bs
     in if   Int
nulls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
        then Maybe Bytes
forall a. Maybe a
Nothing
        else Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (Bytes -> Maybe Bytes) -> Bytes -> Maybe Bytes
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> Bytes
BS.replicate Int
nulls Word8
0x00 Bytes -> Bytes -> Bytes
forall a. Semigroup a => a -> a -> a
<> Bytes
bs

-- | Re-encode an 'Integer' to a little-endian integer stored as a 'ByteString'
--   using the fewest bytes needed to represent it.
--
-- adapated from crypto-api 0.13.3, Crypto.Util.i2bs_unsized
i2be :: (Integral a, Bits a) => a -> BS.ByteString
i2be :: forall a. (Integral a, Bits a) => a -> Bytes
i2be a
0 = Word8 -> Bytes
BS.singleton Word8
0
i2be a
i = Bytes -> Bytes
BS.reverse (Bytes -> Bytes) -> Bytes -> Bytes
forall a b. (a -> b) -> a -> b
$ (a -> Maybe (Word8, a)) -> a -> Bytes
forall a. (a -> Maybe (Word8, a)) -> a -> Bytes
BS.unfoldr (\a
i' -> if a
i' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 then Maybe (Word8, a)
forall a. Maybe a
Nothing else (Word8, a) -> Maybe (Word8, a)
forall a. a -> Maybe a
Just (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i', (a
i' a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))) a
i