static-0.1.0.0: Type-safe and interoperable static values and closures

Safe HaskellNone
LanguageHaskell2010

Control.Static.Serialise

Synopsis

Documentation

data SKeyedExt g Source #

Serialisable external value, with an associated static-key.

g is a type that can generically represent all the external interface of your static values. See RepVal and DoubleEncoding for more details.

Constructors

SKeyedExt !String !g 
Instances
Functor SKeyedExt Source # 
Instance details

Defined in Control.Static.Serialise

Methods

fmap :: (a -> b) -> SKeyedExt a -> SKeyedExt b #

(<$) :: a -> SKeyedExt b -> SKeyedExt a #

Eq g => Eq (SKeyedExt g) Source # 
Instance details

Defined in Control.Static.Serialise

Methods

(==) :: SKeyedExt g -> SKeyedExt g -> Bool #

(/=) :: SKeyedExt g -> SKeyedExt g -> Bool #

Ord g => Ord (SKeyedExt g) Source # 
Instance details

Defined in Control.Static.Serialise

Read g => Read (SKeyedExt g) Source # 
Instance details

Defined in Control.Static.Serialise

Show g => Show (SKeyedExt g) Source # 
Instance details

Defined in Control.Static.Serialise

Generic (SKeyedExt g) Source # 
Instance details

Defined in Control.Static.Serialise

Associated Types

type Rep (SKeyedExt g) :: Type -> Type #

Methods

from :: SKeyedExt g -> Rep (SKeyedExt g) x #

to :: Rep (SKeyedExt g) x -> SKeyedExt g #

Binary g => Binary (SKeyedExt g) Source # 
Instance details

Defined in Control.Static.Serialise

Methods

put :: SKeyedExt g -> Put #

get :: Get (SKeyedExt g) #

putList :: [SKeyedExt g] -> Put #

Serialise g => Serialise (SKeyedExt g) Source # 
Instance details

Defined in Control.Static.Serialise

type Rep (SKeyedExt g) Source # 
Instance details

Defined in Control.Static.Serialise

type Rep (SKeyedExt g) = D1 (MetaData "SKeyedExt" "Control.Static.Serialise" "static-0.1.0.0-7wqGG0f3J7JHnhbc0pzNq6" False) (C1 (MetaCons "SKeyedExt" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 String) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 g)))

data SKeyedError Source #

Possible errors when resolving a key in a static table.

Instances
Eq SKeyedError Source # 
Instance details

Defined in Control.Static.Serialise

Ord SKeyedError Source # 
Instance details

Defined in Control.Static.Serialise

Read SKeyedError Source # 
Instance details

Defined in Control.Static.Serialise

Show SKeyedError Source # 
Instance details

Defined in Control.Static.Serialise

Generic SKeyedError Source # 
Instance details

Defined in Control.Static.Serialise

Associated Types

type Rep SKeyedError :: Type -> Type #

Binary SKeyedError Source # 
Instance details

Defined in Control.Static.Serialise

Serialise SKeyedError Source # 
Instance details

Defined in Control.Static.Serialise

type Rep SKeyedError Source # 
Instance details

Defined in Control.Static.Serialise

type Rep SKeyedError = D1 (MetaData "SKeyedError" "Control.Static.Serialise" "static-0.1.0.0-7wqGG0f3J7JHnhbc0pzNq6" False) (C1 (MetaCons "SKeyedNotFound" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)) :+: C1 (MetaCons "SKeyedExtDecodeFailure" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)))

class RepVal g (v :: Type) (k :: kt) where Source #

A value and its external representation, indexed by some key.

Methods

toRep :: Sing k -> v -> g Source #

Convert an external value into its generic representation.

fromRep :: Sing k -> g -> Either String v Source #

Convert a generic representation into its external value.

This may fail, since g may have to represent several other v' as well, which k should help determine.

Instances
Typeable v => RepVal Dynamic v (k :: kt) Source #

RepVal instance for Dynamic.

Note that by nature this is not serialisable, and is only really meant for testing purposes. Neither can it support a generic Eq or Ord instance; if you need that then try DSerialise or DBinary.

Instance details

Defined in Control.Static.Serialise

Methods

toRep :: Sing k -> v -> Dynamic Source #

fromRep :: Sing k -> Dynamic -> Either String v Source #

(Typeable v, Serialise v) => RepVal DSerialise v (k :: kt) Source # 
Instance details

Defined in Control.Static.Serialise

(Typeable v, Binary v) => RepVal DBinary v (k :: kt) Source # 
Instance details

Defined in Control.Static.Serialise

Methods

toRep :: Sing k -> v -> DBinary Source #

fromRep :: Sing k -> DBinary -> Either String v Source #

type RepValSym3 (g6989586621679180882 :: Type) (v6989586621679180883 :: Type) (k6989586621679180884 :: kt6989586621679180881) = RepVal g6989586621679180882 v6989586621679180883 k6989586621679180884 Source #

data RepValSym2 (g6989586621679180882 :: Type) (v6989586621679180883 :: Type) :: forall kt6989586621679180881. (~>) kt6989586621679180881 Constraint where Source #

Constructors

RepValSym2KindInference :: forall g6989586621679180882 v6989586621679180883 k6989586621679180884 arg. SameKind (Apply (RepValSym2 g6989586621679180882 v6989586621679180883) arg) (RepValSym3 g6989586621679180882 v6989586621679180883 arg) => RepValSym2 g6989586621679180882 v6989586621679180883 k6989586621679180884 
Instances
SuppressUnusedWarnings (RepValSym2 v6989586621679180883 g6989586621679180882 kt6989586621679180881 :: TyFun kt6989586621679180881 Constraint -> Type) Source # 
Instance details

