{-# LANGUAGE UndecidableInstances #-}
module Data.Type.BitRecords.SizedString
(SizedString()
,ASizedString()
,utf8
,utf82
,SizedString2())
where
import Data.Type.BitRecords.Core
import Data.FunctionBuilder
import Data.Type.BitRecords.Builder.LazyByteStringBuilder
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Quote as TH
import GHC.TypeLits
import Data.Type.Pretty
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Proxy
import Data.Kind.Extra
type SizedString str bytes =
MkField ('MkFieldCustom :: BitField ASizedString ASizedString (8 * bytes)) := 'MkASizedString str bytes
type SizedString2 str bytes =
Konst ('MkFieldCustom :: BitField ASizedString ASizedString (8 * bytes)) :=. 'MkASizedString str bytes
data ASizedString where
MkASizedString :: Symbol -> Nat -> ASizedString
type instance
SizeInBytes ('MkASizedString str byteCount) = byteCount
type instance
ToPretty ASizedString = PutStr "utf-8"
type instance PrettyCustomFieldValue ASizedString ASizedString s sr =
ToPretty sr
type instance
ToPretty ('MkASizedString str byteCount) =
PrettySurrounded (PutStr "<<") (PutStr ">>") (PutStr str)
<+> PutStr "[" <++> PutNat byteCount <++> PutStr " Bytes]"
utf8 :: TH.QuasiQuoter
utf8 = TH.QuasiQuoter undefined undefined mkSizedStr undefined
where mkSizedStr :: String -> TH.Q TH.Type
mkSizedStr str =
do let strT = TH.LitT (TH.StrTyLit str)
byteCount =
fromIntegral (B.length (E.encodeUtf8 (T.pack str)))
byteCountT = TH.LitT (TH.NumTyLit byteCount)
return $
TH.PromotedT ''SizedString `TH.AppT` strT `TH.AppT` byteCountT
utf82 :: TH.QuasiQuoter
utf82 = TH.QuasiQuoter undefined undefined mkSizedStr undefined
where mkSizedStr :: String -> TH.Q TH.Type
mkSizedStr str =
do let strT = TH.LitT (TH.StrTyLit str)
byteCount =
fromIntegral (B.length (E.encodeUtf8 (T.pack str)))
byteCountT = TH.LitT (TH.NumTyLit byteCount)
return $
TH.PromotedT ''SizedString2 `TH.AppT` strT `TH.AppT` byteCountT
instance
forall (size :: Nat)
(str :: Symbol)
(bytes :: Nat)
(f :: Extends (BitRecordField ('MkFieldCustom :: BitField ASizedString ASizedString size))) .
(KnownSymbol str)
=> HasFunctionBuilder BitBuilder (Proxy (f := 'MkASizedString str bytes))
where
toFunctionBuilder _ =
immediate (appendStrictByteString
(E.encodeUtf8 (T.pack (symbolVal (Proxy @str)))))
instance
forall (size :: Nat)
(str :: Symbol)
(bytes :: Nat)
(f :: Extends (BitField ASizedString ASizedString size)) .
(KnownSymbol str)
=> HasFunctionBuilder BitBuilder (Proxy (f :=. 'MkASizedString str bytes))
where
toFunctionBuilder _ =
immediate (appendStrictByteString
(E.encodeUtf8 (T.pack (symbolVal (Proxy @str)))))