typed-encoding-0.2.2.0: Type safe string transformations

Safe HaskellSafe
LanguageHaskell2010

Data.TypedEncoding.Internal.Class.Encoder

Description

Internal definition of types

Possible replacement for EncodeFAll class that works with open definitions such as "r-ban"

Documentation

data Encoder f (enc :: [Symbol]) (grps :: [Symbol]) conf str where Source #

Constructors

ZeroEnc :: Encoder f '[] '[] conf str

constructor is to be treated as Unsafe to Encode and Decode instance implementations particular encoding instances may expose smart constructors for limited data types

AppendEnc :: (Enc xs conf str -> f (Enc (x ': xs) conf str)) -> Encoder f xs grps conf str -> Encoder f (x ': xs) (TakeUntil x ":" ': grps) conf str 

runEncoder :: forall grps enc f c str. Monad f => Encoder f enc grps c str -> Enc ('[] :: [Symbol]) c str -> f (Enc enc c str) Source #

encodeFEncoder :: forall f t tg xs gxs c str. (tg ~ TakeUntil t ":", Encodings f xs gxs c str, EncodeF f (Enc xs c str) (Enc (t ': xs) c str)) => Encoder f (t ': xs) (tg ': gxs) c str Source #

class Encodings f (enc :: [Symbol]) (grps :: [Symbol]) c str where Source #

Methods

encodings :: Encoder f enc grps c str Source #

Instances
Encodings f ([] :: [Symbol]) ([] :: [Symbol]) c str Source # 
Instance details

Defined in Data.TypedEncoding.Internal.Class.Encoder

Methods

encodings :: Encoder f [] [] c str Source #

(KnownSymbol s, "r-ban" ~ TakeUntil s ":", IsStringR str, Encodings (Either EncodeEx) xs grps c str) => Encodings (Either EncodeEx) (s ': xs) ("r-ban" ': grps) c str Source # 
Instance details

Defined in Data.TypedEncoding.Combinators.Restriction.BoundedAlphaNums

Methods

encodings :: Encoder (Either EncodeEx) (s ': xs) ("r-ban" ': grps) c str Source #

Encodings (Either EncodeEx) xs grps c ByteString => Encodings (Either EncodeEx) ("enc-B64" ': xs) ("enc-B64" ': grps) c ByteString Source # 
Instance details

Defined in Data.TypedEncoding.Instances.Enc.Base64

Methods

encodings :: Encoder (Either EncodeEx) ("enc-B64" ': xs) ("enc-B64" ': grps) c ByteString Source #

Encodings (Either EncodeEx) xs grps c ByteString => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c ByteString Source # 
Instance details

Defined in Data.TypedEncoding.Instances.Restriction.ASCII

Methods

encodings :: Encoder (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c ByteString Source #

Encodings (Either EncodeEx) xs grps c ByteString => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c ByteString Source # 
Instance details

Defined in Data.TypedEncoding.Instances.Restriction.ASCII

Methods

encodings :: Encoder (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c ByteString Source #

Encodings (Either EncodeEx) xs grps c Text => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c Text Source # 
Instance details

Defined in Data.TypedEncoding.Instances.Restriction.ASCII

Methods

encodings :: Encoder (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c Text Source #

Encodings (Either EncodeEx) xs grps c Text => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c Text Source # 
Instance details

Defined in Data.TypedEncoding.Instances.Restriction.ASCII

Methods

encodings :: Encoder (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c Text Source #

Encodings (Either EncodeEx) xs grps c String => Encodings (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c String Source # 
Instance details

Defined in Data.TypedEncoding.Instances.Restriction.ASCII

Methods

encodings :: Encoder (Either EncodeEx) ("r-ASCII" ': xs) ("r-ASCII" ': grps) c String Source #

Encodings (Either EncodeEx) xs grps c ByteString => Encodings (Either EncodeEx) ("r-UTF8" ': xs) ("r-UTF8" ': grps) c ByteString Source # 
Instance details

Defined in Data.TypedEncoding.Instances.Restriction.UTF8

Methods

encodings :: Encoder (Either EncodeEx) ("r-UTF8" ': xs) ("r-UTF8" ': grps) c ByteString Source #

Encodings (Either EncodeEx) xs grps c ByteString => Encodings (Either EncodeEx) ("r-UTF8" ': xs) ("r-UTF8" ': grps) c ByteString Source #

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

>>> encodeFAll . toEncoding () $ "\xc3\xb1" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)
Right (MkEnc Proxy () "\195\177")
>>> encodeFAll . toEncoding () $ "\xc3\x28" :: Either EncodeEx (Enc '["r-UTF8"] () B.ByteString)
Left (EncodeEx "r-UTF8" (Cannot decode byte '\xc3': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream))

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

\(b :: B.ByteString) -> verEncoding b (fmap (fromEncoding . decodeAll . proxiedId (Proxy :: Proxy (Enc '["r-UTF8"] _ _))) . (encodeFAll :: _ -> Either EncodeEx _). toEncoding () $ b)
Instance details

Defined in Data.TypedEncoding.Instances.Restriction.UTF8

Methods

encodings :: Encoder (Either EncodeEx) ("r-UTF8" ': xs) ("r-UTF8" ': grps) c ByteString Source #