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 #-}
Related
I'm trying to use type class to simulate ad-hoc polymorphism and solve generic cases involving higher kinded types and so far can't figure out the correct solution.
What I'm looking for is to define something similar to:
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
infixl 0 >>>
-- | Type class that allows applying a value of type #fn# to some #m a#
class Apply m a fn b | a fn -> b where
(>>>) :: m a -> fn -> m b
-- to later use it in following manner:
(Just False) >>> True -- same as True <$ ma
(Just True) >>> id -- same as id <$> ma
Nothing >>> pure Bool -- same as Nothing >>= const $ pure Bool
(Just "foo") >>> (\a -> return a) -- same as (Just "foo") >>= (\a -> return a)
So far I've tried multiple options, none of them working.
Just a straight forward solution obviously fails:
instance (Functor m) => Apply m a b b where
(>>>) m b = b <$ m
instance (Monad m) => Apply m a (m b) b where
(>>>) m mb = m >>= const mb
instance (Functor m) => Apply m a (a -> b) b where
(>>>) m fn = fmap fn m
instance (Monad m, a' ~ a) => Apply m a (a' -> m b) b where
(>>>) m fn = m >>= fn
As there are tons of fundep conflicts (all of them) related to the first instance that gladly covers all the cases (duh).
I couldn't work out also a proper type family approach:
class Apply' (fnType :: FnType) m a fn b | a fn -> b where
(>>>) :: m a -> fn -> m b
instance (Functor m) => Apply' Const m a b b where
(>>>) m b = b <$ m
instance (Monad m) => Apply' ConstM m a (m b) b where
(>>>) m mb = m >>= const mb
instance (Functor m, a ~ a') => Apply' Fn m a (a' -> b) b where
(>>>) m mb = m >>= const mb
instance (Functor m, a ~ a') => Apply' Fn m a (a' -> m b) b where
(>>>) m fn = m >>= fn
data FnType = Const | ConstM | Fn | FnM
type family ApplyT a where
ApplyT (m a) = ConstM
ApplyT (a -> m b) = FnM
ApplyT (a -> b) = Fn
ApplyT _ = Const
Here I have almost the same issue, where the first instance conflicts with all of them through fundep.
The end result I want to achieve is somewhat similar to the infamous magnet pattern sometimes used in Scala.
Update:
To clarify the need for such type class even further, here is a somewhat simple example:
-- | Monad to operate on
data Endpoint m a = Endpoint { runEndpoint :: Maybe (m a) } deriving (Functor, Applicative, Monad)
So far there is no huge need to have mentioned operator >>> in place, as users might use the standard set of <$ | <$> | >>= instead. (Actually, not sure about >>= as there is no way to define Endpoint in terms of Monad)
Now to make it a bit more complex:
infixr 6 :::
-- | Let's introduce HList GADT
data HList xs where
HNil :: HList '[]
(:::) :: a -> HList as -> HList (a ': as)
-- Endpoint where a ~ HList
endpoint :: Endpoint IO (HList '[Bool, Int]) = pure $ True ::: 5 ::: HNil
-- Some random function
fn :: Bool -> Int -> String
fn b i = show b ++ show i
fn <$> endpoint -- doesn't work, as fn is a function of a -> b -> c, not HList -> c
Also, imagine that the function fn might be also defined with m String as a result. That's why I'm looking for a way to hide this complexity away from the API user.
Worth mentioning, I already have a type class to convert a -> b -> c into HList '[a, b] -> c
If the goal is to abstract over HLists, just do that. Don't muddle things by introducing a possible monad wrapper at every argument, it turns out to be quite complicated indeed. Instead do the wrapping and lifting at the function level with all the usual tools. So:
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
data HList a where
HNil :: HList '[]
(:::) :: x -> HList xs -> HList (x : xs)
class ApplyArgs args i o | args i -> o, args o -> i where
apply :: i -> HList args -> o
instance i ~ o => ApplyArgs '[] i o where
apply i _ = i
instance (x ~ y, ApplyArgs xs i o) => ApplyArgs (x:xs) (y -> i) o where
apply f (x ::: xs) = apply (f x) xs
Consider the following Haskell code (GHC 8.2):
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Constraint
type family Head xs where
Head (x ': xs) = x
type family Tail xs where
Tail (x ': xs) = xs
class IsList xs where
isList :: (xs ~ '[] => r) -> ((xs ~ (Head xs ': Tail xs), IsList (Tail xs)) => r) -> r
instance IsList '[] where isList r _ = r
instance IsList xs => IsList (x ': xs) where isList _ r = r
type family Prepend xs ys where
Prepend '[] ys = ys
Prepend (x ': xs) ys = x ': Prepend xs ys
prependPreservesIsList :: forall xs ys. (IsList xs, IsList ys) => Dict (IsList (Prepend xs ys))
prependPreservesIsList = isList #xs Dict (withDict (prependPreservesIsList #(Tail xs) #ys) Dict)
class IsList (Deps a) => Hard (a :: *) where
type Deps a :: [*]
instance (Hard a, Hard b) => Hard (Either a b) where
type Deps (Either a b) = Prepend (Deps a) (Deps b)
it fails with
Main.hs:37:10: error:
• Could not deduce (IsList (Prepend (Deps a) (Deps b)))
arising from the superclasses of an instance declaration
from the context: (Hard a, Hard b)
bound by the instance declaration at Main.hs:37:10-46
• In the instance declaration for ‘Hard (Either a b)’
|
37 | instance (Hard a, Hard b) => Hard (Either a b) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
What the code is trying to do is construct a class Hard that has an associated list of types Deps, where the Deps corresponding to an Either a b are supposed to be the concatenation of the Deps corresponding to a and b.
We know how to prove to GHC that this form of concatenation preserves the IsList class, as witnessed by prependPreservesIsList. If we had (Hard a, Hard b) and we needed to write normal code that required (IsList (Deps (Either a b))) we'd just withDict prependPreservesIsList and be on our way. But we need GHC to recognize this constraint "at compile time", in order to grant that the Either a b instance is legal.
Is there any way to "open a constraint dictionary" at compile-time, or to otherwise finagle this code so as to cause GHC to accept the Either a b instance?
Consider switching from type-level lists to type-level trees. So:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
data Tree a = Empty | Node a | Branch (Tree a) (Tree a)
class IsTree xs where
isTree ::
(xs ~ 'Empty => a) ->
(forall x. xs ~ 'Node x => a) ->
(forall l r. (xs ~ 'Branch l r, IsTree l, IsTree r) => a) ->
a
instance IsTree 'Empty where isTree a _ _ = a
instance IsTree ('Node x) where isTree _ a _ = a
instance (IsTree l, IsTree r) => IsTree ('Branch l r) where isTree _ _ a = a
class IsTree (Deps a) => Hard a where
type Deps a :: Tree *
instance (Hard a, Hard b) => Hard (Either a b) where
type Deps (Either a b) = 'Branch (Deps a) (Deps b)
There's another way to represent type class constraints, as first class dictionaries (Dict), although it's not nearly as ergonomic:
class Hard a where
type Deps a :: [*]
depsIsList :: Dict (IsList (Deps a))
instance (Hard a, Hard b) => Hard (Either a b) where
type Deps (Either a b) = Prepend (Deps a) (Deps b)
depsIsList =
case depsIsList #a of
Dict ->
case depsIsList #b of
Dict -> prependPreservesIsList #(Deps a) #(Deps b)
Using (:-) from the constraints package might make composing dictionaries like that a tiny bit less painful.
I am using makeFields from lens to generate fields overloaded for various structures. I would like to use these fields at one with multiple structures while having to state which field I want to use only once. It would look like this:
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Lens
data A = A
{ _aX :: String
, _aY :: String
}
makeFields ''A
data B = B
{ _bX :: String -> Char
, _bY :: String -> Bool
}
makeFields ''B
-- x can get _aX from an A and _bX from a B
a :: A
a = undefined
b :: B
b = undefined
q :: (Getter A String) AND (Getter B (String -> a)) -> a
q lens = (b^.lens) (a^.lens)
Which type should I give q? I tried letting GHC infer the types, but that failed.
To decide what is to be done, we need to know what the types of your (makeField-generated) fields are:
GHCi> :t x
x :: (HasX s a, Functor f) => (a -> f a) -> s -> f s
So the abstraction covering all your x-bearing types (the abstraction I was whining about before noticing you were using makeFields) is a multi-parameter type class HasX, and similarly for the other fields. That gives us enough to use x with different types in a single implementation:
-- Additional extension required: FlexibleContexts
-- Note that GHC is able to infer this type.
qx :: (HasX t (a -> b), HasX s a) => t -> s -> b
qx t s = (t ^. x) (s ^. x)
GHCi> import Data.Maybe
GHCi> let testA = A "foo" "bar"
GHCi> let testB = B (fromMaybe 'ø' . listToMaybe) null
GHCi> qx testB testA
'f'
That, however, is not quite what you asked for. You wanted something like:
q xOrY b a = (b^.xOrY) (a^.xOrY)
Achieving that, however, requires abstracting over the classes HasX, HasY, etc. Doing so is, in fact, somewhat feasible thanks to the ConstraintKinds extension, as demonstrated in Could we abstract over type classes? Here it goes:
-- Additional extensions required: ConstraintKinds, ScopedTypeVariables
-- Additional import required: Data.Proxy
-- GHC cannot infer this type.
q :: forall h s t a b. (h t (a -> b), h s a) => Proxy a -> Proxy h
-> (forall u c. h u c => Getting c u c) -> t -> s -> b
q _ _ l t s =
(t ^. (l :: Getting (a -> b) t (a -> b))) (s ^. (l :: Getting a s a))
GHCi> q (Proxy :: Proxy String) (Proxy :: Proxy HasX) x testB testA
'f'
The first proxy, which determines the intermediate type, is necessary unless you give up this bit of generality and replace a by String. Additionally, you have to specify the field twice, both by passing the getter as an argument and through the second proxy. I am not at all convinced that this second solution is worth the trouble -- the extra boilerplate of having to define qx, qy, etc. looks quite a bit less painful than all the circuitousness involved here. Still, if any of you who are reading this would like to suggest an improvement, I'm all ears.
I have a list of heterogeneous types (or at least that's what I have in mind):
data Nul
data Bits b otherBits where
BitsLst :: b -> otherBits -> Bits b otherBits
NoMoreBits :: Bits b Nul
Now, given an input type b, I want to go through all the slabs of Bits with type b and summarize them, ignoring other slabs with type b' /= b:
class Monoid r => EncodeBit b r | b -> r where
encodeBit :: b -> r
class AbstractFoldable aMulti r where
manyFold :: r -> aMulti -> r
instance (EncodeBit b r, AbstractFoldable otherBits r) =>
AbstractFoldable (Bits b otherBits ) r where
manyFold r0 (BitsLst bi other) = manyFold (r0 `mappend` (encodeBit bi)) other
manyFold b0 NoMoreBits = b0
instance AbstractFoldable otherBits r =>
AbstractFoldable (Bits nb otherBits ) r where
manyFold r0 (BitsLst _ other) = manyFold r0 other
manyFold b0 NoMoreBits = b0
But the compiler wants none of it. And with good reason, since both instance declarations have the same head. Question: what is the correct way of folding over Bits with an arbitrary type?
Note: the above example is compiled with
{-# LANGUAGE MultiParamTypeClasses,
FunctionalDependencies,
GADTs,
DataKinds,
FlexibleInstances,
FlexibleContexts
#-}
Answering your comment:
Actually, I can do if I can filter the heterogeneous list by type. Is that possible?
You can filter the heterogeneous list by type if you add a Typeable constraint to b.
The main idea is we will use Data.Typeable's cast :: (Typeable a, Typeable b) => a -> Maybe b to determine if each item in the list is of a certain type. This will require a Typeable constraint for each item in the list. Instead of building a new list type with this constraint built in, we will make the ability to check if All types in a list meet some constraint.
Our goal is to make the following program output [True,False], filtering a heterogeneous list to only its Bool elements. I will endevour to place the language extensions and imports with the first snippet they are needed for
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
example :: HList (Bool ': String ': Bool ': String ': '[])
example = HCons True $ HCons "Jack" $ HCons False $ HCons "Jill" $ HNil
main = do
print (ofType example :: [Bool])
HList here is a fairly standard definition of a heterogeneous list in haskell using DataKinds
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
data HList (l :: [*]) where
HCons :: h -> HList t -> HList (h ': t)
HNil :: HList '[]
We want to write ofType with a signature like "if All things in a heterogeneous list are Typeable, get a list of those things of a specific Typeable type.
import Data.Typeable
ofType :: (All Typeable l, Typeable a) => HList l -> [a]
To do this, we need to develop the notion of All things in a list of types satisfying some constraint. We will store the dictionaries for satisfied constraints in a GADT that either captures both the head constraint dictionary and constraints for All of the the tail or proves that the list is empty. A type list satisfies a constraint for All it's items if we can capture the dictionaries for it.
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
-- requires the constraints† package.
-- Constraint is actually in GHC.Prim
-- it's just easier to get to this way
import Data.Constraint (Constraint)
class All (c :: * -> Constraint) (l :: [*]) where
allDict :: p1 c -> p2 l -> DList c l
data DList (ctx :: * -> Constraint) (l :: [*]) where
DCons :: (ctx h, All ctx t) => DList ctx (h ': t)
DNil :: DList ctx '[]
DList really is a list of dictionaries. DCons captures the dictionary for the constraint applied to the head item (ctx h) and all the dictionaries for the remainder of the list (All ctx t). We can't get the dictionaries for the tail directly from the constructor, but we can write a function that extracts them from the dictionary for All ctx t.
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Proxy
dtail :: forall ctx h t. DList ctx (h ': t) -> DList ctx t
dtail DCons = allDict (Proxy :: Proxy ctx) (Proxy :: Proxy t)
An empty list of types trivially satisfies any constraint applied to all of its items
instance All c '[] where
allDict _ _ = DNil
If the head of a list satisfies a constraint and all of the tail does too, then everything in the list satisfies the constraint.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
instance (c h, All c t) => All c (h ': t) where
allDict _ _ = DCons
We can now write ofType, which requires foralls for scoping type variables with ScopedTypeVariables.
import Data.Maybe
ofType :: forall a l. (All Typeable l, Typeable a) => HList l -> [a]
ofType l = ofType' (allDict (Proxy :: Proxy Typeable) l) l
where
ofType' :: forall l. (All Typeable l) => DList Typeable l -> HList l -> [a]
ofType' d#DCons (HCons x t) = maybeToList (cast x) ++ ofType' (dtail d) t
ofType' DNil HNil = []
We are zipping the HList together with its dictionaries with maybeToList . cast and concatenating the results. We can make that explicit with RankNTypes.
{-# LANGUAGE RankNTypes #-}
import Data.Monoid (Monoid, (<>), mempty)
zipDHWith :: forall c w l p. (All c l, Monoid w) => (forall a. (c a) => a -> w) -> p c -> HList l -> w
zipDHWith f p l = zipDHWith' (allDict p l) l
where
zipDHWith' :: forall l. (All c l) => DList c l -> HList l -> w
zipDHWith' d#DCons (HCons x t) = f x <> zipDHWith' (dtail d) t
zipDHWith' DNil HNil = mempty
ofType :: (All Typeable l, Typeable a) => HList l -> [a]
ofType = zipDHWith (maybeToList . cast) (Proxy :: Proxy Typeable)
†constraints
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)