Mapping over a heterogenous data structure with a generic function - haskell

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],())))

Related

Deriving Show when a type family is present (without writing manual constraints)

I want to create an ADT that is parameterized on a certain type family, which can be used to change the type of the fields. I'd like to derive Show/Eq/etc. for this type without lots of boilerplate.
Standalone deriving works, if you manually write out the constraints. I understand from questions like this one why a normal deriving Show statement doesn't work.
But, writing out the constraints is cumbersome if you have lots of fields like this. My question is, given all the new deriving features in GHC lately (strategies, via, etc.) is there some way to do this concisely?
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module Test where
import Data.Kind
import Prelude
type family Switchable (f :: Type -> Type) x where
Switchable TextName x = String
Switchable Same x = x
data TextName x
data Same x
data Foo f = Foo {
fooField :: Switchable f Int
}
-- The constraint here is required, which gets cumbersome when many fields are present
deriving instance (Show (Switchable f Int)) => Show (Foo f)
At first I thought you might be able to get away with a quantified constraint like this:
deriving instance (forall a. Show a => Show (Switchable f a)) => Show (Foo f)
But sadly, type families cannot appear in a quantified constraint, for the same reason they can't appear in instance heads.
So I came up with a slightly worse, but still less cumbersome solution: extract all the constraint boilerplate as yet another type family returning a constraint.
type family ShowAll f (xs :: [Type]) :: Constraint where
ShowAll f '[] = ()
ShowAll f (x:xs) = (Show (Switchable f x), ShowAll f xs)
Now you can use this to assert Show (Switchable f a) for all interesting a:
data Foo f = Foo {
fooField1 :: Switchable f Int,
fooField2 :: Switchable f String,
fooField3 :: Switchable f Bool
}
deriving instance ShowAll f '[Int, String, Bool] => Show (Foo f)
You still have to enumerate all the a explicitly, but at least now it's cleaner without all the noise.
I hope this is helpful.
There are a few different methods for this.
Make an alias for applying a constraint to all the field types, to abbreviate constraints on all of them. (Some will be redundant.)
{-# Language ConstraintKinds #-}
data Foo f = Foo
{ fooField1 :: Switchable f Int
, fooField2 :: Switchable f String
, fooField3 :: Switchable f Bool
}
type Fields (c :: Type -> Constraint) (f :: Type -> Type) =
( c (Switchable f Int)
, c (Switchable f String)
, c (Switchable f Bool)
)
deriving instance (Fields Show f) => Show (Foo f)
Replace the type family with a GADT.
data Foo f = Foo
{ fooField1 :: Field f Int
, fooField2 :: Field f String
, fooField3 :: Field f Bool
}
deriving instance Show (Foo f)
data Field (f :: Type -> Type) x where
Field :: Switch f x r -> Field f x
deriving instance (Show x) => Show (Field f x)
data Switch (f :: Type -> Type) x r where
SwitchTextName :: String -> Switch TextName x String
SwitchSame :: x -> Switch Same x x
deriving instance (Show x) => Show (Switch f x r)
This is a 1-for-1 translation, but it can be simplified depending on the specifics, such as using only one type parameter, instead of having both x for the provided type and r for the resulting representation type.
Since constraints are only necessary to talk about types generically, avoid constraints by deriving instances for concrete combinations of types whenever possible.
deriving instance Show (Foo TextName)
deriving instance Show (Foo Same)
Make each field type that may vary into a type parameter, then write convenience aliases for combinations of parameters.
data Foo i s b = Foo
{ fooField1 :: i
, fooField2 :: s
, fooField3 :: b
}
type FooByName = Foo String String String
type FooByNumbers = Foo Int String Bool
#4 can be a little unwieldy with a large number of parameters, but it has the distinct advantage that you can easily write polymorphic functions to update only one parameter and ignore the others. When all the field types are indexed by a single type parameter, like in the type-family version, you may need to traverse the whole data structure to update any of them.

List of showables OOP-style in Haskell?

I want to build a list of different things which have one property in common, namely, they could be turned into string. The object-oriented approach is straightforward: define interface Showable and make classes of interest implement it. Second point can in principle be a problem when you can't alter the classes, but let's pretend this is not the case. Then you create a list of Showables and fill it with objects of these classes without any additional noise (e.g. upcasting is usually done implicitly). Proof of concept in Java is given here.
My question is what options for this do I have in Haskell? Below I discuss approaches that I've tried and which don't really satisfy me.
Approach 1: existensials. Works but ugly.
{-# LANGUAGE ExistentialQuantification #-}
data Showable = forall a. Show a => Sh a
aList :: [Showable]
aList = [Sh (1 :: Int), Sh "abc"]
The main drawback for me here is the necessity for Sh when filling the list. This closely resembles upcast operations which are implicitly done in OO-languages.
More generally, the dummy wrapper Showable for the thing which is already in the language — Show type class — adds extra noise in my code. No good.
Approach 2: impredicatives. Desired but does not work.
The most straightforward type for such a list for me and what I really desire would be:
{-# LANGUAGE ImpredicativeTypes #-}
aList :: [forall a. Show a => a]
aList = [(1 :: Int), "abc"]
Besides that (as I heard)ImpredicativeTypes is “fragile at best and broken at worst”
it does not compile:
Couldn't match expected type ‘a’ with actual type ‘Int’
‘a’ is a rigid type variable bound by
a type expected by the context: Show a => a
and the same error for "abc". (Note type signature for 1: without it I receive even more weird message: Could not deduce (Num a) arising from the literal ‘1’).
Approach 3: Rank-N types together with some sort of functional lists (difference lists?).
Instead of problematic ImpredicativeTypes one would probably prefer more stable and wide-accepted RankNTypes. This basically means: move
desired forall a. Show a => a out of type constructor (i.e. []) to plain function types. Consequently we need some representation of lists as plain functions. As I barely heard there are such representations. The one I heard of is difference lists. But in Dlist package the main type is good old data so we return to impredicatives. I didn't investigate this line any further as I suspect that it could yield more verbose code than in approach 1. But if you think it won't, please give me an example.
Bottom line: how would you attack such a task in Haskell? Could you give more succinct solution than in OO-language (especially in place of filling a list — see comment for code in approach 1)? Can you comment on how relevant are the approaches listed above?
UPD (based on first comments): the question is of course simplified for the purpose of readability. The real problem is more about how to store things which share the same type class, i.e. can be processed later on in a number of ways (Show has only one method, but other classes can have more than one). This factors out solutions which suggest apply show method right when filling a list.
Since evaluation is lazy in Haskell, how about just creating a list of the actual strings?
showables = [ show 1, show "blah", show 3.14 ]
The HList-style solutions would work, but it is possible to reduce the complexity if you only need to work with lists of constrained existentials and you don't need the other HList machinery.
Here's how I handle this in my existentialist package:
{-# LANGUAGE ConstraintKinds, ExistentialQuantification, RankNTypes #-}
data ConstrList c = forall a. c a => a :> ConstrList c
| Nil
infixr :>
constrMap :: (forall a. c a => a -> b) -> ConstrList c -> [b]
constrMap f (x :> xs) = f x : constrMap f xs
constrMap f Nil = []
This can then be used like this:
example :: [String]
example
= constrMap show
(( 'a'
:> True
:> ()
:> Nil) :: ConstrList Show)
It could be useful if you have a large list or possibly if you have to do lots of manipulations to a list of constrained existentials.
Using this approach, you also don't need to encode the length of the list in the type (or the original types of the elements). This could be a good thing or a bad thing depending on the situation. If you want to preserve the all of original type information, an HList is probably the way to go.
Also, if (as is the case of Show) there is only one class method, the approach I would recommend would be applying that method to each item in the list directly as in ErikR's answer or the first technique in phadej's answer.
It sounds like the actual problem is more complex than just a list of Show-able values, so it is hard to give a definite recommendation of which of these specifically is the most appropriate without more concrete information.
One of these methods would probably work out well though (unless the architecture of the code itself could be simplified so that it doesn't run into the problem in the first place).
Generalizing to existentials contained in higher-kinded types
This can be generalized to higher kinds like this:
data AnyList c f = forall a. c a => f a :| (AnyList c f)
| Nil
infixr :|
anyMap :: (forall a. c a => f a -> b) -> AnyList c f -> [b]
anyMap g (x :| xs) = g x : anyMap g xs
anyMap g Nil = []
Using this, we can (for example) create a list of functions that have Show-able result types.
example2 :: Int -> [String]
example2 x = anyMap (\m -> show (m x))
(( f
:| g
:| h
:| Nil) :: AnyList Show ((->) Int))
where
f :: Int -> String
f = show
g :: Int -> Bool
g = (< 3)
h :: Int -> ()
h _ = ()
We can see that this is a true generalization by defining:
type ConstrList c = AnyList c Identity
(>:) :: forall c a. c a => a -> AnyList c Identity -> AnyList c Identity
x >: xs = Identity x :| xs
infixr >:
constrMap :: (forall a. c a => a -> b) -> AnyList c Identity -> [b]
constrMap f (Identity x :| xs) = f x : constrMap f xs
constrMap f Nil = []
This allows the original example from the first part of this to work using this new, more general, formulation with no changes to the existing example code except changing :> to >: (even this small change might be able to be avoided with pattern synonyms. I'm not totally sure though since I haven't tried and sometimes pattern synonyms interact with existential quantification in ways that I don't fully understand).
If you really, really want, you can use a heterogeneous list. This approach really isn't useful for Show, because it has a single method and all you can do is apply it, but if your class has multiple methods this could be useful.
{-# LANGUAGE PolyKinds, KindSignatures, GADTs, TypeFamilies
, TypeOperators, DataKinds, ConstraintKinds, RankNTypes, PatternSynonyms #-}
import Data.List (intercalate)
import GHC.Prim (Constraint)
infixr 5 :&
data HList xs where
None :: HList '[]
(:&) :: a -> HList bs -> HList (a ': bs)
-- | Constraint All c xs holds if c holds for all x in xs
type family All (c :: k -> Constraint) xs :: Constraint where
All c '[] = ()
All c (x ': xs) = (c x, All c xs)
-- | The list whose element types are unknown, but known to satisfy
-- a class predicate.
data CList c where CL :: All c xs => HList xs -> CList c
cons :: c a => a -> CList c -> CList c
cons a (CL xs) = CL (a :& xs)
empty :: CList c
empty = CL None
uncons :: (forall a . c a => a -> CList c -> r) -> r -> CList c -> r
uncons _ n (CL None) = n
uncons c n (CL (x :& xs)) = c x (CL xs)
foldrC :: (forall a . c a => a -> r -> r) -> r -> CList c -> r
foldrC f z = go where go = uncons (\x -> f x . go) z
showAll :: CList Show -> String
showAll l = "[" ++ intercalate "," (foldrC (\x xs -> show x : xs) [] l) ++ "]"
test = putStrLn $ showAll $ CL $
1 :&
'a' :&
"foo" :&
[2.3, 2.5 .. 3] :&
None
You can create your own operator to reduce syntax noise:
infixr 5 <:
(<:) :: Show a => a -> [String] -> [String]
x <: l = show x : l
So you can do:
λ > (1 :: Int) <: True <: "abs" <: []
["1","True","\"abs\""]
This is not [1 :: Int, True, "abs"] but not much longer.
Unfortunately you cannot rebind [...] syntax with RebindableSyntax.
Another approach is to use HList and preserve all type information, i.e. no downcasts, no upcasts:
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
import GHC.Exts (Constraint)
infixr 5 :::
type family All (c :: k -> Constraint) (xs :: [k]) :: Constraint where
All c '[] = ()
All c (x ': xs) = (c x, All c xs)
data HList as where
HNil :: HList '[]
(:::) :: a -> HList as -> HList (a ': as)
instance All Show as => Show (HList as) where
showsPrec d HNil = showString "HNil"
showsPrec d (x ::: xs) = showParen (d > 5) (showsPrec 5 x)
. showString " ::: "
. showParen (d > 5) (showsPrec 5 xs)
And after all that:
λ *Main > (1 :: Int) ::: True ::: "foo" ::: HNil
1 ::: True ::: "foo" ::: HNil
λ *Main > :t (1 :: Int) ::: True ::: "foo" ::: HNil
(1 :: Int) ::: True ::: "foo" ::: HNil
:: HList '[Int, Bool, [Char]]
There are various ways to encode heterogenous list, in HList is one, there is also generics-sop with NP I xs. It depends on what you are trying to achieve in the larger context, if this is this preserve-all-the-types approach is what you need.
I would do something like this:
newtype Strings = Strings { getStrings :: [String] }
newtype DiffList a = DiffList { getDiffList :: [a] -> [a] }
instance Monoid (DiffList a) where
mempty = DiffList id
DiffList f `mappend` DiffList g = DiffList (f . g)
class ShowList a where
showList' :: DiffList String -> a
instance ShowList Strings where
showList' (DiffList xs) = Strings (xs [])
instance (Show a, ShowList b) => ShowList (a -> b) where
showList' xs x = showList' $ xs `mappend` DiffList (show x :)
showList = showList' mempty
Now, you can create a ShowList as follows:
myShowList = showList 1 "blah" 3.14
You can get back a list of strings using getStrings as follows:
myStrings = getStrings myShowList
Here's what's happening:
A value of the type ShowList a => a could be:
Either a list of strings wrapped in a Strings newtype wrapper.
Or a function from an instance of Show to an instance of ShowList.
This means that the function showList is a variadic argument function which takes an arbitrary number of printable values and eventually returns a list of strings wrapped in a Strings newtype wrapper.
You can eventually call getStrings on a value of the type ShowList a => a to get the final result. In addition, you don't need to do any explicit type coercion yourself.
Advantages:
You can add new elements to your list whenever you want.
The syntax is succinct. You don't have to manually add show in front of every element.
It doesn't make use of any language extensions. Hence, it works in Haskell 98 too.
You get the best of both worlds, type safety and a great syntax.
Using difference lists, you can construct the result in linear time.
For more information on functions with variadic arguments, read the answer to the following question:
How does Haskell printf work?
My answer is fundamentally the same as ErikR's: the type that best embodies your requirements is [String]. But I'll go a bit more into the logic that I believe justifies this answer. The key is in this quote from the question:
[...] things which have one property in common, namely, they could be turned into string.
Let's call this type Stringable. But now the key observation is this:
Stringable is isomorphic to String!
That is, if your statement above is the whole specification of the Stringable type, then there is a pair functions with these signatures:
toString :: Stringable -> String
toStringable :: String -> Stringable
...such that the two functions are inverses. When two types are isomorphic, any program that uses either of the types can be rewritten in terms of the other without any change to its semantics. So Stringable doesn't let you do anything that String doesn't let you do already!
In more concrete terms, the point is that this refactoring is guaranteed to work no matter what:
At every point in your program where you turn an object into a Stringable and stick that into a [Stringable], turn the object into a String and stick that into a [String].
At every point in your program that you consume a Stringable by applying toString to it, you can now eliminate the call to toString.
Note that this argument generalizes to types more complex than Stringable, with many "methods". So for example, the type of "things that you can turn into either a String or an Int" is isomorphic to (String, Int). The type of "things that you can either turn into a String or combine them with a Foo to produce a Bar" is isomorphic to (String, Foo -> Bar). And so on. Basically, this logic leads to the "record of methods" encoding that other answers have brought up.
I think the lesson to draw from this is the following: you need a specification richer than just "can be turned into a string" in order to justify using any of the mechanisms you brought up. So for example, if we add the requirement that Stringable values can be downcast to the original type, an existential type now perhaps becomes justifiable:
{-# LANGUAGE GADTs #-}
import Data.Typeable
data Showable = Showable
Showable :: (Show a, Typeable a) => a -> Stringable
downcast :: Typeable a => Showable -> Maybe a
downcast (Showable a) = cast a
This Showable type is not isomorphic to String, because the Typeable constraint allows us to implement the downcast function that allows us to distinguish between different Showables that produce the same string. A richer version of this idea can be seen in this "shape example" Gist.
You can store partially applied functions in the list.
Suppose we are building a ray-tracer with different shape that you can intersect.
data Sphere = ...
data Triangle = ...
data Ray = ...
data IntersectionResult = ...
class Intersect t where
intersect :: t -> Ray -> Maybe IntersectionResult
instance Intersect Sphere where ...
instance Intersect Triangle where ...
Now, we can partially apply the intersect to get a list of Ray -> Maybe IntersectionResult such as:
myList :: [(Ray -> Maybe IntersectionResult)]
myList = [intersect sphere, intersect triangle, ...]
Now, if you want to get all the intersections, you can write:
map ($ ray) myList -- or map (\f -> f ray) myList
This can be extended a bit to handle an interface with multiples functions, for example, if you want to be able to get something of a shape :
class ShapeWithSomething t where
getSomething :: t -> OtherParam -> Float
data ShapeIntersectAndSomething = ShapeIntersectAndSomething {
intersect :: Ray -> Maybe IntersectionResult,
getSomething :: OtherParam -> Float}
Something I don't know is the overhead of this approach. We need to store the pointer to the function and the pointer to the shape and this for each function of the interface, which is a lot compared to the shared vtable usually used in OO language. I don't have any idea if GHC is able to optimize this.
The core of the problem is : you want to dispatch (read select which function to call) at runtime, depending on what the "type" of the object is. In Haskell this can be achieved by wrapping the data into a sum data type (which is called here ShowableInterface):
data ShowableInterface = ShowInt Int | ShowApple Apple | ShowBusiness Business
instance Show ShowableInterface where
show (ShowInt i) = show i
show (ShowApple a) = show a
show (ShowBusiness b) = show b
list=[ShowInt 2, ShowApple CrunchyGold, ShowBusiness MoulinRouge]
show list
would correspond to something like this in Java :
class Int implements ShowableInterface
{
public show {return Integer.asString(i)};
}
class Apple implements ShowableInterface
{
public show {return this.name};
}
class ShowBusiness implements ShowableInterface
{
public show {return this.fancyName};
}
List list = new ArrayList (new Apple("CrunchyGold"),
new ShowBusiness("MoulingRouge"), new Integer(2));
so in Haskell you need to explicitly wrap stuff into the ShowableInterface, in Java this wrapping is done implicitly on object creation.
credit goes to #haskell IRC for explaining this to me a year ago, or so.

Haskell: Heterogeneous list for data with phantom variable

I'm learning about existential quantification, phantom types, and GADTs at the moment. How do I go about creating a heterogeneous list of a data type with a phantom variable? For example:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ExistentialQuantification #-}
data Toy a where
TBool :: Bool -> Toy Bool
TInt :: Int -> Toy Int
instance Show (Toy a) where
show (TBool b) = "TBool " ++ show b
show (TInt i) = "TInt " ++ show i
bools :: [Toy Bool]
bools = [TBool False, TBool True]
ints :: [Toy Int]
ints = map TInt [0..9]
Having functions like below are OK:
isBool :: Toy a -> Bool
isBool (TBool _) = True
isBool (TInt _) = False
addOne :: Toy Int -> Toy Int
addOne (TInt a) = TInt $ a + 1
However, I would like to be able to declare a heterogeneous list like so:
zeros :: [Toy a]
zeros = [TBool False, TInt 0]
I tried using an empty type class to restrict the type on a by:
class Unify a
instance Unify Bool
instance Unify Int
zeros :: Unify a => [Toy a]
zeros = [TBool False, TInt 0]
But the above would fail to compile. I was able to use existential quantification to do get the following:
data T = forall a. (Forget a, Show a) => T a
instance Show T where
show (T a) = show a
class (Show a) => Forget a
instance Forget (Toy a)
instance Forget T
zeros :: [T]
zeros = [T (TBool False), T (TInt 0)]
But this way, I cannot apply a function that was based on the specific type of a in Toy a to T e.g. addOne above.
In conclusion, what are some ways I can create a heterogeneous list without forgetting/losing the phantom variable?
Start with the Toy type:
data Toy a where
TBool :: Bool -> Toy Bool
TInt :: Int -> Toy Int
Now you can wrap it up in an existential without over-generalizing with the class system:
data WrappedToy where
Wrap :: Toy a -> WrappedToy
Since the wrapper only holds Toys, we can unwrap them and get Toys back:
incIfInt :: WrappedToy -> WrappedToy
incIfInt (Wrap (TInt n)) = Wrap (TInt (n+1))
incIfInt w = w
And now you can distinguish things within the list:
incIntToys :: [WrappedToy] -> [WrappedToy]
incIntToys = map incIfInt
Edit
As Cirdec points out, the different pieces can be teased apart a bit:
onInt :: (Toy Int -> WrappedToy) -> WrappedToy -> WrappedToy
onInt f (Wrap t#(TInt _)) = f t
onInt _ w = w
mapInt :: (Int -> Int) -> Toy Int -> Toy Int
mapInt f (TInt x) = TInt (f x)
incIntToys :: [WrappedToy] -> [WrappedToy]
incIntToys = map $ onInt (Wrap . mapInt (+1))
I should also note that nothing here so far really justifies the Toy GADT. bheklilr's simpler approach of using a plain algebraic datatype should work just fine.
There was a very similar question a few days ago.
In your case it would be
{-# LANGUAGE GADTs, PolyKinds, Rank2Types #-}
data Exists :: (k -> *) -> * where
This :: p x -> Exists p
type Toys = [Exists Toy]
zeros :: Toys
zeros = [This (TBool False), This (TInt 0)]
It's easy to eliminate an existential:
recEx :: (forall x. p x -> c) -> Exists p -> c
recEx f (This x) = f x
Then if you have a recursor for the Toy datatype
recToy :: (Toy Bool -> c) -> (Toy Int -> c) -> Toy a -> c
recToy f g x#(TBool _) = f x
recToy f g x#(TInt _) = g x
you can map a wrapped toy:
mapToyEx :: (Toy Bool -> p x) -> (Toy Int -> p y) -> Exists Toy -> Exists p
mapToyEx f g = recEx (recToy (This . f) (This . g))
For example
non_zeros :: Toys
non_zeros = map (mapToyEx (const (TBool True)) addOne) zeros
This approach is similar to one in #dfeuer's answer, but it's less ad hoc.
The ordinary heterogeneous list indexed by a list of the types of its elements is
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
data HList l where
HNil :: HList '[]
HCons :: a -> HList l -> HList (a ': l)
We can modify this to hold values inside some f :: * -> *.
data HList1 f l where
HNil1 :: HList1 f '[]
HCons1 :: f a -> HList1 f l -> HList1 f (a ': l)
Which you can use to write zeros without forgetting the type variables.
zeros :: HList1 Toy [Bool, Int]
zeros = HCons1 (TBool False) $ HCons1 (TInt 0) $ HNil1
Have you played with Data.Typeable? A Typeable constraint allows you to make guesses at the type hidden by the existential, and cast to that type when you guess right.
Not your example, but some example code I have lying around:
{-# LANGUAGE GADTs, ScopedTypeVariables, TypeOperators #-}
import Data.Typeable
data Showable where
-- Note that this is an existential defined in GADT form
Showable :: (Typeable a, Show a) => a -> Showable
instance Show Showable where
show (Showable value) = "Showable " ++ show value
-- Example of casting Showable to Integer
castToInteger :: Showable -> Maybe Integer
castToInteger (Showable (value :: a)) =
case eqT :: Maybe (a :~: Integer) of
Just Refl -> Just value
Nothing -> Nothing
example1 = [Showable "foo", Showable 5]
example2 = map castToInteger example1

Typed expression parser

I'm trying to create a typed expression parser in Haskell, which works great so far, but I'm currently struggling to implement higher order functions. I've boiled the problem down to a simple example:
{-# LANGUAGE TypeFamilies,GADTs,FlexibleContexts,RankNTypes #-}
-- A function has an argument type and a result type
class Fun f where
type FunArg f
type FunRes f
-- Expressions are either constants of function applications
data Expr a where
Const :: a -> Expr a
App :: Fun f => f -> FunArg f -> Expr (FunRes f)
-- A very simple function
data Plus = Plus
-- Which takes two integer expressions and returns an integer expression
instance Fun Plus where
type FunArg Plus = (Expr Int,Expr Int)
type FunRes Plus = Int
-- A more complicated function which lifts a function to lists (like in haskell)
data Map f r = Map f
-- For this we need the concept of lifting function arguments:
class Liftable a where
type LiftRes a
-- A singleton argument is lifted by changing the expression type from a to [a]
instance Liftable (Expr a) where
type LiftRes (Expr a) = Expr [a]
-- Two function arguments are lifted by lifting each argument
instance (Liftable a,Liftable b) => Liftable (a,b) where
type LiftRes (a,b) = (LiftRes a,LiftRes b)
-- Now we can declare a function instance for Map
instance (Fun f,Liftable (FunArg f),r ~ LiftRes (FunArg f)) => Fun (Map f r) where
type FunArg (Map f r) = r
type FunRes (Map f r) = [FunRes f]
-- Now a parser for functions:
parseFun :: [String] -> (forall f. Fun f => f -> a) -> a
-- The parser for the plus function is easy:
parseFun ["plus"] f = f Plus
-- But the parser for map is not possible:
parseFun ("map":sym) f
= parseFun sym (\fun -> f (Map fun))
The problem seems to be that there is no way to convince the type checker that every LiftRes is itself Liftable, because recursive class declarations are forbidden.
My question is: How do I make this work? Are there other examples of typed expression parsers from which I could take hints?
EDIT: It seems that this discussion about type family constraints seems to be very related. However, I fail to make their solution work in my case, maybe someone can help with that?
The easiest way to make your example work is to remove the Liftable (FunArg f) constraint from the instance declaration. But I think your example is just so condensed that it doesn't show why you actually need it.
So the next best thing is to add a Liftable (FunArg f) superclass constraint to the Fun class:
class Liftable (FunArg f) => Fun f where
...
If this is not feasible (i.e., if not all your functions have liftable argument types), then you cannot expect to write a parseFun of the given type.
A more general remark: I think what you're trying to do here is very strange, and perhaps too much at once. Parsing from unstructured strings into a context-free datatype is already difficult enough. Why not do that first, and write a separate function that transforms the "untyped", but structured representation of your language into a typed one.
EDIT (as a reaction to the comments, revised): As pointed out in the discussion on type family constraints that you also linked in your question, you can bypass the superclass cycle restriction by using ConstraintKinds. Here is a way to make your reduced example work. Perhaps this will scale to the full solution?
{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, FlexibleContexts, GADTs #-}
import Data.Constraint -- from the constraints package
import Data.Proxy -- from the tagged package
-- A function has an argument type and a result type
class Liftable (FunArg f) => Fun f where
type FunArg f
type FunRes f
-- Expr, Plus, and instance Fun Plus as before
class Liftable a where
type LiftRes a
get :: p a -> Dict (Liftable (LiftRes a))
-- acquire "superclass" dictionary by calling this method and
-- then pattern matching on the result
instance Liftable (Expr a) where
type LiftRes (Expr a) = Expr [a]
get _ = Dict
instance (Liftable a, Liftable b) => Liftable (a, b) where
type LiftRes (a, b) = (LiftRes a, LiftRes b)
get (_ :: p (a, b)) =
case get (Proxy :: Proxy a) of -- extra code required
Dict -> case get (Proxy :: Proxy b) of -- extra code required
Dict -> Dict
data Map f r = Map f
instance (Fun f, Liftable r, r ~ LiftRes (FunArg f)) => Fun (Map f r) where
type FunArg (Map f r) = r
type FunRes (Map f r) = [FunRes f]
parseFun :: forall a. [String] -> (forall f. Fun f => f -> a) -> a
parseFun ["plus"] f = f Plus
parseFun ("map" : sym) f = parseFun sym
(\ (fun :: g) -> case get (Proxy :: Proxy (FunArg g)) of -- extra code required
Dict -> f (Map fun))

How can I abstract a common Haskell recursive applicative functor pattern

While using applicative functors in Haskell I've often run into situations where I end up with repetitive code like this:
instance Arbitrary MyType where
arbitrary = MyType <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
In this example I'd like to say:
instance Arbitrary MyType where
arbitrary = applyMany MyType 4 arbitrary
but I can't figure out how to make applyMany (or something similar to it). I can't even figure out what the type would be but it would take a data constructor, an Int (n), and a function to apply n times. This happens when creating instances for QuickCheck, SmallCheck, Data.Binary, Xml serialization, and other recursive situations.
So how could I define applyMany?
Check out derive. Any other good generics library should be able to do this as well; derive is just the one I am familiar with. For example:
{-# LANGUAGE TemplateHaskell #-}
import Data.DeriveTH
import Test.QuickCheck
$( derive makeArbitrary ''MyType )
To address the question you actually asked, FUZxxl is right, this is not possible in plain vanilla Haskell. As you point out, it is not clear what its type should even be. It is possible with Template Haskell metaprogramming (not too pleasant). If you go that route, you should probably just use a generics library which has already done the hard research for you. I believe it is also possible using type-level naturals and typeclasses, but unfortunately such type-level solutions are usually difficult to abstract over. Conor McBride is working on that problem.
I think you can do it with OverlappingInstances hack:
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, OverlappingInstances #-}
import Test.QuickCheck
import Control.Applicative
class Arbitrable a b where
convert :: Gen a -> Gen b
instance (Arbitrary a, Arbitrable b c) => Arbitrable (a->b) c where
convert a = convert (a <*> arbitrary)
instance (a ~ b) => Arbitrable a b where
convert = id
-- Should work for any type with Arbitrary parameters
data MyType a b c d = MyType a b c d deriving (Show, Eq)
instance Arbitrary (MyType Char Int Double Bool) where
arbitrary = convert (pure MyType)
check = quickCheck ((\s -> s == s) :: (MyType Char Int Double Bool -> Bool))
Not satisfied with my other answer, I have come up with an awesomer one.
-- arb.hs
import Test.QuickCheck
import Control.Monad (liftM)
data SimpleType = SimpleType Int Char Bool String deriving(Show, Eq)
uncurry4 f (a,b,c,d) = f a b c d
instance Arbitrary SimpleType where
arbitrary = uncurry4 SimpleType `liftM` arbitrary
-- ^ this line is teh pwnzors.
-- Note how easily it can be adapted to other "simple" data types
ghci> :l arb.hs
[1 of 1] Compiling Main ( arb.hs, interpreted )
Ok, modules loaded: Main.
ghci> sample (arbitrary :: Gen SimpleType)
>>>a bunch of "Loading package" statements<<<
SimpleType 1 'B' False ""
SimpleType 0 '\n' True ""
SimpleType 0 '\186' False "\208! \227"
...
Lengthy explanation of how I figured this out
So here's how I got it. I was wondering, "well how is there already an Arbitrary instance for (Int, Int, Int, Int)? I'm sure no one wrote it, so it must be derived somehow. Sure enough, I found the following in the docs for instances of Arbitrary:
(Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (a, b, c, d)
Well, if they already have that defined, then why not abuse it? Simple types that are merely composed of smaller Arbitrary data types are not much different than just a tuple.
So now I need to somehow transform the "arbitrary" method for the 4-tuple so that it works for my type. Uncurrying is probably involved.
Stop. Hoogle time!
(We can easily define our own uncurry4, so assume we already have this to operate with.)
I have a generator, arbitrary :: Gen (q,r,s,t) (where q,r,s,t are all instances of Arbitrary). But let's just say it's arbitrary :: Gen a. In other words, a represents (q,r,s,t). I have a function, uncurry4, which has type (q -> r -> s -> t -> b) -> (q,r,s,t) -> b. We are obviously going to apply uncurry4 to our SimpleType constructor. So uncurry4 SimpleType has type (q,r,s,t) -> SimpleType. Let's keep the return value generic, though, because Hoogle doesn't know about our SimpleType. So remembering our definition of a, we have essentially uncurry4 SimpleType :: a -> b.
So I've got a Gen a and a function a -> b. And I want a Gen b result. (Remember, for our situation, a is (q,r,s,t) and b is SimpleType). So I am looking for a function with this type signature: Gen a -> (a -> b) -> Gen b. Hoogling that, and knowing that Gen is an instance of Monad, I immediately recognize liftM as the monadical-magical solution to my problems.
Hoogle saves the day again. I knew there was probably some "lifting" combinator to get the desired result, but I honestly didn't think to use liftM (durrr!) until I hoogled the type signature.
Here is what I'v got at least:
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module ApplyMany where
import Control.Applicative
import TypeLevel.NaturalNumber -- from type-level-natural-number package
class GetVal a where
getVal :: a
class Applicative f => ApplyMany n f g where
type Res n g
app :: n -> f g -> f (Res n g)
instance Applicative f => ApplyMany Zero f g where
type Res Zero g = g
app _ fg = fg
instance
(Applicative f, GetVal (f a), ApplyMany n f g)
=> ApplyMany (SuccessorTo n) f (a -> g)
where
type Res (SuccessorTo n) (a -> g) = Res n g
app n fg = app (predecessorOf n) (fg<*>getVal)
Usage example:
import Test.QuickCheck
data MyType = MyType Char Int Bool deriving Show
instance Arbitrary a => GetVal (Gen a) where getVal = arbitrary
test3 = app n3 (pure MyType) :: Gen MyType
test2 = app n2 (pure MyType) :: Gen (Bool -> MyType)
test1 = app n1 (pure MyType) :: Gen (Int -> Bool -> MyType)
test0 = app n0 (pure MyType) :: Gen (Char -> Int -> Bool -> MyType)
Btw, I think this solution is not very useful in real world. Especially without local type-classes.
Check out liftA2 and liftA3. Also, you can easily write your own applyTwice or applyThrice methods like so:
applyTwice :: (a -> a -> b) -> a -> b
applyTwice f x = f x x
applyThrice :: (a -> a -> a -> b) -> a -> b
applyThrice f x = f x x x
There's no easy way I can see to get the generic applyMany you're asking for, but writing trivial helpers such as these is neither difficult nor uncommon.
[edit] So it turns out, you'd think something like this would work
liftA4 f a b c d = f <$> a <*> b <*> c <*> d
quadraApply f x = f x x x x
data MyType = MyType Int String Double Char
instance Arbitrary MyType where
arbitrary = (liftA4 MyType) `quadraApply` arbitrary
But it doesn't. (liftA4 MyType) has a type signature of (Applicative f) => f Int -> f String -> f Double -> f Char -> f MyType. This is incompatible with the first parameter of quadraApply, which has a type signature of (a -> a -> a -> a -> b) -> a -> b. It would only work for data structures that hold multiple values of the same Arbitrary type.
data FourOf a = FourOf a a a a
instance (Arbitrary a) => Arbitrary (FourOf a) where
arbitrary = (liftA4 FourOf) `quadraApply` arbitrary
ghci> sample (arbitrary :: Gen (FourOf Int))
Of course you could just do this if you had that situation
ghci> :l +Control.Monad
ghci> let uncurry4 f (a, b, c, d) = f a b c d
ghci> samples <- sample (arbitrary :: Gen (Int, Int, Int, Int))
ghci> forM_ samples (print . uncurry4 FourOf)
There might be some language pragma that can shoehorn the "arbitrary" function into the more diverse data types. But that's currently beyond my level of Haskell-fu.
This is not possible with Haskell. The problem is, that your function will have a type, that depends on the numeric argument. With a type system that allows dependent types, that should be possible, but I guess not in Haskell.
What you can try is using polymorphism and tyeclasses to archieve this, but it could become hacky and you need a big bunch of extensions to satisfy the compiler.

Resources