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

Safe HaskellNone
LanguageHaskell2010

Control.Static

Contents

Synopsis

Common definitions

data TCTab (c :: kt ~> (Type ~> Constraint)) (kk :: [kt]) (vv :: [Type]) :: Type where Source #

Heterogeneous constrained table.

Constructors

TCNil :: TCTab c '[] '[] 
TCCons :: (c @@ k) @@ v => !(Sing (k :: kt)) -> !v -> !(TCTab c kk vv) -> TCTab c (k ': kk) (v ': vv) 

Static keys and values

type SKey (k :: Symbol) = Sing k Source #

Standalone static key with no associated value.

Users typically don't need this, and should use SKeyed or SKeyedExt as appropriate.

data SKeyed k v Source #

Internal value, typed-indexed by an associated static-key.

Generally, v is not expected to be serialisable or otherwise representable outside of the program. For cases where it is, you should define an instance of RepVal. That then enables you to use toSKeyedExt and other utility functions with this constraint.

Constructors

SKeyed !(SKey k) !v 
Instances
Functor (SKeyed k) Source # 
Instance details

Defined in Control.Static.Static

Methods

fmap :: (a -> b) -> SKeyed k a -> SKeyed k b #

(<$) :: a -> SKeyed k b -> SKeyed k a #

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)))

withSKeyedExt :: SKeyedExt g -> (forall (a :: Symbol). SKeyed a g -> r) -> r Source #

Similar to withSomeSing for a SKeyedExt, extract the type from the String key and run a typed function on the typed value.

toSKeyedExt :: RepVal g v k => SKeyed k v -> SKeyedExt g Source #

Convert an internal value to an external value, depending on the existence of an instance of RepVal to help perform the conversion.

Static tables and resolving values

gwithStatic :: forall c0 c1 f g ext (k :: Symbol) (kk :: [Symbol]) vv r. TCTab (RepExtSym3 c0 g ext) kk vv -> SKeyed k g -> TCTab c1 kk (Fmap f vv) -> (forall k' v. Just '(k', v) ~ LookupKV k kk vv => Just '(k', f @@ v) ~ Fmap (FmapSym1 f) (LookupKV k kk vv) => (c0 @@ k') @@ v => (c1 @@ k') @@ (f @@ v) => Sing k' -> (f @@ v) -> v -> (ext @@ v) -> r) -> Either SKeyedError r Source #

Given an SKeyed of an external value g, do the following:

  1. Lookup the corresponding internal value (I) of type v.
  2. Decode the external value (X) of type g, if its type can be decoded into the type ext v.
  3. Lookup the corresponding continuation (C).
  4. Apply (C) to (I) and (X), returning a value of type r.

withStaticCts :: forall c0 c1 g ext (k :: Symbol) (kk :: [Symbol]) vv r. TCTab (RepExtSym3 c0 g ext) kk vv -> SKeyed k g -> TCTab c1 kk (Fmap (TyContIXSym2 r ext) vv) -> Either SKeyedError r Source #

withSomeStaticCts :: forall c0 c1 g ext (kk :: [Symbol]) vv r. TCTab (RepExtSym3 c0 g ext) kk vv -> SKeyedExt g -> TCTab c1 kk (Fmap (TyContIXSym2 r ext) vv) -> Either SKeyedError r Source #

withStaticCxt :: forall c f g ext (k :: Symbol) (kk :: [Symbol]) vv r. TCTab (RepExtSym3 c g ext) kk vv -> SKeyed k g -> (forall k' v. Just '(k', v) ~ LookupKV k kk vv => ProofLookupKV f k kk vv => (c @@ k') @@ v => Sing k' -> v -> (ext @@ v) -> r) -> Either SKeyedError r Source #

withSomeStaticCxt :: forall c f g ext (kk :: [Symbol]) vv r. TCTab (RepExtSym3 c g ext) kk vv -> SKeyedExt g -> (forall k k' v. Just '(k', v) ~ LookupKV k kk vv => ProofLookupKV f k kk vv => (c @@ k') @@ v => Sing k' -> v -> (ext @@ v) -> r) -> Either SKeyedError r Source #

Static closures

class Closure (Part pcl) => PreClosure pcl where Source #

A pre-closure is a function that takes two statically-known arguments: a constraint, and an explicit argument; and gives a closure.

Typically, you define a bunch of top-level functions of the form (ctx => env -> arg -> res), then create a table of pre-closures using the TH function mkStaticTab.

Associated Types

type Cxt pcl :: Constraint Source #

type Env pcl Source #

type Part pcl Source #

Methods

applyPre :: Cxt pcl => pcl -> Env pcl -> Part pcl Source #

Instances
PreClosure (CxtW c (e -> v -> r)) Source # 
Instance details

Defined in Control.Static.Closure

Associated Types

type Cxt (CxtW c (e -> v -> r)) :: Constraint Source #

type Env (CxtW c (e -> v -> r)) :: Type Source #

type Part (CxtW c (e -> v -> r)) :: Type Source #

Methods

applyPre :: CxtW c (e -> v -> r) -> Env (CxtW c (e -> v -> r)) -> Part (CxtW c (e -> v -> r)) Source #

class Closure cl where Source #

A closure is a function that takes a runtime argument, and gives a result.

It is created by applying a constraint and environment to a pre-closure. Typically you do this once on a table of pre-closures, using mkClosureTab.

Associated Types

type Arg cl Source #

type Res cl Source #

Methods

apply :: cl -> Arg cl -> Res cl Source #

Instances
Closure (v -> r) Source # 
Instance details

Defined in Control.Static.Closure

Associated Types

type Arg (v -> r) :: Type Source #

type Res (v -> r) :: Type Source #

Methods

apply :: (v -> r) -> Arg (v -> r) -> Res (v -> r) Source #

class PostClosure x f where Source #

A post-closure is a function that takes a runtime result, and converts all the results of all different closures into the same type.

Associated Types

type Pre f Source #

Methods

applyPost :: f -> Pre f -> x Source #

Instances
PostClosure x (r -> x) Source # 
Instance details

Defined in Control.Static.Closure

Associated Types

type Pre (r -> x) :: Type Source #

Methods

applyPost :: (r -> x) -> Pre (r -> x) -> x Source #

type ClosureApply g = SKeyedExt g Source #

An applied closure, consisting of its static key and an argument.

applyClosure :: RepVal g arg k => SKeyed k (CxtW cxt (env -> arg -> res)) -> arg -> ClosureApply g Source #

Create a ClosureApply in its serialisable static form.

envTabCons :: SKeyed k (CxtW cxt (env -> arg -> res)) -> env -> TTab kk vv -> TTab (k ': kk) (env ': vv) Source #

envTabNil :: TTab '[] '[] Source #

mkClosureTab :: forall c1 kk vv. ConstrainList (Fmap CxtSym0 vv) => ConstrainList (ZipWith (ConstSym1 (TyCon1 PreClosure)) kk vv) => TTab kk vv -> TCTab c1 kk (Fmap EnvSym0 vv) -> TCTab' Closure kk (Fmap PartSym0 vv) Source #

Create a table of closures from a table of pre-closures.

We apply the relevant constraints and environment arguments, statically-known at compile time.

type RepClosure c g = RepExtSym3 (AndC2 (ConstSym1 (TyCon1 Closure)) (FlipSym2 (.@#@$) ResSym0 .@#@$$$ c)) g ArgSym0 Source #

RepClosure c g k v is a constraint comprising:

  • RepVal g (Arg v) k
  • c k (Res v)
  • Closure v

modulo singletons defunctionalisation on c.

type RepClosure' r g = RepClosure (ConstSym1 (TyCon1 ((~) r))) g Source #

A RepClosure whose result is exactly r.

repClosureTab :: forall c g (kk :: [Symbol]) vv. ConstrainList (ZipWith (FlipSym2 (.@#@$) ResSym0 .@#@$$$ c) kk vv) => ConstrainList (ZipWith (FlipSym1 (TyCon2 (RepVal g) .@#@$$$ ApplySym1 ArgSym0)) kk vv) => TCTab' Closure kk vv -> TCTab (RepClosure c g) kk vv Source #

Convert a Closure table into a RepClosure table, deducing constraints.

This is used to convert the result of mkClosureTab into a form that can be passed to the other functions e.g. evalSomeClosure.

withEvalClosureCts :: forall c g (k :: Symbol) (kk :: [Symbol]) vv x. TCTab (RepClosure c g) kk vv -> SKeyed k g -> TCTab' (PostClosure x) kk (Fmap (ResCont x) vv) -> Either SKeyedError x Source #

Apply a closure table to a single input and a post-processing table, giving a single result (if the input key was found).

This is the statically-typed version; for a version that runs for unknown keys see withEvalSomeClosureCts.

withEvalSomeClosureCts :: forall c g (kk :: [Symbol]) vv x. TCTab (RepClosure c g) kk vv -> ClosureApply g -> TCTab' (PostClosure x) kk (Fmap (ResCont x) vv) -> Either SKeyedError x Source #

Apply a closure table to a single input and a post-processing table, giving a single result (if the input key was found).

This is the dynamically-typed version; for a version that type-checks for statically-known keys see withEvalClosureCts.

withEvalClosureCxt :: forall c f g (k :: Symbol) (kk :: [Symbol]) vv r. TCTab (RepClosure c g) kk vv -> SKeyed k g -> (forall k' v. Just '(k', v) ~ LookupKV k kk vv => ProofLookupKV f k kk vv => (c @@ k') @@ Res v => Sing k' -> Res v -> r) -> Either SKeyedError r Source #

Apply a closure table to a single input, and pass the constrained result to a continuation (if the input key was found).

This is the statically-typed version; for a version that runs for unknown keys see withEvalSomeClosureCxt.

withEvalSomeClosureCxt :: forall c f g (kk :: [Symbol]) vv r. TCTab (RepClosure c g) kk vv -> ClosureApply g -> (forall k k' v. Just '(k', v) ~ LookupKV k kk vv => ProofLookupKV f k kk vv => (c @@ k') @@ Res v => Sing k' -> Res v -> r) -> Either SKeyedError r Source #

Apply a closure table to a single input, and pass the constrained result to a continuation (if the input key was found).

This is the dynamically-typed version; for a version that type-checks for statically-known keys see withEvalClosureCxt.

evalClosure :: forall g (k :: Symbol) (kk :: [Symbol]) vv r. TCTab (RepClosure' r g) kk vv -> SKeyed k g -> Either SKeyedError r Source #

Evaluate a closure application with statically-known type, against a table of closures, that all have the same result type.

evalSomeClosure :: forall g (kk :: [Symbol]) vv r. TCTab (RepClosure' r g) kk vv -> ClosureApply g -> Either SKeyedError r Source #

Evaluate a closure application with statically-unknown type, against a table of closures, that all have the same result type.

Serialisation

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 #

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)))

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 #