Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
Internal definition of types
Synopsis
- data Enc enc conf str where
- toEncoding :: conf -> str -> Enc '[] conf str
- fromEncoding :: Enc '[] conf str -> str
- implTranF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)
- implEncodeF :: (Show err, KnownSymbol x) => Proxy x -> (str -> Either err str) -> Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str)
- implDecodeF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)
- implCheckPrevF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)
- implTranF' :: Functor f => (conf -> str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)
- implEncodeF' :: (Show err, KnownSymbol x) => Proxy x -> (conf -> str -> Either err str) -> Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str)
- implDecodeF' :: Functor f => (conf -> str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str)
- implTranP :: Applicative f => (str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)
- implEncodeP :: Applicative f => (str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)
- implTranP' :: Applicative f => (conf -> str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)
- implEncodeP' :: Applicative f => (conf -> str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str)
- getPayload :: Enc enc conf str -> str
- unsafeSetPayload :: conf -> str -> Enc enc conf str
- withUnsafeCoerce :: (s1 -> s2) -> Enc e1 c s1 -> Enc e2 c s2
- unsafeChangePayload :: (s1 -> s2) -> Enc e c s1 -> Enc e c s2
- data RecreateEx where
- RecreateEx :: (Show e, KnownSymbol x) => Proxy x -> e -> RecreateEx
- data EncodeEx where
- EncodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> EncodeEx
- data UnexpectedDecodeEx where
- UnexpectedDecodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> UnexpectedDecodeEx
Documentation
data Enc enc conf str where Source #
MkEnc :: Proxy enc -> conf -> str -> Enc enc 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 |
Instances
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("do-UPPER" ': xs) c Text) Source # | |
Defined in Data.TypedEncoding.Instances.Encode.Sample | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("enc-B64" ': xs) c Text) Source # | |
Defined in Data.TypedEncoding.Instances.Base64 | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("enc-B64" ': xs) c Text) Source # | |
Defined in Data.TypedEncoding.Instances.Base64 | |
Applicative f => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("enc-B64-len" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Base64 checkPrevF :: Enc ("enc-B64-len" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("enc-B64" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Base64 checkPrevF :: Enc ("enc-B64" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("enc-B64-len" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Base64 checkPrevF :: Enc ("enc-B64-len" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("enc-B64" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Base64 checkPrevF :: Enc ("enc-B64" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.UTF8 checkPrevF :: Enc ("r-UTF8" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.UTF8 checkPrevF :: Enc ("r-UTF8" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.ASCII checkPrevF :: Enc ("r-ASCII" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.ASCII checkPrevF :: Enc ("r-ASCII" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("r-ASCII" ': xs) c Text) Source # | |
Defined in Data.TypedEncoding.Instances.ASCII | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("r-ASCII" ': xs) c Text) Source # | |
Defined in Data.TypedEncoding.Instances.ASCII | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("my-sign" ': xs) c Text) Source # | Recreation allows effectful |
Defined in Examples.TypedEncoding.DiySignEncoding | |
(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 |
(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 # | |
(Eq conf, Eq str) => Eq (Enc enc conf str) Source # | |
(Show conf, Show str) => Show (Enc enc conf str) Source # | |
(Displ (Proxy xs), Show c, Displ str) => Displ (Enc xs c str) Source # | |
toEncoding :: conf -> str -> Enc '[] conf str Source #
fromEncoding :: Enc '[] conf str -> str Source #
implEncodeF :: (Show err, KnownSymbol x) => Proxy x -> (str -> Either err str) -> Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) Source #
implCheckPrevF :: Functor f => (str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str) Source #
implTranF' :: Functor f => (conf -> str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str) Source #
implEncodeF' :: (Show err, KnownSymbol x) => Proxy x -> (conf -> str -> Either err str) -> Enc enc1 conf str -> Either EncodeEx (Enc enc2 conf str) Source #
implDecodeF' :: Functor f => (conf -> str -> f str) -> Enc enc1 conf str -> f (Enc enc2 conf str) Source #
implEncodeP :: Applicative f => (str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str) Source #
implTranP' :: Applicative f => (conf -> str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str) Source #
implEncodeP' :: Applicative f => (conf -> str -> str) -> Enc enc1 conf str -> f (Enc enc2 conf str) Source #
getPayload :: Enc enc conf str -> str Source #
unsafeSetPayload :: conf -> str -> Enc enc conf str Source #
withUnsafeCoerce :: (s1 -> s2) -> Enc e1 c s1 -> Enc e2 c s2 Source #
unsafeChangePayload :: (s1 -> s2) -> Enc e c s1 -> Enc e c s2 Source #
data RecreateEx where Source #
Represents errors in recovery (recreation of encoded types).
RecreateEx :: (Show e, KnownSymbol x) => Proxy x -> e -> RecreateEx |
Instances
Show RecreateEx Source # | |
Defined in Data.TypedEncoding.Internal.Types showsPrec :: Int -> RecreateEx -> ShowS # show :: RecreateEx -> String # showList :: [RecreateEx] -> ShowS # | |
RecreateErr (Either RecreateEx) Source # | |
Defined in Data.TypedEncoding.Internal.Class recoveryErr :: RecreateEx -> Either RecreateEx a Source # |
Represents errors in encoding
EncodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> EncodeEx |
Instances
Show EncodeEx Source # | |
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 # | |
data UnexpectedDecodeEx where Source #
Type safety over encodings makes decoding process safe. However failures are still possible due to bugs or unsafe payload modifications. UnexpectedDecodeEx represents such errors.
UnexpectedDecodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> UnexpectedDecodeEx |
Instances
Show UnexpectedDecodeEx Source # | |
Defined in Data.TypedEncoding.Internal.Types showsPrec :: Int -> UnexpectedDecodeEx -> ShowS # show :: UnexpectedDecodeEx -> String # showList :: [UnexpectedDecodeEx] -> ShowS # | |
UnexpectedDecodeErr (Either UnexpectedDecodeEx) Source # | |