Is there a sane way to apply a polymorphic function to a value of type Dynamic?
For instance, I have a value of type Dynamic and I want to apply Just to the value inside the Dynamic. So if the value was constructed by toDyn True I want the result to be toDyn (Just True). The number of different types that can occur inside the Dynamic is not bounded.
(I have a solution when the types involved come from a closed universe, but it's unpleasant.)
This is perhaps not the sanest approach, but we can abuse my reflection package to lie about a TypeRep.
{-# LANGUAGE Rank2Types, FlexibleContexts, ScopedTypeVariables #-}
import Data.Dynamic
import Data.Proxy
import Data.Reflection
import GHC.Prim (Any)
import Unsafe.Coerce
newtype WithRep s a = WithRep { withRep :: a }
instance Reifies s TypeRep => Typeable (WithRep s a) where
typeOf s = reflect (Proxy :: Proxy s)
Given that we can now peek at the TypeRep of our Dynamic argument and instantiate our Dynamic function appropriately.
apD :: forall f. Typeable1 f => (forall a. a -> f a) -> Dynamic -> Dynamic
apD f a = dynApp df a
where t = dynTypeRep a
df = reify (mkFunTy t (typeOf1 (undefined :: f ()) `mkAppTy` t)) $
\(_ :: Proxy s) -> toDyn (WithRep f :: WithRep s (() -> f ()))
It could be a lot easier if base just supplied something like apD for us, but that requires a rank 2 type, and Typeable/Dynamic manage to avoid them, even if Data does not.
Another path would be to just exploit the implementation of Dynamic:
data Dynamic = Dynamic TypeRep Any
and unsafeCoerce to your own Dynamic' data type, do what you need to do with the TypeRep in the internals, and after applying your function, unsafeCoerce everything back.
Related
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.)
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
"_"
I'm currently writing a QuickCheck style library and relying on Template Haskell for generating a large number of test cases.
I want to generate code like:
quickCheck (prop_Num_plus_is_associative :: Integer -> Integer -> Integer -> Property)
The property "prop_Monoid_plus_is_associative" has the following type:
prop_Num_plus_is_associative :: (Eq a, Monoid a, Show a) => a -> a -> a -> Property
so that I can check it with any appropriate instance of Monoid. However, sometimes, the types that my program chooses to fill in for "a" does not satisfy the context. I would like to filter out those cases by checking whether a certain instance exists.
However, when I call reifyInstance on Monoid (Max Integer), it only gives me the list of instances that it could possibly match, namely (Bounded a, Ord a) => Monoid (Max a), it does not do the rest of the work of checking whether Integer is Bounded and Ord. Is there a function similar to reifyInstance that does?
Edit:
Here the program that I was hinting at:
{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
import Data.Semigroup
import Language.Haskell.TH
main :: IO ()
main = do
$(do
tMaxInt <- [t| Max Integer |]
runIO . putStrLn . pprint =<< reifyInstances ''Monoid [ tMaxInt ]
[e| return () |] )
It outputs
instance (GHC.Classes.Ord a_0,
GHC.Enum.Bounded a_0) => GHC.Base.Monoid (Data.Semigroup.Max a_0)
despite the fact that Max Integer is not a Monoid.
-- InternalComponent.hs
data ComponentState = ComponentState ...
instance Default ComponentState where ...
componentFunction :: (MonadState InternalComponentState m) => a -> m a
-- Program.hs
data ProgramState = forall cs. ProgramState {
componentState :: cs,
...
}
newtype MyMonad a = MyMonad { runMyMonad :: StateT ProgramState IO a }
myFunction a = do
s <- get
let cs = componentState s
let (r, cs') = runState (componentFunction a) cs
put $ s { componentState = cs' }
return r
What I want is to be able to use the componentFunction inside of MyMonad (in myFunction, as presented in the example), without being particularly interested in the actual type of the state the component requires. Keeping the component state inside of my own state isn't a requirement, but that's as far as my ability to use state in Haskell goes.
This can really be viewed as an equivalent of an implementation of a stateful interface in another programming language: instantiation of the interface with some implementation provides default state value, and every function called through that interface can modify that state. In any point isn't the user presented with implementation details.
In case it's not clear, the above example fails because the implementation of myFunction can't prove that the record selector provides an appropriate type (because it's an existential); at least that's how I understand it.
You can parametrize ProgramState by the type of the component state(s), e.g. have
data ProgramState cs = ProgramState { componentState :: cs }
This would mean you'll also have to expose the ComponentState type from InternalComponent.hs, but not the constructors. This way you give the type checker something to play with, but don't expose any internals to the users of InternalComponent.
First, I'd suggest to read Combining multiple states in StateT, just to see other available options.
Since in the case of nested states we need to update values inside more complex objects, using lens can make life a lot easier (see also this tutorial). A value of type Lens' s a knows how to reach a particular value of type a inside s and how to modify it (that is, creating a new value of type s that is the same, except for a modified a). Then we can define a helper function
runInside :: (MonadState s m) => Lens' s a -> State a r -> m r
runInside lens s = lens %%= (runState s)
Given a lens and a stateful computation on a, we can lift such a computation to a stateful computation parametrized by s. The library allows us to generate lenses using Template Haskell, for example:
{-# LANGUAGE RankNTypes, TemplateHaskell #-}
import Control.Lens.TH
data ProgramState cs = ProgramState { _componentState :: cs }
$(makeLenses ''ProgramState)
will generate componentState :: Lens' ProgramState cs (actually the generated function will be slightly more more generic). Combining them together we get
runInside componentState :: MonadState (ProgramState a) m => State a r -> m r
Using Typeable we could go even further and create a map that automatically creates or keeps a state for whatever type it is asked for. I'd not recommend this approach in general, as it sort-of avoids Haskell's strong type system checks, but it might be useful in some cases.
{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables, RankNTypes #-}
import Control.Lens
import Control.Lens.TH
import Control.Monad.State
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Typeable
data Something = forall a . Typeable a => Something a
type TypeMap = Map TypeRep Something
We defined a generic untyped container that can hold whatever is Typeable and a map that maps representation of types to their values.
We'll need some class to provide default/starting values:
class Default a where
getDefault :: a
-- just an example
instance Default Int where
getDefault = 0
Finally, we can create a lens that given an arbitrary Typeable type, it focuses on its value in the map by looking up its type representation:
typeLens :: forall t . (Typeable t, Default t) => Lens' TypeMap t
typeLens = lens get set
where
set map v = Map.insert (typeOf v) (Something v) map
get map = case Map.lookup (typeRep (Proxy :: Proxy t)) map of
Just (Something v) | Just r <- cast v -> r
_ -> getDefault
So you could have TypeMap somewhere in your state and let all stateful computations use it, regardless of what state they need.
However, there is a big warning: If two unrelated computations happen to use the same type for their state, they'll share the value with very likely disastrous results! So using explicit records for states of different parts of your computations is going to be much safer.
I want to write a function with this type signature:
getTypeRep :: Typeable a => t a -> TypeRep
where the TypeRep will be the type representation for a, not for t a. That is, the compiler should automatically return the correct type representation at any call sites [to getTypeRep], which will have concrete types for a.
To add some context, I want to create a "Dynamic type" data type, with the twist that it will remember the top-level type, but not its parameter. For example, I want to turn MyClass a into Dynamic MyClass, and the above function will be used to create instances of Dynamic MyClass that store a representation of the type parameter a.
Well, how about using scoped type variables to select the inner component:
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Dynamic
import Data.Typeable
getTypeRep :: forall t a . Typeable a => t a -> TypeRep
getTypeRep _ = typeOf (undefined :: a)
Works for me:
*Main> getTypeRep (Just ())
()
*Main> getTypeRep (Just 7)
Integer
*Main> getTypeRep ([True])
Bool
Interesting design.
On a tangential note to Don's solution, notice that code rarely require ScopedTypeVariables. It just makes the solution cleaner (but less portable). The solution without scoped types is:
{-# LANGUAGE ExplicitForAll #-}
import Data.Typeable
helper :: t a -> a
helper _ = undefined
getTypeRep :: forall t a. Typeable a => t a -> TypeRep
getTypeRep = typeOf . helper
This function (now) exists in Data.Typeable typeRep