module Bytezap.Write.Derived where

import Bytezap.Write.Internal
import Bytezap.Poke.Derived qualified as P

import Data.ByteString.Short qualified as SBS
import Data.Text.Internal qualified as T
import Data.Char ( ord )

-- | Write a 'SBS.ShortByteString'.
shortByteString :: SBS.ShortByteString -> Write s
shortByteString :: forall s. ShortByteString -> Write s
shortByteString ShortByteString
sbs = Int -> Poke s -> Write s
forall s. Int -> Poke s -> Write s
Write (ShortByteString -> Int
SBS.length ShortByteString
sbs) (ShortByteString -> Poke s
forall s. ShortByteString -> Poke s
P.shortByteString ShortByteString
sbs)

-- | Write a 'T.Text'.
text :: T.Text -> Write s
text :: forall s. Text -> Write s
text t :: Text
t@(T.Text Array
_arr Int
_off Int
len) = Int -> Poke s -> Write s
forall s. Int -> Poke s -> Write s
Write Int
len (Text -> Poke s
forall s. Text -> Poke s
P.text Text
t)

-- | Write a 'Char'.
--
-- Adapted from utf8-string.
char :: Char -> Write s
char :: forall s. Char -> Write s
char Char
c = Int -> Poke s -> Write s
forall s. Int -> Poke s -> Write s
Write (Int -> Int
forall {a} {a}. (Ord a, Num a, Num a) => a -> a
go (Char -> Int
ord Char
c)) (Char -> Poke s
forall s. Char -> Poke s
P.char Char
c)
 where
  go :: a -> a
go a
oc
   | a
oc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7f       = a
1
   | a
oc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7ff      = a
2
   | a
oc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0xffff     = a
3
   | Bool
otherwise        = a
4