Defined in Control.Static.Serialise

type Apply (RepValSym2 v6989586621679180883 g6989586621679180882 kt :: TyFun kt Constraint -> Type) (k6989586621679180884 :: kt) Source # 
Instance details

Defined in Control.Static.Serialise

type Apply (RepValSym2 v6989586621679180883 g6989586621679180882 kt :: TyFun kt Constraint -> Type) (k6989586621679180884 :: kt) = RepVal v6989586621679180883 g6989586621679180882 k6989586621679180884

data RepValSym1 (g6989586621679180882 :: Type) :: forall kt6989586621679180881. (~>) Type ((~>) kt6989586621679180881 Constraint) where Source #

Constructors

RepValSym1KindInference :: forall g6989586621679180882 v6989586621679180883 arg. SameKind (Apply (RepValSym1 g6989586621679180882) arg) (RepValSym2 g6989586621679180882 arg) => RepValSym1 g6989586621679180882 v6989586621679180883 
Instances
SuppressUnusedWarnings (RepValSym1 g6989586621679180882 kt6989586621679180881 :: TyFun Type (kt6989586621679180881 ~> Constraint) -> Type) Source # 
Instance details

Defined in Control.Static.Serialise

type Apply (RepValSym1 g6989586621679180882 kt6989586621679180881 :: TyFun Type (kt6989586621679180881 ~> Constraint) -> Type) (v6989586621679180883 :: Type) Source # 
Instance details

Defined in Control.Static.Serialise

type Apply (RepValSym1 g6989586621679180882 kt6989586621679180881 :: TyFun Type (kt6989586621679180881 ~> Constraint) -> Type) (v6989586621679180883 :: Type) = (RepValSym2 g6989586621679180882 v6989586621679180883 kt6989586621679180881 :: TyFun kt6989586621679180881 Constraint -> Type)

data RepValSym0 :: forall kt6989586621679180881. (~>) Type ((~>) Type ((~>) kt6989586621679180881 Constraint)) where Source #

Constructors

RepValSym0KindInference :: forall g6989586621679180882 arg. SameKind (Apply RepValSym0 arg) (RepValSym1 arg) => RepValSym0 g6989586621679180882 
Instances
SuppressUnusedWarnings (RepValSym0 :: TyFun Type (Type ~> (kt6989586621679180881 ~> Constraint)) -> Type) Source # 
Instance details

Defined in Control.Static.Serialise

type Apply (RepValSym0 :: TyFun Type (Type ~> (kt6989586621679180881 ~> Constraint)) -> Type) (g6989586621679180882 :: Type) Source # 
Instance details

Defined in Control.Static.Serialise

type Apply (RepValSym0 :: TyFun Type (Type ~> (kt6989586621679180881 ~> Constraint)) -> Type) (g6989586621679180882 :: Type) = (RepValSym1 g6989586621679180882 kt6989586621679180881 :: TyFun Type (kt6989586621679180881 ~> Constraint) -> Type)

castOrFail :: forall s t. (Typeable s, Typeable t) => s -> Either String t Source #

data DoubleEncoding s b where Source #

Uniform generic wrapper.

In a type-safe language like Haskell, one needs to know in advance the type of something in order to deserialise it successfully. In many applications however, the point at which data enters the program is separate from the point at which we have enough type information to fully deserialise a statically-keyed value. Between these points, we often want to deserialise the other parts of that data, and perform logic based on its value.

This wrapper works around that fact by double-encoding the static-value. This is perhaps suboptimal performance-wise, but is simple to implement and use, especially in a compositional manner. When data first enters the program, one can deserialise the whole data using the mechanism represented by s, which will then contain HalfEncoded b instances of this type inside it. When you finally have enough type information to perform the rest of the deserialise you can call fromRep on these parts, to recovered the typed value corresponding to each part.

This wrapper also short-circuits the case of calling toRep then fromRep without attempting to serialise the value in between. In this case the original value is simply wrapped in the Decoded constructor, no attempt to serialise based on s is actually made, and no value based on b is ever constructed.

If you need optimal performance and really must avoid double-serialising, you can instead define your own ADT as a sum-type over all your possible serialisation types, make this serialisable, and implement RepVal for it.

s is a constraint over serialisable types, e.g Serialise or Binary. b is the concrete serialisation type, e.g. ByteString.

Constructors

Decoded :: (Typeable t, s t) => !t -> DoubleEncoding s b 
HalfEncoded :: !b -> DoubleEncoding s b 
Instances
Eq DBinary Source # 
Instance details

Defined in Control.Static.Serialise

Methods

(==) :: DBinary -> DBinary -> Bool #

(/=) :: DBinary -> DBinary -> Bool #

Eq DSerialise Source # 
Instance details

Defined in Control.Static.Serialise

Ord DBinary Source # 
Instance details

Defined in Control.Static.Serialise

Ord DSerialise Source # 
Instance details

Defined in Control.Static.Serialise

Binary DBinary Source # 
Instance details

Defined in Control.Static.Serialise

Methods

put :: DBinary -> Put #

get :: Get DBinary #

putList :: [DBinary] -> Put #

Serialise DSerialise Source # 
Instance details

Defined in Control.Static.Serialise

(Typeable v, Serialise v) => RepVal DSerialise v (k :: kt) Source # 
Instance details

Defined in Control.Static.Serialise

(Typeable v, Binary v) => RepVal DBinary v (k :: kt) Source # 
Instance details

Defined in Control.Static.Serialise

Methods

toRep :: Sing k -> v -> DBinary Source #

fromRep :: Sing k -> DBinary -> Either String v Source #