typed-encoding-0.5.2.2: Type safe string transformations

Safe HaskellSafe
LanguageHaskell2010

Data.TypedEncoding.Instances.Restriction.UTF8

Contents

Description

'UTF-8' encoding with additional assumption of conforming to Unicode.D76.

"r-UTF-8" basically defines restriction on ByteString that is needed for conversion to Text to work.

Since: 0.1.0.0

Synopsis

Documentation

prxyUtf8 :: Proxy "r-UTF8" Source #

verEncoding :: ByteString -> Either err ByteString -> Bool Source #

helper function checks that given ByteString, if is encoded as Left is must be not Utf8 decodable is is encoded as Right is must be Utf8 encodable

reexported for backward compatibility, will be removed in the future

implVerifyR :: (a -> Either err b) -> a -> Either err a Source #

Since: 0.5.1.0

Orphan instances

(RecreateErr f, Applicative f) => Validate f "r-UTF8" "r-UTF8" c ByteString Source # 
Instance details

Methods

validation :: Validation f "r-UTF8" "r-UTF8" c ByteString Source #

(RecreateErr f, Applicative f) => Validate f "r-UTF8" "r-UTF8" c ByteString Source # 
Instance details

Methods

validation :: Validation f "r-UTF8" "r-UTF8" c ByteString Source #

Applicative f => Decode f "r-UTF8" "r-UTF8" c str Source # 
Instance details

Methods

decoding :: Decoding f "r-UTF8" "r-UTF8" c str Source #

Encode (Either EncodeEx) "r-UTF8" "r-UTF8" c ByteString Source # 
Instance details

Methods

encoding :: Encoding (Either EncodeEx) "r-UTF8" "r-UTF8" c ByteString Source #

Encode (Either EncodeEx) "r-UTF8" "r-UTF8" c ByteString Source #

UTF8 encodings are defined for ByteString only as that would not make much sense for Text

>>> _runEncodings encodings . toEncoding () $ "\xc3\xb1" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)
Right (UnsafeMkEnc Proxy () "\195\177")
>>> _runEncodings encodings . toEncoding () $ "\xc3\x28" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)
Left (EncodeEx "r-UTF8" (Cannot decode byte '\xc3': ...

Following test uses verEncoding helper that checks that bytes are encoded as Right iff they are valid UTF8 bytes

>>> :{
quickCheck $ \(b :: B.ByteString) -> verEncoding b $ fmap (
         fromEncoding 
         . decodeAll @'["r-UTF8"]
         ) . encodeFAll @'["r-UTF8"] @(Either EncodeEx)
         . toEncoding () $ b
:}
+++ OK, passed 100 tests.
Instance details

Methods

encoding :: Encoding (Either EncodeEx) "r-UTF8" "r-UTF8" c ByteString Source #