Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
Synopsis
- class EncodeF f instr outstr where
- encodeF :: instr -> f outstr
- class EncodeFAll f (xs :: [k]) c str where
- encodeFAll :: Enc '[] c str -> f (Enc xs c str)
- encodeAll :: EncodeFAll Identity (xs :: [k]) c str => Enc '[] c str -> Enc xs c str
- class DecodeF f instr outstr where
- decodeF :: instr -> f outstr
- class DecodeFAll f (xs :: [k]) c str where
- decodeFAll :: Enc xs c str -> f (Enc '[] c str)
- decodeAll :: DecodeFAll Identity (xs :: [k]) c str => Enc xs c str -> Enc '[] c str
- class RecreateF f instr outstr where
- checkPrevF :: outstr -> f instr
- class Functor f => RecreateFAll f (xs :: [k]) c str where
- recreateAll :: RecreateFAll Identity (xs :: [k]) c str => Enc '[] c str -> Enc xs c str
- type family Append (xs :: [k]) (ys :: [k]) :: [k] where ...
- encodeFPart :: forall f xs xsf c str. (Functor f, EncodeFAll f xs c str) => Proxy xs -> Enc xsf c str -> f (Enc (Append xs xsf) c str)
- encodePart :: EncodeFAll Identity (xs :: [k]) c str => Proxy xs -> Enc xsf c str -> Enc (Append xs xsf) c str
- decodeFPart :: forall f xs xsf c str. (Functor f, DecodeFAll f xs c str) => Proxy xs -> Enc (Append xs xsf) c str -> f (Enc xsf c str)
- decodePart :: DecodeFAll Identity (xs :: [k]) c str => Proxy xs -> Enc (Append xs xsf) c str -> Enc xsf c str
- class Subset (x :: k) (y :: k) where
- class FlattenAs (x :: k) (y :: k) where
- class HasA c a where
- class UnexpectedDecodeErr f where
- unexpectedDecodeErr :: UnexpectedDecodeEx -> f a
- asUnexpected :: (UnexpectedDecodeErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a
- class RecreateErr f where
- recoveryErr :: RecreateEx -> f a
- asRecreateErr :: (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a
- class Displ x where
- errorOnLeft :: Show err => Either err a -> a
Documentation
>>>
:set -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XFlexibleInstances -XFlexibleContexts
>>>
import Data.TypedEncoding.Internal.Types (unsafeSetPayload)
class EncodeF f instr outstr where Source #
Instances
(HasA c SizeLimit, Applicative f) => EncodeF (f :: Type -> Type) (Enc xs c ByteString) (Enc ("do-size-limit" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Encode.Sample encodeF :: Enc xs c ByteString -> f (Enc ("do-size-limit" ': xs) c ByteString) Source # | |
(HasA c SizeLimit, Applicative f) => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-size-limit" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-reverse" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-reverse" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-Title" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-Title" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-lower" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-lower" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-UPPER" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-UPPER" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("enc-B64" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("enc-B64" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c ByteString) (Enc ("enc-B64" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Base64 encodeF :: Enc xs c ByteString -> f (Enc ("enc-B64" ': xs) c ByteString) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c ByteString) (Enc ("enc-B64" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Base64 encodeF :: Enc xs c ByteString -> f (Enc ("enc-B64" ': xs) c ByteString) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("my-sign" ': xs) c Text :: Type) Source # | Because encoding function is pure we can create instance of EncodeF
that is polymorphic in effect |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-UTF8" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.UTF8 encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-UTF8" ': xs) c ByteString :: Type) Source # | UTF8 encodings are defined for ByteString only as that would not make much sense for Text
Following test uses \(b :: B.ByteString) -> verEncoding b (fmap (fromEncoding . decodeAll . proxiedId (Proxy :: Proxy (Enc '["r-UTF8"] _ _))) . (encodeFAll :: _ -> Either EncodeEx _). toEncoding () $ b) |
Defined in Data.TypedEncoding.Instances.UTF8 encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-ASCII" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.ASCII encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-ASCII" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.ASCII encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c Text) (Enc ("r-ASCII" ': xs) c Text :: Type) Source # | |
EncodeF (Either EncodeEx) (Enc xs c Text) (Enc ("r-ASCII" ': xs) c Text :: Type) Source # | |
EncodeF (Either EncodeEx) (Enc xs c Char) (Enc ("r-ASCII" ': xs) c Char :: Type) Source # | |
class EncodeFAll f (xs :: [k]) c str where Source #
encodeFAll :: Enc '[] c str -> f (Enc xs c str) Source #
Instances
Applicative f => EncodeFAll f ([] :: [k]) c str Source # | |
Defined in Data.TypedEncoding.Internal.Class encodeFAll :: Enc [] c str -> f (Enc [] c str) Source # | |
(Monad f, EncodeFAll f xs c str, EncodeF f (Enc xs c str) (Enc (x ': xs) c str)) => EncodeFAll f (x ': xs :: [k]) c str Source # | |
Defined in Data.TypedEncoding.Internal.Class encodeFAll :: Enc [] c str -> f (Enc (x ': xs) c str) Source # |
class DecodeF f instr outstr where Source #
Instances
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("enc-B64" ': xs) c Text) (Enc xs c Text :: Type) Source # | |
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("enc-B64" ': xs) c Text) (Enc xs c Text :: Type) Source # | |
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("enc-B64" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Base64 decodeF :: Enc ("enc-B64" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("enc-B64" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | Effectful instance for corruption detection. This protocol is used, for example, in emails. It is a well known encoding and hackers will have no problem making undetectable changes, but error handling at this stage could verify that email was corrupted. |
Defined in Data.TypedEncoding.Instances.Base64 decodeF :: Enc ("enc-B64" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-UTF8" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.UTF8 decodeF :: Enc ("r-UTF8" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-UTF8" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.UTF8 decodeF :: Enc ("r-UTF8" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.ASCII decodeF :: Enc ("r-ASCII" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.ASCII decodeF :: Enc ("r-ASCII" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c Text) (Enc xs c Text :: Type) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c Text) (Enc xs c Text :: Type) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c Char) (Enc xs c Char :: Type) Source # | |
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("my-sign" ': xs) c Text) (Enc xs c Text :: Type) Source # | Decoding allows effectful Implementation simply uses |
class DecodeFAll f (xs :: [k]) c str where Source #
decodeFAll :: Enc xs c str -> f (Enc '[] c str) Source #
Instances
Applicative f => DecodeFAll f ([] :: [k]) c str Source # | |
Defined in Data.TypedEncoding.Internal.Class decodeFAll :: Enc [] c str -> f (Enc [] c str) Source # | |
(Monad f, DecodeFAll f xs c str, DecodeF f (Enc (x ': xs) c str) (Enc xs c str)) => DecodeFAll f (x ': xs :: [k]) c str Source # | |
Defined in Data.TypedEncoding.Internal.Class decodeFAll :: Enc (x ': xs) c str -> f (Enc [] c str) Source # |
class RecreateF f instr outstr where Source #
Used to safely recover encoded data validating all encodingss
checkPrevF :: outstr -> f instr Source #
Instances
class Functor f => RecreateFAll f (xs :: [k]) c str where Source #
checkFAll :: Enc xs c str -> f (Enc '[] c str) Source #
recreateFAll :: Enc '[] c str -> f (Enc xs c str) Source #
Instances
Applicative f => RecreateFAll f ([] :: [k]) c str Source # | |
(Monad f, RecreateFAll f xs c str, RecreateF f (Enc xs c str) (Enc (x ': xs) c str)) => RecreateFAll f (x ': xs :: [k]) c str Source # | |
recreateAll :: RecreateFAll Identity (xs :: [k]) c str => Enc '[] c str -> Enc xs c str Source #
type family Append (xs :: [k]) (ys :: [k]) :: [k] where ... Source #
TODO use singletons definition instead?
encodeFPart :: forall f xs xsf c str. (Functor f, EncodeFAll f xs c str) => Proxy xs -> Enc xsf c str -> f (Enc (Append xs xsf) c str) Source #
encodePart :: EncodeFAll Identity (xs :: [k]) c str => Proxy xs -> Enc xsf c str -> Enc (Append xs xsf) c str Source #
decodeFPart :: forall f xs xsf c str. (Functor f, DecodeFAll f xs c str) => Proxy xs -> Enc (Append xs xsf) c str -> f (Enc xsf c str) Source #
Unsafe implementation guarded by safe type definition
decodePart :: DecodeFAll Identity (xs :: [k]) c str => Proxy xs -> Enc (Append xs xsf) c str -> Enc xsf c str Source #
class Subset (x :: k) (y :: k) where Source #
Nothing
Instances
Subset "r-ASCII" "r-UTF8" Source # | allow to treat ASCII encodings as UTF8 forgetting about B64 encoding
|
class FlattenAs (x :: k) (y :: k) where Source #
Nothing
Instances
FlattenAs "enc-B64" "r-ASCII" Source # | |
FlattenAs "enc-B64-nontext" "r-ASCII" Source # | allow to treat B64 encodings as ASCII forgetting about B64 encoding
|
Polymorphic data payloads used to encode/decode
class UnexpectedDecodeErr f where Source #
With type safety in pace decoding errors should be unexpected this class can be used to provide extra info if decoding could fail
unexpectedDecodeErr :: UnexpectedDecodeEx -> f a Source #
Instances
UnexpectedDecodeErr Identity Source # | |
Defined in Data.TypedEncoding.Internal.Class | |
UnexpectedDecodeErr (Either UnexpectedDecodeEx) Source # | |
asUnexpected :: (UnexpectedDecodeErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a Source #
class RecreateErr f where Source #
Recovery errors are expected unless Recovery allows Identity instance
recoveryErr :: RecreateEx -> f a Source #
Instances
RecreateErr (Either RecreateEx) Source # | |
Defined in Data.TypedEncoding.Internal.Class recoveryErr :: RecreateEx -> Either RecreateEx a Source # |
asRecreateErr :: (RecreateErr f, Applicative f, Show err, KnownSymbol x) => Proxy x -> Either err a -> f a Source #
Display
Human friendly version of Show
Instances
Displ String Source # | |
Displ ByteString Source # | |
Defined in Data.TypedEncoding.Internal.Class displ :: ByteString -> String Source # | |
Displ ByteString Source # | |
Defined in Data.TypedEncoding.Internal.Class displ :: ByteString -> String Source # | |
Displ Text Source # | |
Displ Text Source # | |
(pxs ~ Proxy xs, Displ pxs, KnownSymbol x) => Displ (Proxy (x ': xs)) Source # |
|
Displ (Proxy ([] :: [k])) Source # | |
(Displ (Proxy xs), Show c, Displ str) => Displ (Enc xs c str) Source # | |
errorOnLeft :: Show err => Either err a -> a Source #