module Binrep.Type.Text.Encoding.Utf8 where

import Binrep.Type.Text.Internal

import Refined

import Data.Text.Encoding qualified as Text
import Data.Text ( Text )

data Utf8

instance Encode Utf8 where encode' :: Text -> Bytes
encode' = Text -> Bytes
Text.encodeUtf8
instance Decode Utf8 where decode :: Bytes -> Either String (AsText Utf8)
decode  = (UnicodeException -> String)
-> (Bytes -> Either UnicodeException Text)
-> Bytes
-> Either String (AsText Utf8)
forall {k} (enc :: k) e.
(e -> String)
-> (Bytes -> Either e Text) -> Bytes -> Either String (AsText enc)
decodeText UnicodeException -> String
forall a. Show a => a -> String
show Bytes -> Either UnicodeException Text
Text.decodeUtf8'

-- | Any 'Text' value is always valid UTF-8.
instance Predicate Utf8 Text where validate :: Proxy Utf8 -> Text -> Maybe RefineException
validate Proxy Utf8
_ Text
_ = Maybe RefineException
success