{- | Inefficient attempt at UTF-8 magics.

To encode UTF-8 strings to bytestrings at compile time, we really need more
support from the compiler. We can go @Char -> Natural@, but we can't go @Natural
-> [Natural]@ where each value is @<= 255@. Doing so is hard without bit
twiddling.

The best we can do is get reify the 'Symbol' directly, then encode as UTF-8 at
runtime. It's a bit of a farce, and we can't derive a 'CBLen' instance, but
works just fine. Actually, I dunno, it might be faster than the bytewise magic
handling, depending on how GHC optimizes its instances.
-}

{-# LANGUAGE AllowAmbiguousTypes #-}

module Binrep.Type.Magic.UTF8 where

import Binrep

import GHC.TypeLits
import GHC.Exts ( proxy#, Proxy# )
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.ByteString qualified as B
import FlatParse.Basic qualified as FP

data MagicUTF8 (str :: Symbol) = MagicUTF8 deriving Int -> MagicUTF8 str -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (str :: Symbol). Int -> MagicUTF8 str -> ShowS
forall (str :: Symbol). [MagicUTF8 str] -> ShowS
forall (str :: Symbol). MagicUTF8 str -> String
showList :: [MagicUTF8 str] -> ShowS
$cshowList :: forall (str :: Symbol). [MagicUTF8 str] -> ShowS
show :: MagicUTF8 str -> String
$cshow :: forall (str :: Symbol). MagicUTF8 str -> String
showsPrec :: Int -> MagicUTF8 str -> ShowS
$cshowsPrec :: forall (str :: Symbol). Int -> MagicUTF8 str -> ShowS
Show

symVal :: forall str. KnownSymbol str => String
symVal :: forall (str :: Symbol). KnownSymbol str => String
symVal = forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# str)

instance KnownSymbol str => BLen (MagicUTF8 str) where
    blen :: MagicUTF8 str -> Int
blen MagicUTF8 str
MagicUTF8 = forall a. AsBLen a => Int -> a
posIntToBLen forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length forall a b. (a -> b) -> a -> b
$ String -> ByteString
encodeStringUtf8 forall a b. (a -> b) -> a -> b
$ forall (str :: Symbol). KnownSymbol str => String
symVal @str

instance KnownSymbol str => Put  (MagicUTF8 str) where
    put :: MagicUTF8 str -> Builder
put  MagicUTF8 str
MagicUTF8 = forall a. Put a => a -> Builder
put forall a b. (a -> b) -> a -> b
$ String -> ByteString
encodeStringUtf8 forall a b. (a -> b) -> a -> b
$ forall (str :: Symbol). KnownSymbol str => String
symVal @str

instance KnownSymbol str => Get  (MagicUTF8 str) where
    get :: Getter (MagicUTF8 str)
get = do
        let expected :: ByteString
expected = String -> ByteString
encodeStringUtf8 forall a b. (a -> b) -> a -> b
$ forall (str :: Symbol). KnownSymbol str => String
symVal @str
        ByteString
actual <- forall e. Int -> Parser e ByteString
FP.takeBs forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
expected
        if   ByteString
actual forall a. Eq a => a -> a -> Bool
== ByteString
expected
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall (str :: Symbol). MagicUTF8 str
MagicUTF8
        else forall a. EBase -> Getter a
eBase forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> EBase
EExpected ByteString
expected ByteString
actual

encodeStringUtf8 :: String -> B.ByteString
encodeStringUtf8 :: String -> ByteString
encodeStringUtf8 = Text -> ByteString
Text.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack