imprint-0.0.1.0: Serialization of arbitrary Haskell expressions

Copyright© 2018 Mark Karpov
LicenseBSD 3 clause
MaintainerMark Karpov <markkarpov92@gmail.com>
Stabilityexperimental
Portabilityportable
Safe HaskellNone
LanguageHaskell2010

Data.Imprint

Contents

Description

This package provides a solution for serialization of arbitrary Haskell values, monomorphic functions, and closures without relying on remote tables or Template Haskell, with minimum boilderplate.

To use the package, be sure to enable the following language extensions:

The following form of import is recommended:

import Data.Imprint (Imprint, Col (..), Dict (..), (<:>))
import qualified Data.Imprint as I

To serialize a value, we must first create an Imprint of it. If the value in question is an instance of the Binary type class, then the binary function should be used:

intImprint :: Imprint 'Z Int
intImprint = I.binary (static Dict) 4

The static keyword has to do with the concept of static pointers, see the link above. We won't go into the details here, but it suffices to say that we need to have an evidence of existence of Binary instance in serializable form. static, being a keyword, not a function, has to be used like this and cannot be put inside binary, because it creates a pointer to a concrete thing that is passed to it. This little ceremony of passing static Dict as the first argument of binary every time you create an Imprint of a value that has a Binary instance is the only boilderplate we have to put up with, though.

To create an Imprint of a function or indeed almost anything that has no Binary instance, we use the static function:

funImprint :: Imprint 'Z (Int -> String -> String)
funImprint = I.static (static f)
  where
    f n str = str ++ show n

The f function we want to serialize may be defined anywhere. Note that the resulting Imprint is opaque and has no sign of how it was created (with binary or with static).

Finally, there is a way to apply an Imprint of a value to an Imprint of a function with (<:>):

closureImprint :: Imprint ('Z ':~> Int) (String -> String)
closureImprint = funImprint <:> intImprint

Note how the applied arguments are collected in the phantom type (the first argument of Imprint type constructor). There is no requirement to apply all arguments, you may transmit a partially applied function all right.

Now, to serialization. That is quite simple, because Imprint is an instance of Binary and so it is perfectly serializable. On the receiving site, you however must know the full type of Imprint, including the collection of applied arguments in order to restore it.

If a more dynamic approach is desirable, we could adopt the representation of closures used in distributed-process as a special case with the following type of Imprint:

Imprint ('Z ':~> ByteString) (Process ())

In that case we would need to serialize all the arguments beforehand and put the deserializing code into the ByteString -> Process () function.

Finally, we give the guarantee that if you have a value of the type Imprint as a, then you can have the a value back, see restore:

restore :: Imprint bs a -> a

Synopsis

Types

data Imprint (bs :: Col *) a Source #

Imprint bs a is an image of a that is isomorphic to a and serializable.

Instances

Typeable * a => Binary (Imprint (Z *) a) Source # 

Methods

put :: Imprint (Z *) a -> Put #

get :: Get (Imprint (Z *) a) #

putList :: [Imprint (Z *) a] -> Put #

(Binary (Imprint bs (b -> a)), Typeable * a, Typeable * b) => Binary (Imprint ((:~>) * bs b) a) Source # 

Methods

put :: Imprint ((* :~> bs) b) a -> Put #

get :: Get (Imprint ((* :~> bs) b) a) #

putList :: [Imprint ((* :~> bs) b) a] -> Put #

data Col a where Source #

This helper type is used to build the phantom type holding types of the arguments applied to an Imprint of a function.

Constructors

Z :: Col a 
(:~>) :: Col a -> a -> Col a infixl 4 

data Dict a :: Constraint -> * where #

Values of type Dict p capture a dictionary for a constraint of type p.

e.g.

Dict :: Dict (Eq Int)

captures a dictionary that proves we have an:

instance Eq 'Int

Pattern matching on the Dict constructor will bring this instance into scope.

Constructors

Dict :: Dict a 

Instances

a :=> (Read (Dict a)) 

Methods

ins :: a :- Read (Dict a) #

a :=> (Monoid (Dict a)) 

Methods

ins :: a :- Monoid (Dict a) #

a :=> (Enum (Dict a)) 

Methods

ins :: a :- Enum (Dict a) #

a :=> (Bounded (Dict a)) 

Methods

ins :: a :- Bounded (Dict a) #

() :=> (Eq (Dict a)) 

Methods

ins :: () :- Eq (Dict a) #

() :=> (Ord (Dict a)) 

Methods

ins :: () :- Ord (Dict a) #

() :=> (Show (Dict a)) 

Methods

ins :: () :- Show (Dict a) #

a => Bounded (Dict a) 

Methods

minBound :: Dict a #

maxBound :: Dict a #

a => Enum (Dict a) 

Methods

succ :: Dict a -> Dict a #

pred :: Dict a -> Dict a #

toEnum :: Int -> Dict a #

fromEnum :: Dict a -> Int #

enumFrom :: Dict a -> [Dict a] #

enumFromThen :: Dict a -> Dict a -> [Dict a] #

enumFromTo :: Dict a -> Dict a -> [Dict a] #

enumFromThenTo :: Dict a -> Dict a -> Dict a -> [Dict a] #

Eq (Dict a) 

Methods

(==) :: Dict a -> Dict a -> Bool #

(/=) :: Dict a -> Dict a -> Bool #

(Typeable Constraint p, p) => Data (Dict p) 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Dict p -> c (Dict p) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Dict p) #

toConstr :: Dict p -> Constr #

dataTypeOf :: Dict p -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Dict p)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Dict p)) #

gmapT :: (forall b. Data b => b -> b) -> Dict p -> Dict p #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dict p -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dict p -> r #

gmapQ :: (forall d. Data d => d -> u) -> Dict p -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Dict p -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Dict p -> m (Dict p) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Dict p -> m (Dict p) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Dict p -> m (Dict p) #

Ord (Dict a) 

Methods

compare :: Dict a -> Dict a -> Ordering #

(<) :: Dict a -> Dict a -> Bool #

(<=) :: Dict a -> Dict a -> Bool #

(>) :: Dict a -> Dict a -> Bool #

(>=) :: Dict a -> Dict a -> Bool #

max :: Dict a -> Dict a -> Dict a #

min :: Dict a -> Dict a -> Dict a #

a => Read (Dict a) 
Show (Dict a) 

Methods

showsPrec :: Int -> Dict a -> ShowS #

show :: Dict a -> String #

showList :: [Dict a] -> ShowS #

a => Monoid (Dict a) 

Methods

mempty :: Dict a #

mappend :: Dict a -> Dict a -> Dict a #

mconcat :: [Dict a] -> Dict a #

Creation of imprints

binary :: Typeable a => StaticPtr (Dict (Binary a)) -> a -> Imprint Z a Source #

Create an Imprint of a value with Binary instance.

intImprint :: Imprint 'Z Int
intImprint = I.binary (static Dict) 4

static :: Typeable a => StaticPtr a -> Imprint Z a Source #

Create an Imprint of a value without Binary instance.

funImprint :: Imprint 'Z (Int -> String -> String)
funImprint = I.static (static f)
  where
    f n str = str ++ show n

(<:>) :: Imprint bs (b -> a) -> Imprint Z b -> Imprint (bs :~> b) a infixl 4 Source #

Apply Imprint of a value to an Imprint of a function building a closure.

closureImprint :: Imprint ('Z ':~> Int) (String -> String)
closureImprint = funImprint <:> intImprint

Elimination of imprints

restore :: Imprint as a -> a Source #

Restore a value from its Imprint.