I have constructed a simple example of a Vinyl record. First, some language pragmas and imports:
{-# LANGUAGE DataKinds, TypeOperators #-}
import Data.Vinyl
import Data.Vinyl.Functor
import Control.Applicative
the actual example (it employs the HList type synonym for simplicity):
mytuple :: HList [Integer,Bool]
mytuple = Identity 4 :& Identity True :& RNil
This compiles ok. But now I want to print the Vinyl record using rtraverse:
printi :: Show a => Identity a -> IO (Identity a)
printi (Identity x) = print x *> pure (Identity x)
main :: IO ()
main = rtraverse printi mytuple *> pure ()
This gives the following error: No instance for (Show x) arising from a use of ‘printi’. Which is expected I guess, because rtraverse expects a function with no constraints.
How to solve this? It seems like reifyConstraint will be a part of the solution, but I don't know how to use it.
You are correct that reifyConstraint will solve this problem. What this function does is convert (or "reify") constraints into datatypes, namely the Dict datatype. For example
>:t reifyConstraint (Proxy :: Proxy Show) mytuple
(reifyConstraint (Proxy :: Proxy Show) mytuple)
:: Rec (Dict Show :. Identity) '[Integer, Bool]
Each element in this record will have form Dict (Identity _). Dict is defined as
data Dict c x where Dict :: c x => x -> Dict c x
Now you simply need a traversal function which can handle a (Dict Show :. Identity) a as an input.
printi :: Compose (Dict Show) Identity a -> IO (Compose (Dict Show) Identity a)
printi x#(Compose (Dict a)) = print a >> return x
Note that you don't need a Show constraint on a - the Show class dictionary is stored in the Dict datatype. You can rtraverse with this function.
main = rtraverse printi (reifyConstraint (Proxy :: Proxy Show) mytuple)
Related
Motivation
I have a type, MyType, which is parametrised by a functor, f.
I want to use MyType Identity to represent "my view" of the data, and MyType Maybe to represent the type of updates to the data.
Problem
Is it possible to write an aeson ToJSON instance for MyType? I tried to use the ToJSON class, but I get an error (see bottom of post).
{-# LANGUAGE DeriveGeneric #-}
module Main where
import GHC.Generics
import Data.Aeson
data MyType f = MyType
{ age :: f Int
, name :: f String
} deriving(Generic)
instance ToJSON1 f => ToJSON (MyType f)
main :: IO ()
main = print . encode $ MyType (Just 1) (Just "hi")
How can I get a ToJSON instance for MyType f, for an arbitrary f?
Compilation error
Main.hs:12:10: error:
• Could not deduce (ToJSON (f String))
arising from a use of ‘aeson-1.2.4.0:Data.Aeson.Types.ToJSON.$dmtoJSON’
from the context: ToJSON1 f
bound by the instance declaration
at Main.hs:12:10-39
• In the expression:
aeson-1.2.4.0:Data.Aeson.Types.ToJSON.$dmtoJSON #MyType f
In an equation for ‘toJSON’:
toJSON = aeson-1.2.4.0:Data.Aeson.Types.ToJSON.$dmtoJSON #MyType f
In the instance declaration for ‘ToJSON (MyType f)’
|
12 | instance ToJSON1 f => ToJSON (MyType f)
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Failed, no modules loaded.
Using my idea in the comment of exploiting the Lifting class, and after some tinkering I arrived at this
{-# LANGUAGE DeriveGeneric
, FlexibleContexts
, MultiParamTypeClasses
, ScopedTypeVariables
, TypeApplications
, UndecidableInstances
#-}
module Main where
import GHC.Generics
import Data.Aeson
import Data.Constraint
import Data.Constraint.Lifting
data MyType f = MyType
{ age :: f Int
, name :: f String
} deriving(Generic)
instance (Lifting ToJSON f) => ToJSON (MyType f) where
toJSON mt
| Sub Dict <- lifting #ToJSON #f #Int
, Sub Dict <- lifting #ToJSON #f #String
= genericToJSON defaultOptions mt
instance Lifting ToJSON Maybe where
lifting = Sub Dict
main :: IO ()
main = print . encode $ MyType (Just 1) (Just "hi")
Notes:
Dict converts back and forth between constraints (such as ToJSON Int) and values. Sub is just the constructor for constraint entailment.
lifting #ToJSON #f #Int is type application syntax.
I used genericToJSON defaultOptions by looking up the default implementation for toJSON. We just needed to manually bring some instances into scope with lifting first.
I hope this helps.
My aim is to write function that takes some polymorphic values and list with typereps representing concrete types. It returns new list with the same values but already casted to concrete types specified via typereps.
Let we have such list of values: ["one", "two"] with -XOverloadedStrings enabled.
Respectively, type of each one is IsString a => a.
List of typereps we could get in such way:
import Data.Typeable (Proxy(..), typeRep)
import Data.Text (Text)
[typeRep (Proxy :: Proxy String), typeRep (Proxy :: Proxy ByteString)]
Is there any way to get "one" of type String and "two" of type ByteString?
P.S. To prevent error according to list containing values of different types, we may wrap every value in Dynamic., as in the example below(pseudocode):
{-# LANGUAGE ParallelListComp #-}
import Data.Dynamic (toDyn)
[ toDyn (val :: type') | val <- vals | type' <- concreteTypes ]
It could be done using Template Haskell, but it will be too ugly.
I can't really imagine your purpose, but the code will probably look something like this. I'm using the new Type.Reflection interface because I'm more familiar with it than with the classic Data.Typeable, but that should work for this too.
import Type.Reflection
types :: [SomeTypeRep]
types = [SomeTypeRep (typeRep #String), SomeTypeRep (typeRep #Text)]
strings :: [String]
strings = ["one", "two"]
converted :: [Dynamic]
converted = fromJust $ zipWithM convert types strings
convert :: SomeTypeRep -> String -> Maybe Dynamic
convert (SomeTypeRep rep) s
| Just HRefl <- eqTypeRep rep (typeRep #String) = Just $ toDynamic s
| Just HRefl <- eqTypeRep rep (typeRep #Text) = Just $ toDynamic (fromString s)
| otherwise = Nothing
Hold my beer.
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString (ByteString)
import Data.String
import Data.Text (Text)
data Forall c where Forall :: (forall a. c a => a) -> Forall c
data Exists c where Exists :: c a => a -> Exists c
data Evidence c where Evidence :: c a => proxy a -> Evidence c
instance c ~ IsString => IsString (Forall c) where
fromString s = Forall (fromString s)
asProxyType :: proxy a -> a -> a
asProxyType = const id
downcast :: Evidence c -> Forall c -> Exists c
downcast (Evidence proxy) (Forall v) = Exists (asProxyType proxy v)
polymorphicStrings :: c ~ IsString => [Forall c]
polymorphicStrings = ["one", "two"]
types :: c ~ IsString => [Evidence c]
types = [Evidence ([] :: [ByteString]), Evidence ([] :: [Text])]
monomorphicStrings :: c ~ IsString => [Exists c]
monomorphicStrings = zipWith downcast types polymorphicStrings
To connect with the question as asked: Exists Typeable is isomorphic to Dynamic. You might need to generalize Forall, Exists :: Constraint -> * to Forall, Exists :: [Constraint] -> * to comfortably support both IsString and Typeable at once, which is a bit of type-level hacking but nothing too strenuous. Type families can give you an Elem :: Constraint -> [Constraint] -> Bool which can be used to replace c ~ IsString everywhere above.
I have an extensible Vinyl / Composite record (similar to HList, Frames...), and I would like to generate the tuples of keys/values, such as
tuplify '[String :-> Whatevs, ...] :: [(String, String)]
This is surprisingly hard. original gist.
Solution Gist, thanks to Alec below
type FA = "a" :-> String
type FB = "b" :-> Int
type AB = '[FA, FB]
ab :: Rec Identity AB
ab = "A" :*: 1 :*: RNil
tuplify :: (Show a) => Rec Identity '[a] -> [(String, String)]
tuplify = recordToList . rmap undefined -- ??????
-- tuplify ab = [("a", "A"), ("b", "1")]
If you care to try out what I've done so far, check out that gist, and it has well-thought-out examples and the errors I see:
Here is the hardware for refying in Composite (reifyDicts):
And the same for Vinyl (reifyConstraints):
AFAICT, the problem is that in something like rmap:
rmap :: (forall x. f x -> g x) -> Rec f rs -> Rec g rs
The mapped fn is defined forall x, but my tuplify is constrained, and I think the reification should move the constraint into the type (that's what Dicts are for), but, alas, no luck so far.
I can't get composite related stuff to install on my global Stack setup but the following should still work (I just copy-pasted relevant definitions). That said, I think a simple type-class based dispatch based on type is simpler here (since the constraints are non-trivial). With all of the right extensions enabled [1], you just need:
class Tuplify a where
tuplify :: a -> [(String, String)]
instance Tuplify (Rec Identity '[]) where
tuplify RNil = []
instance (Show t, KnownSymbol s, Tuplify (Rec Identity rs)) =>
Tuplify (Rec Identity (s :-> t ': rs)) where
tuplify (v :*: rs) = (symbolVal (Proxy :: Proxy s), show v) : tuplify rs
Then, in GHCi:
ghci> tuplify ab
[("a","\"A\""),("b","1")]
If you really want to try the reifying constraint approach, you'll have to start by declaring a type class and instance for the particular constraint you want:
class ShowField a where
showField :: a -> (String, String)
instance (KnownSymbol s, Show a) => ShowField (Identity (s :-> a)) where
showField (Identity (Val v)) = (symbolVal (Proxy :: Proxy s), show v)
Then it becomes more straightforward to use reifyConstraints and rmap:
tuplify' :: RecAll Identity rs ShowField => Rec Identity rs -> [(String, String)]
tuplify' xs = recordToList
. rmap (\(Vinyl.Compose (Dict x)) -> Vinyl.Const $ showField x)
$ reifyConstraint (Proxy :: Proxy ShowField) xs
I imagine something similar is possible with reifyDicts, although I wish there was a variant of it defined using ValuesAllHave instead of just AllHave (then we could bypass declaring a ShowField typeclass and do everything in just a function).
[1] extensions needed for first example
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
Given the code below which looks up type-specific information in Data.HashMap for a type, is it possible to define a new function getMapVal2 as documented in the comments, to build the TypeKey argument given the type?
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
import Data.Monoid ((<>))
import Data.Proxy (Proxy(Proxy))
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import qualified Data.HashMap.Strict as Map (HashMap, empty, insert, lookup)
import Data.Dynamic
import GHC.Generics
import Data.Maybe (fromJust, isNothing, maybe)
type family TypeKey (a :: *) :: Symbol where
TypeKey Int = "int"
TypeKey T = "trec"
data T = T { aInt :: Int} deriving (Show, Generic, Typeable)
extract ::(s ~ TypeKey a, Typeable a, KnownSymbol s) => Maybe Dynamic -> Maybe a
extract dyn = if (isNothing dyn) then Nothing else fromDynamic . fromJust $ dyn
getMapVal :: (s ~ TypeKey a, Typeable a, KnownSymbol s) => Map.HashMap String Dynamic -> String -> Maybe a
getMapVal m k = extract $ Map.lookup k m
{-- How do we get the TypeKey lookup for type a?
getMapVal2 :: (s ~ TypeKey a, Typeable a, KnownSymbol s) => Map.HashMap String Dynamic -> a -> Maybe a
getMapVal2 m ty = extract $ Map.lookup (symbolVal (Proxy :: Proxy (TypeKey ???))) m
--}
main = do
let map = Map.insert (symbolVal (Proxy :: Proxy (TypeKey T))) (toDyn $ T {aInt=5}) Map.empty -- we insert some value in hashmap for type T - it is of same type
val = getMapVal map (symbolVal (Proxy :: Proxy (TypeKey T))) :: Maybe T -- now let us retrieve the value in map for Type T. We pass the SymbolVal ourselves
--val = getMapVal2 map (T {aInt = 2}) -- now we want to lookup map value given something of a type T. Need getMapVal2 to build symbolval given the input type
print $ maybe "" show val -- prints value stored in Hashmap for type T which is: T {aInt=5}
This is just a toy code to test passing type specific configuration at run-time via Data.HashMap to a polymorphic function that acts on types of a typeclass.
Use the ScopedTypeVariables extension. This allows you to refer to forall-bound type variables in the body of the definition in which they are bound.
{-# LANGUAGE ScopedTypeVariables #-}
getMapVal2 :: forall a s. (s ~ TypeKey a, Typeable a, KnownSymbol s) => Map.HashMap String Dynamic -> a -> Maybe a
getMapVal2 m ty = extract $ Map.lookup (symbolVal (Proxy :: Proxy (TypeKey a))) m
I'm working on an HList implementation and I'm stuck trying to implement a map function for it. I've tried a lot of different approaches but with each one I reach compiler errors related to that function.
Following is an example of how I want to use a generic function Just to apply it to all elements of the input data structure.
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
-- | An input heterogenous data structure
recursivePairs :: (Int, (Char, (Bool, ())))
recursivePairs = (1, ('a', (True, ())))
-- | This is how I want to use it
recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool, ())))
recursivePairs' = hMap Just recursivePairs
class HMap f input output where
hMap :: f -> input -> output
-- | A counterpart of a Nil pattern match for a list
instance HMap f () () where
hMap _ _ = ()
-- | A counterpart of a Cons pattern match for a list
instance
( HMap f iTail oTail,
Apply f iHead oHead ) =>
HMap f (iHead, iTail) (oHead, oTail)
where
hMap f (head, tail) = (apply f head, hMap f tail)
class Apply f input output where
apply :: f -> input -> output
instance Apply (input -> output) input output where
apply = id
With this I'm getting the following compiler error:
No instance for (Apply (a0 -> Maybe a0) Int (Maybe Int))
arising from a use of `hMap'
The type variable `a0' is ambiguous
Is there at all a way to solve this and if not then why?
The problem is that you are trying to use a polymorphic function with different arguments, but your Apply instance takes a function (a mono-type). You can easily fix this multiple ways
data JustIfy = JustIfy
instance Apply JustIfy a (Maybe a) where
apply _ = Just
recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool, ())))
recursivePairs' = hMap JustIfy recursivePairs
works with your code just fine
EDIT: A more general approach to the same thing is (requiring RankNTypes)
--A "universal" action that works on all types
newtype Univ f = Univ (forall x. x -> f x)
instance Apply (Univ f) x (f x) where
apply (Univ f) x = f x
recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool, ())))
recursivePairs' = hMap (Univ Just) recursivePairs
or if you are using a recent ish version of GHC and are willing to turn on more extensions
newtype Univ' c f = Univ' (forall x. c x => x -> f x)
instance c x => Apply (Univ' c f) x (f x) where
apply (Univ' f) x = f x
class All x
instance All x
recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool, ())))
recursivePairs' = hMap (Univ' Just :: Univ' All Maybe) recursivePairs
which is nice since then it lets you do things like include a "show" in the function you map with.
For a more general solution, check out Oleg's Type level lambda caclulus which allows you to write code at the value level and then auto-magically infers the appropriate type level program. Unfortunetly, Oleg's solution is at this point rather old, and uses a nominal implementation of the LC which I don't particularly like. I've been thinking about how to do better, but might hold off until deciable equality comes to type families.
My view is that HLists should these days be done using GADTs and DataKinds rather than tuples. Type families are preferable to functional dependencies, but currently are more limited because they lack decidable equality.
Although the following does not exactly answer the question (so I won't be accepting it), it does solve the problem concerning mapping the structure without requiring any additional instances for applicative functors:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Applicative
main = do
print $ (hPure recursivePairs :: (Maybe Int, (Maybe Char, (Maybe Bool, ()))))
print $ (hPure recursivePairs :: ([Int], ([Char], ([Bool], ()))))
recursivePairs :: (Int, (Char, (Bool, ())))
recursivePairs = (1, ('a', (True, ())))
class HPure input output where
hPure :: input -> output
instance HPure () () where
hPure _ = ()
instance
( Applicative f,
HPure iTail oTail ) =>
HPure (iHead, iTail) (f iHead, oTail)
where hPure (iHead, iTail) = (pure iHead, hPure iTail)
Outputs:
(Just 1,(Just 'a',(Just True,())))
([1],("a",([True],())))