RPC (Or: How do I disambiguate function application based on TypeRep values?) - haskell

I'm building some infrastructure for doing remote procedure calls in Haskell, and for reasons that are too long to explain here, I cannot reuse existing libraries.
So here's the setup: I have a type class for serializing and deserializing data:
class Serializable a where
encode :: a -> B.ByteString
decode :: B.ByteString -> Maybe a
maxSize :: a -> Int
where B is Data.ByteString.
I can use this to implement serialization of integers, booleans, lists of serializables, tuples of serializables ect.
Now I want to send some arguments across a network to a server, which then performs a computation based on these arguments, and sends back a result. So I create an existential type representing things that can be serialized:
data SerializableExt = forall t . Serializable t => SerializableExt t
because I want to send something of type [SerializableExt].
So, of course, I need to create an instance Serializable SerializableExt. This is where the problem starts:
In order to implement decode :: B.ByteString -> Maybe SerializableExt I need to know the concrete type that the existential type SerializableExt wraps.
So I implement encode :: SerializableExt -> B.ByteString as serializing the concrete type along with the value:
encode (SerializableExt x) = encode (typeOf x, x)
using typeOf from Data-Typeable. The problem is now the implementation of decode :: B.ByteString -> Maybe SerializableExt:
decode bs =
let (tyenc, xenc) = splitPair bs -- Not really important. It just splits bs into the two components
in case (decode tyenc :: Maybe TypeRep) of
Just ty -> SerializableExt <$> _ -- Somehow invoke decode xenc, where the choice of which decode to execute depends on the value of ty.
_ -> Nothing
But I can't see how to fill in the hole here. Because of Haskell's separation of the value level and the type level I can't use the value of ty to disambiguate the invocation of decode xenc, right?
Is there a way to solve this issue, and actually put something in the hole which will do what I want? Or can you come up with another design?
EDIT: One way of doing it would be the following:
decode bs =
let (tyenc, xenc) = splitPair bs
in SerializableExt <$>
case (decode tyenc :: Maybe TypeRep) of
Just ty
| ty == typeRep (Proxy :: Proxy Int) -> decode xenc :: Maybe Int
| ty = typeRep (Proxy :: Proxy ()) -> decode xenc :: Maybe ()
| ...
_ -> Nothing
but this is bad for several reasons:
It's tedious to extend.
It cannot handle pairs (or generally: tuples) generically; every
combination of types needs to be handled.
It's not very Haskelly

Data.Dynamic lets us put arbitrary Haskell values into a single container, and get them out again in a type-safe way. That's a good start towards inter-process communication; I'll come back to serialization below.
We can write a program that takes a list of Dynamic values, checks for the number & types it needs, and returns a result in the same way.
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Experiments with type-safe serialization.
module Main where
import Data.Proxy
import Data.Dynamic
import Data.Foldable
import Data.Type.Equality
import Type.Reflection
foo :: Int -> String -> String
foo i s = concat (replicate i s)
actor :: [Dynamic] -> Either String [Dynamic]
actor (di : ds : _) = case (fromDynamic di, fromDynamic ds) of
(Just i, Just s) -> Right [toDyn (foo i s)]
_ -> Left "Wrong types of arguments"
actor _ = Left "Not enough arguments"
caller :: Either String [Dynamic]
caller = actor [ toDyn (3::Int), toDyn "bar" ]
main :: IO ()
main = case caller of
Left err -> putStrLn err
Right dyns -> for_ dyns (\d -> case fromDynamic d of
Just s -> putStrLn s
Nothing -> print d)
We can use a TypeRep to guide selection of a class instance. (For ease of testing my code, I used String.)
class Serial a where
encode :: a -> String
decode :: String -> Maybe a
decodeAs :: Serial a => TypeRep a -> String -> Maybe a
decodeAs _ s = decode s
Finally, we'd like to serialize the TypeRep, and when decoding, check that the encoded type matches the type that we're decoding at.
instance Serial SomeTypeRep
encodeDyn :: (Typeable a, Serial a) => a -> (String, String)
encodeDyn a = (encode (SomeTypeRep (typeOf a)), encode a)
decodeDynamic :: forall a. (Typeable a, Serial a) => String -> String -> Maybe a
decodeDynamic tyStr aStr = case decode tyStr of
Nothing -> Nothing
Just (SomeTypeRep ty) ->
case eqTypeRep ty (typeRep :: TypeRep a) of
Nothing -> Nothing
Just HRefl -> decodeAs ty aStr

Related

How to convert Dynamic to Forall something

I have a cache with Dynamic values. Some of them have the type Delayed a.
Normally when I access the cache, I know the type a, so it's not a problem, I can use fromDynamic to cast to Maybe a.
I would like to call a function which doesn't need to know anything about the type a on a list of Dynamic. (The method is cancel :: Delay a -> IO ()).
Is there a way to do so ?
Basically I need a way to do get from Dynamic to Forall a . Delayed a ?
Edit
For information, Delayed holds a pending asynchronous value and a MVar to start or Cancel it. It is equivalent to
data Delayed m a = Delayed { blocker :: MVar Bool, async :: Async m a }
Such values are stored in a cache (which use Dynamic and store other things). When displaying the cache status, I need to be able to get the status of Delayed value (which involve accessing the blocker but has nothing to do with the actual value.
A value of type forall a . X a is a value which can be instantiated to any of X Int, X Bool, X String, etc. Presumably, your cache stores values of many different types, but no single value is valid at every possible type parameter. What you actually need is a value of type exists a . Delayed a. However, Haskell doesn't have first-class existential quantifiers, so you must encode that type in some way. One particular encoding is:
castToDelayed :: (forall a . Typeable a => Delayed a -> r) -> Dynamic -> r
Assume that you have this function; then you can simply write castToDelayed cancel :: Dynamic -> IO (). Note that the function parameter to castToDelayed provides a Typeable constraint, but you can freely ignore that constraint (which is what cancel is doing). Also note this function must be partial due to its type alone (clearly not every Dynamic is a Delayed a for some a), so in real code, you should produce e.g. Maybe r instead. Here I will elide this detail and just throw an error.
How you actually write this function will depend on which version of GHC you are using (the most recent, 8.2, or some older version). On 8.2, this is a very nice, simple function:
{-# LANGUAGE ViewPatterns #-}
-- NB: probably requires some other extensions
import Data.Dynamic
import Type.Reflection
castToDelayed :: (forall a . Typeable a => Delayed a -> r) -> Dynamic -> r
castToDelayed k (Dynamic (App (eqTypeRep (typeRep :: TypeRep Delayed) -> Just HRefl) a) x)
= withTypeable a (k x)
castToDelayed _ _ = error "Not a Delayed"
(Aside: at first I thought the Con pattern synonym would be useful here, but on deeper inspection it seems entirely useless. You must use eqTypeRep instead.)
Briefly, this function works as follows:
It pattern matches on the Dynamic value to obtain the actual value (of some existentially quantified type a) stored within, and the representation of its type (of type TypeRep a).
It pattern matches on the TypeRep a to determine if it is an application (using App). Clearly, Delayed a is the application of a type constructor, so that is the first thing we must check.
It compares the type constructor (the first argument to App) to the TypeRep corresponding to Delayed (note you must have an instance Typeable Delayed for this). If that comparison is successful, it pattern matches on the proof (that is Just HRefl) that the first argument to App and Delayed are in fact the same type.
At this point, the compiler knows that a ~ Delayed x for some x. So, you can call the function forall a . Typeable a => Delayed a -> r on the value x :: a. It must also provide the proof that x is Typeable, which is given precisely by a value of type TypeRep x - withTypeable reifies this value-level proof as a type-level constraint (alternatively, you could have the input function take as argument TypeRep a, or just omit the constrain altogether, since your specific use case doesn't need it; but this type is the most general possible).
On older versions, the principle is basically the same. However, TypeRep did not take a type parameter then; you can pattern match on it to discover if it is the TypeRep corresponding to Delayed, but you cannot prove to the compiler that the value stored inside the Dynamic has type Delayed x for some x. It will therefore require unsafeCoerce, at the step where you are applying the function k to the value x. Furthermore, there is no withTypeable before GHC 8.2, so you will have to write the function with type (forall a . Delayed a -> r) -> Dynamic -> r instead (which, fortunately, is enough for your use case); or implement such a function yourself (see the source of the function to see how; the implementation on older versions of GHC will be similar, but will have type TypeRep -> (forall a . Typeable a => Proxy a -> r) -> r instead).
Here is how you implement this in GHC < 8.2 (tested on 8.0.2). It is a horrible hack, and I make no claim it will correctly in all circumstances.
{-# LANGUAGE DeriveDataTypeable, MagicHash, ScopedTypeVariables, PolyKinds, ViewPatterns #-}
import Data.Dynamic
import Data.Typeable
import Unsafe.Coerce
import GHC.Prim (Proxy#)
import Data.Proxy
-- This part reifies a `Typeable' dictionary from a `TypeRep'.
-- This works because `Typeable' is a class with a single field, so
-- operationally `Typeable a => r' is the same as `(Proxy# a -> TypeRep) -> r'
newtype MagicTypeable r (kp :: KProxy k) =
MagicTypeable (forall (a :: k) . Typeable a => Proxy a -> r)
withTypeRep :: MagicTypeable r (kp :: KProxy k)
-> forall a . TypeRep -> Proxy a -> r
withTypeRep d t = unsafeCoerce d ((\_ -> t) :: Proxy# a -> TypeRep)
withTypeable :: forall r . TypeRep -> (forall (a :: k) . Typeable a => Proxy a -> r) -> r
withTypeable t k = withTypeRep (MagicTypeable k) t Proxy
-- The type constructor for Delayed
delayed_tycon = fst $ splitTyConApp $ typeRep (Proxy :: Proxy Delayed)
-- This is needed because Dynamic doesn't export its constructor, and
-- we need to pattern match on it.
data DYNAMIC = Dynamic TypeRep Any
unsafeViewDynamic :: Dynamic -> DYNAMIC
unsafeViewDynamic = unsafeCoerce
-- The actual implementation, much the same as the one on GHC 8.2, but more
-- 'unsafe' things
castToDelayed :: (forall a . Typeable a => Delayed a -> r) -> Dynamic -> r
castToDelayed k (unsafeViewDynamic -> Dynamic t x) =
case splitTyConApp t of
(((== delayed_tycon) -> True), [a]) ->
withTypeable a $ \(_ :: Proxy (a :: *)) -> k (unsafeCoerce x :: Delayed a)
_ -> error "Not a Delayed"
I don't know what Delayed actually is, but lets assume it's defined as follows for testing purposes:
data Delayed a = Some a | None deriving (Typeable, Show)
Then consider this simple test case:
test0 :: Typeable a => Delayed a -> String
test0 (Some x) = maybe "not a String" id $ cast x
test0 None = "None"
test0' =
let c = castToDelayed test0 in
[ c (toDyn (None :: Delayed Int))
, c (toDyn (Some 'a'))
, c (toDyn (Some "a")) ]
Why not define
{-# LANGUAGE ExistentialQuantification #-}
data Delayed' = forall a. Delayed' (Delayed a)
and then store than in the Dynamic? You can then cast it out of the dynamic, case on it, and pass the result to cancel. (Depending on what your use case is you may no longer even need the Dynamic.)

Checking constraints at runtime

I'm trying to define a function that detects whether the type of an input satisfies a given constraint:
satisfies :: (c a => a -> b) -> a -> Maybe b
-- or the more general
claim :: (c => a) -> Maybe a
So the desired behaviour would be:
>>> :t satisfies #Show show
satisfies #Show show :: a -> Maybe String
>>> satisfies #Show show (0 :: Int)
Just "0"
>>> satisfies #Show show (id :: Int -> Int)
Nothing
The goal is to make it easy to define fully polymorphic functions that take
advantage of specializations when possible:
showAny :: a -> String
showAny (satisfies #Show show -> Just str) = str
showAny (satisfies #Typeable showType -> Just str) = "_ :: " ++ str
showAny _ = "_"
As the easiest thing I could try, my first attempt tried using -fdefer-to-runtime
{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
module Claim where
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Error (catchIOError)
satisfies :: (c a => a -> b) -> a -> Maybe b
satisfies f a = unsafePerformIO $
(return . Just $! f a) `catchIOError` \_ -> return Nothing
This failed because -fdefer-type-errors doesn't defer the checking to
runtime, or allow further checking to be done in the context which it is
actually used (as I had hoped), but instead at compile time replaces found
type errors with the equivalent of error "MESSAGE".
Now I'm out of ideas. Is implementing satisfies even possible?
You can't dispatch on instance availability at runtime. Remember, a constraint is translated by the compiler into a type class dictionary - a record of functions that is passed around explicitly and accessed explicitly at runtime. The "fat arrow" => is represented at runtime by a "thin arrow" ->, so the elaborator needs to know at compile time which dictionary to pass around.
That is, the following crude example:
class Show a where
show :: a -> String
instance Show String where
show = id
showTwice :: Show a => a -> String
showTwice x = show x ++ show x
main = putStrLn $ showTwice "foo"
generates Core code which looks approximately like:
data Show_ a = Show_ { show :: a -> String }
showString_ :: Show_ String
showString_ = Show_ { show = id }
showTwice :: Show_ a -> a -> String
showTwice show_ x = show show_ x ++ show show_ x
main = putStrLn $ showTwice showString_ "foo"
When generating code for main, the compiler needs to know where to find showString_.
You can imagine a system wherein you can look up a type class dictionary at runtime with some sort of introspection mechanism, but this would produce weird behaviour from a language design perspective. The problem is orphan instances. If I write a function which attempts to look up a given instance in module A, and define such an instance in an unrelated module B, then the behaviour of that function when called from some client module C depends on whether B was imported by some other part of the program. Pretty strange!
A more usual way of doing "fully polymorphic functions that take advantage of specializations when possible" would be to put the function in question into a type class itself and give it a default implementation (perhaps with a default signature if the default implementation depends on some superclass). Your showAny would then look like this:
{-# LANGUAGE DefaultSignatures #-}
import Data.Typeable
class ShowAny a where
showAny :: a -> String
default showAny :: Typeable a => a -> String
showAny x = "_ :: " ++ show (typeOf x)
You'd need to implement ShowAny for all of the types with which you want to use showAny, but that's usually a single line of code,
instance (Typeable a, Typeable b) => ShowAny (a -> b)
and you can specialise an implementation for a given type just by overriding showAny.
instance ShowAny String where
showAny = id
You see this approach quite frequently in libraries which do generic programming. aeson, for example, can use GHC.Generics to serialise a given type to and from JSON (all you have to do is derive Generic and write two lines instance ToJSON MyType; instance FromJSON MyType), but you can also write your own instances of ToJSON and FromJSON if the generic code isn't fast enough or you need to customise the output.
An alternate workaround to the accepted answer is to pass the dictionaries around manually.
That is, given:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
module Claim where
data Proof c where QED :: c => Proof c
type Claim c = Maybe (Proof c)
type c ? a = Maybe (Proof (c a))
One can write:
showAny :: (Show? a, Typeable? a) -> a -> String
showAny (Just QED, _) a = show a
showAny (_, Just QED) a = "_ :: " ++ showType a
showAny _ _ = "_"
Which works accepably well:
>>> showAny (Nothing, Just QED) (id :: Int -> Int)
"_ :: Int -> Int"
>>> showAny (Just QED, Just QED) (0 :: Int)
"0"
>>> showAny (Nothing, Nothing) undefined
"_"

Deserializing many network messages without using an ad-hoc parser implementation

I have a question pertaining to deserialization. I can envision a solution using Data.Data, Data.Typeable, or with GHC.Generics, but I'm curious if it can be accomplished without generics, SYB, or meta-programming.
Problem Description:
Given a list of [String] that is known to contain the fields of a locally defined algebraic data type, I would like to deserialize the [String] to construct the target data type. I could write a parser to do this, but I'm looking for a generalized solution that will deserialize to an arbitrary number of data types defined within the program without writing a parser for each type. With knowledge of the number and type of value constructors an algebraic type has, it's as simple as performing a read on each string to yield the appropriate values necessary to build up the type. However, I don't want to use generics, reflection, SYB, or meta-programming (unless it's otherwise impossible).
Say I have around 50 types defined similar to this (all simple algebraic types composed of basic primitives (no nested or recursive types, just different combinations and orderings of primitives) :
data NetworkMsg = NetworkMsg { field1 :: Int, field2 :: Int, field3 :: Double}
data NetworkMsg2 = NetworkMsg2 { field1 :: Double, field2 :: Int, field3 :: Double }
I can determine the data-type to be associated with a [String] I've received over the network using a tag id that I parse before each [String].
Possible conjectured solution path:
Since data constructors are first-class values in Haskell, and actually have a type-- Can NetworkMsg constructor be thought of as a function, such as:
NetworkMsg :: Int -> Int -> Double -> NetworkMsg
Could I transform this function into a function on tuples using uncurryN then copy the [String] into a tuple of the same shape the function now takes?
NetworkMsg' :: (Int, Int, Double) -> NetworkMsg
I don't think this would work because I'd need knowledge of the value constructors and type information, which would require Data.Typeable, reflection, or some other metaprogramming technique.
Basically, I'm looking for automatic deserialization of many types without writing type instance declarations or analyzing the type's shape at run-time. If it's not feasible, I'll do it an alternative way.
You are correct in that the constructors are essentially just functions so you can write generic instances for any number of types by just writing instances for the functions. You'll still need to write a separate instance
for all the different numbers of arguments, though.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
import Text.Read
import Control.Applicative
class FieldParser p r where
parseFields :: p -> [String] -> Maybe r
instance Read a => FieldParser (a -> r) r where
parseFields con [a] = con <$> readMaybe a
parseFields _ _ = Nothing
instance (Read a, Read b) => FieldParser (a -> b -> r) r where
parseFields con [a, b] = con <$> readMaybe a <*> readMaybe b
parseFields _ _ = Nothing
instance (Read a, Read b, Read c) => FieldParser (a -> b -> c -> r) r where
parseFields con [a, b, c] = con <$> readMaybe a <*> readMaybe b <*> readMaybe c
parseFields _ _ = Nothing
{- etc. for as many arguments as you need -}
Now you can use this type class to parse any message based on the constructor as long as the type-checker is able to figure out the resulting message type from context (i.e. it is not able to deduce it simply from the given constructor for these sort of multi-param type class instances).
data Test1 = Test1 {fieldA :: Int} deriving Show
data Test2 = Test2 {fieldB ::Int, fieldC :: Float} deriving Show
test :: String -> [String] -> IO ()
test tag fields = case tag of
"Test1" -> case parseFields Test1 fields of
Just (a :: Test1) -> putStrLn $ "Succesfully parsed " ++ show a
Nothing -> putStrLn "Parse error"
"Test2" -> case parseFields Test2 fields of
Just (a :: Test2) -> putStrLn $ "Succesfully parsed " ++ show a
Nothing -> putStrLn "Parse error"
I'd like to know how exactly you use the message types in the application, though, because having each message as its separate type makes it very difficult to have any sort of generic message handler.
Is there some reason why you don't simply have a single message data type? Such as
data NetworkMsg
= NetworkMsg1 {fieldA :: Int}
| NetworkMsg2 {fieldB :: Int, fieldC :: Float}
Now, while the instances are built in pretty much the same way, you get much better type inference since the result type is always known.
instance Read a => MessageParser (a -> NetworkMsg) where
parseMsg con [a] = con <$> readMaybe a
instance (Read a, Read b) => MessageParser (a -> b -> NetworkMsg) where
parseMsg con [a, b] = con <$> readMaybe a <*> readMaybe b
instance (Read a, Read b, Read c) => MessageParser (a -> b -> c -> NetworkMsg) where
parseMsg con [a, b, c] = con <$> readMaybe a <*> readMaybe b <*> readMaybe c
parseMessage :: String -> [String] -> Maybe NetworkMsg
parseMessage tag fields = case tag of
"NetworkMsg1" -> parseMsg NetworkMsg1 fields
"NetworkMsg2" -> parseMsg NetworkMsg2 fields
_ -> Nothing
I'm also not sure why you want to do type-generic programming specifically without actually using any of the tools meant for generics. GHC.Generics, SYB or Template Haskell is usually the best solution for this kind of problem.

Generic data constructor for Data instance

Given a datatype
data Foo = IFoo Int | SFoo String deriving (Data, Typeable)
what is a simple definition of
gconstr :: (Typeable a, Data t) => a -> t
such that
gconstr (5 :: Int) :: Foo == IFoo 5
gconstr "asdf" :: Foo == SFoo "asdf"
gconstr True :: Foo == _|_
It would be essentially the opposite of syb's gfindtype.
Or does such a thing exist already? I've tried hoogle-ing the type and haven't found much, but the syb types are kind of hard to interpret. A function returning Nothing on error is also acceptable.
This seems to be possible, though it's not completely trivial.
Preliminaries:
{-# LANGUAGE DeriveDataTypeable #-}
import Control.Monad ( msum )
import Data.Data
import Data.Maybe
First a helper function gconstrn, which tries to do the same thing as required of gconstr, but for a specific constructor only:
gconstrn :: (Typeable a, Data t) => Constr -> a -> Maybe t
gconstrn constr arg = gunfold addArg Just constr
where
addArg :: Data b => Maybe (b -> r) -> Maybe r
addArg Nothing = Nothing
addArg (Just f) =
case cast arg of
Just v -> Just (f v)
Nothing -> Nothing
The key part is that the addArg function will use arg as an argument to the constructor, if the types match.
Essentially gunfold starts unfolding with Just IFoo or Just SFoo, and then the next step is to try addArg to provide it with its argument.
For multi-argument constructors this would be called repeatedly, so if you defined an IIFoo constructor that took two Ints, it would also get successfully filled in by gconstrn. Obviously with a bit more work you could do something more sophisticated like providing a list of arguments.
Then it's just a question of trying this with all possible constructors. The recursive definition between result and dt is just to get the right type argument for dataTypeOf, the actual value being passed in doesn't matter at all. ScopedTypeVariables would be an alternative for achieving this.
gconstr :: (Typeable a, Data t) => a -> Maybe t
gconstr arg = result
where result = msum [gconstrn constr arg | constr <- dataTypeConstrs dt]
dt = dataTypeOf (fromJust result)
As discussed in the comments, both functions can be simplified with <*> from Control.Applicative to the following, though it's a bit harder to see what's going on in the gunfold:
gconstr :: (Typeable a, Data t) => a -> Maybe t
gconstr arg = result
where
result = msum $ map (gunfold (<*> cast arg) Just) (dataTypeConstrs dt)
dt = dataTypeOf (fromJust result)

Laziness and polymorphic values

(For the following, simplify Show and Read to
class Show a where show :: a -> String
class Read a where read :: String -> a
And assume that read never fails.)
It's well-known that one can make an existential type of the form
data ShowVal where
ShowVal :: forall a. Show a => a -> ShowVal
And then construct a "heterogeneous list" :: [ShowVal], such as
l = [ShowVal 4, ShowVal 'Q', ShowVal True]
It's also well-known that this is relatively useless, because, instead, one can
just construct a list :: [String], such as
l = [show 4, show 'Q', show True]
Which is exactly isomorphic (after all, the only thing one can do with a
ShowVal is show it).
Laziness makes this particularly nice, because for each value in the list, the
result of show is memoized automatically, so no String is computed more than
once (and Strings that aren't used aren't computed at all).
A ShowVal is equivalent to an existential tuple exists a. (a -> String, a),
where the function is the Show dictionary.
A similar construct can be made for Read:
data ReadVal where
ReadVal :: (forall a. Read a => a) -> ReadVal
Note that, because read is polymorphic in its return value, ReadVal is
universal rather than existential (which means that we don't really need it at
all, because Haskell has first-class universals; but we'll use it here to
highlight the similaries to Show).
We can also make a list :: [ReadVal]:
l = [ReadVal (read "4"), ReadVal (read "'Q'"), ReadVal (read "True")]
Just as with Show, a list :: [ReadVal] is isomorphic to a list :: [String],
such as
l = ["4", "'Q'", "True"]
(We can always get the original String back with
newtype Foo = Foo String
instance Read Foo where read = Foo
Because the Read type class is open.)
A ReadVal is equivalent to a universal function forall a. (String -> a) -> a
(a CPS-style representation). Here the Read dictionary is supplied by the user
of the ReadVal rather than by the producer, because the return value is
polymorphic rather than the argument.
However, in neither of these representations do we get the automatic
memoization that we get in the String representation with Show. Let's say that
read for our type is an expensive operation, so we don't want to compute it
on the same String for the same type more than once.
If we had a closed type, we could do something like:
data ReadVal = ReadVal { asInt :: Int, asChar :: Char, asBool :: Bool }
And then use a value
ReadVal { asInt = read s, asChar = read s, asBool = read s }
Or something along those lines.
But in this case -- even if we only ever use the ReadVal as one type -- the
String will be parsed each time the value is used. Is there a simple way to
get memoization while keeping the ReadVal polymorphic?
(Getting GHC to do it automatically, similarly to the Show case, would be
ideal, if it's somehow possible. A more explicit memoization approach --
perhaps by adding a Typeable constraint? -- would also be OK.)
Laziness makes this particularly nice, because for each value in the list, the result of show is memoized automatically, so no String is computed more than once (and Strings that aren't used aren't computed at all).
This premise is incorrect. There is no magical memo table under the hood.
Laziness means things that aren't needed, aren't computed. It does not mean that all computed values are shared. You still have to introduce explicit sharing (via a table of your own).
Here's an implementation of the more explicit approach; it requires Typeable, because otherwise there'd be nothing to key the memo table on. I based the memoisation code on uglymemo; there might be a way to get this to work with pure memoisation, but I'm not sure. It's tricky, because you have to construct the table outside of the implicit function that any forall a. (Read a, Typeable a) => ... creates, otherwise you end up constructing one table per call, which is useless.
{-# LANGUAGE GADTs, RankNTypes #-}
import Data.Dynamic
import Control.Concurrent.MVar
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import System.IO.Unsafe
data ReadVal where
ReadVal :: { useReadVal :: forall a. (Read a, Typeable a) => a } -> ReadVal
mkReadVal :: String -> ReadVal
mkReadVal s = unsafePerformIO $ do
v <- newMVar HM.empty
return $ ReadVal (readVal v)
where
readVal :: (Read a, Typeable a) => MVar (HashMap TypeRep Dynamic) -> a
readVal v = unsafePerformIO $ do
m <- readMVar v
let r = read s -- not evaluated
let typeRep = typeOf r
case HM.lookup typeRep m of
Nothing -> do
modifyMVar_ v (return . HM.insert typeRep (toDyn r))
return r
Just r' -> return $ fromDyn r' (error "impossible")

Resources