ok, here is a continuation of my previous question (Generically) Build Parsers from custom data types?. I took the advice and decided to build my parsers with generic-sop and all was going fine until now.
I need to expand my implementation a little bit so more complicated situations can be dealt with. Namely, consider these two data definitions, where B is built on top of A:
data A = A String Int
data B = B A Double
In order to generically parse all data structures, I define the following class:
class HasSimpleParser f where
getSimpleParser :: Parser f
class Parsable f where
getParser :: Parser f
class GenericallyParsable f where
getGenericParser :: Parser f
The primitive types such as Int, String, Double etc can be made into instances of HasSimpleParser easily. Then I make data structure such as A an instance of Parsable by doing
instance (Generic r, Code r ~ '[xs], All HasSimpleParser xs) => Parsable r where
getParser = to . SOP. Z <$> hsequence (hcpure (Proxy #HasSimpleParser) getSimpleParser)
I introduce the class GenericallyParsable to parse data structure like B. So I do the following:
instance (Generic r, Code r ~ '[xs], All Parsable xs) => GenericallyParsable r where
getGenericParser = to . SOP. Z <$> hsequence (hcpure (Proxy #Parsable) getParser)
The last pieces of the puzzle are the parsing functions:
parseA :: InputStream ByteString -> IO A
parseA = parseFromStream (getGenericParser #A)
parseB :: InputStream ByteString -> IO B
parseB = parseFromStream (getGenericParser #B)
However, the code won't compile and I got the following error:
• Couldn't match type ‘'['[Char, [Char]]]’ with ‘'[]’
arising from a use of ‘getGenericParser’
• In the first argument of ‘parseFromStream’, namely
‘(getGenericParser #A)’
In the expression: parseFromStream (getGenericParser #A)
In an equation for ‘parseA’:
parseA = parseFromStream (getGenericParser #A)
So how should I modify the code to work?
I think the GenericallyParsable typeclass is not necessary.
Just define a HasSimpleParser instance for A that piggybacks on Parsable:
instance HasSimpleParser A where
getSimpleParser = getParser
If you end up declaring many instances of this type for your records, you can streamline it a little using {-# language DefaultSignatures #-} and changing the definition of HasSimpleParser to
class HasSimpleParser c where
getSimpleParser :: Parser c
default getSimpleParser :: Parsable c => Parser c
getSimpleParser = getParser
Now in the record instances you would only have to write:
instance HasSimpleParser A
In fact, perhaps even the distinction between HasSimpleParser and Parsable in unnecessary. A single HasParser typeclass with instances for both basic and composite types would be enough. The default implementation would use generics-sop and require a (Generic r, Code r ~ '[xs], All HasParser xs) constraint.
class HasParser c where
getParser :: Parser c
default getParser :: (Generic c, Code c ~ '[xs], All HasParser xs) => Parser c
getParser = ...generics-sop code here...
Related
Background:
I am working on a declarative compiler. In this course, I am going to write a class to construct an intermediate data structure. After building the data structure, the output can be redendered from the data structure. To simplify for stackoverflow, I created the following code:
module Main where
import qualified Data.Word as W
import qualified Octetable as Oct
main :: IO ()
main =
do
print (buildNRender "123")
data MyData = MyData Integer
data Construction model = Contains model | Error String
deriving Show
class Builder g where
build :: String -> (Construction g)
render :: (Construction g) -> [W.Word8]
buildNRender :: String -> [W.Word8]
buildNRender = render . build
instance Builder MyData where
build s = Contains (MyData (read s :: Integer))
render (Contains (MyData n)) = Oct.toOctets n
render (Error _) = []
The obvious problem is, 'buildNRender' cannot be part of Builder, because type parameter g is not used at all.
Now, it seems obvious to me that a type class cannot work like this, where an intermediate value in a combination of two or more functions has a type parameter.
The following code makes the intermediate type explicit, and works - but without buildNRender.
...
main :: IO ()
main =
do
print (render ((build "123") :: (Construction MyData))
...
However, is there an elegant way to define such a DEFAULT method of a class (like 'buildNRender'), and to specify the intermediate type in the context of the caller, like in the following code?
...
main :: IO ()
main =
do
print ((buildNRender "123") :: ?(Construction MyData)?)
...
The obvious problem is, buildNRender cannot be part of Builder, because type parameter g is not used at all.
Well, that used to be a problem (concretely, the g would be ambiguous), but isn't anymore because GHC now has extensions that allow working with such parameters.
{-# LANGUAGE AllowAmbiguousTypes, TypeApplications, ScopedTypeVariables, UnicodeSyntax #-}
module Main where
import qualified Data.Word as W
import qualified Octetable as Oct
main :: IO ()
main =
do
print (buildNRender #MyData "123")
data MyData = MyData Integer
data Construction model = Contains model | Error String
deriving Show
class Builder g where
build :: String -> (Construction g)
render :: (Construction g) -> [W.Word8]
buildNRender :: ∀ g . Builder g => String -> [W.Word8]
-- ∀ (forall) g . introduces the type variable g into scope
-- needs extension AllowAmbiguousTypes
buildNRender = render . build #g -- #g is a Type Application
instance Builder MyData where
build s = Contains (MyData (read s :: Integer))
render (Contains (MyData n)) = Oct.toOctets n
render (Error _) = []
Alternatively, without UnicodeSyntax:
{-# LANGUAGE AllowAmbiguousTypes, TypeApplications, ScopedTypeVariables #-}
...
buildNRender :: forall g . Builder g => String -> [W.Word8]
AllowAmbiguousTypes and TypeApplications are definitely a good approach these days. If, however, you prefer to avoid them, you can use one of two classic techniques: proxy passing or newtype tags.
Proxy passing
It's easiest with ScopedTypeVariables:
class Builder g where
build :: String -> Construction g
render :: Construction g -> [W.Word8]
buildNRender :: proxy g -> String -> [W.Word8]
buildNRender _ = render . (build :: String -> Construction g)
The g type variable in the class header will scope over the body of the buildNRender default definition, and can be used within to resolve the ambiguity. For example,
buildNRender (Proxy :: Proxy MyData) "123"
The proxy argument passed to buildNRender can be any type whose last type argument represents the type you want. The canonical choice is defined in Data.Proxy:
data Proxy a = Proxy
If you want to avoid ScopedTypeVariables too, then you'll need some sort of helper function. For example, you could write
blub :: proxy g -> (String -> Construction g) -> String -> Construction g
blub _ = id
and then
buildNRender p = render . blub p build
If you need a lot of this sort of thing, you can define more general versions. blub's type, for example, could be rewritten with prefix notation:
blub :: proxy g -> (->) String (Construction g) -> (->) String (Construction g)
blub _ = id
This leads to a generalization,
blub :: proxy g -> f (c g) -> f (c g)
blub _ = id
which can be used in exactly the same way.
Newtype tagging
To avoid any possible runtime effects of proxy passing at the cost of substantial annoyance in handling, you can import Data.Tagged, which defines
newtype Tagged s b = Tagged {unTagged :: b}
-- It has a Functor instance
Now you can write (with ScopedTypeVariables)
buildNRender :: Tagged g (String -> [W.Word8])
buildNRender = Tagged (render . (build :: String -> Construction g))
Without ScopedTypeVariables, things are again trickier. One option would be
blurble :: f (c g) -> Tagged g (f (c g))
blurble = Tagged
buildNRender :: Tagged g (String -> [W.Word8])
buildNRender = (render .) <$> blurble build
Call could be:
unTagged (buildNRender :: Tg.Tagged MyData (String -> [W.Word8])) "123"
I'm using the syntactic library to make an AST. To evaluate the AST to a (Haskell) value, all of my nodes need to be an instance of the syntactic class EvalEnv:
class EvalEnv sym env where
compileSym :: proxy env -> sym sig -> DenotationM (Reader env) sig
Syntactic also provides a "default" implementation:
compileSymDefault :: (Eval sym, Signature sig)
=> proxy env -> sym sig -> DenotationM (Reader env) sig
but the constraint on sig is unreachable in instances of EvalEnv, making the following (say, overlapping) instance impossible:
instance EvalEnv sym env where
compileSym = compileSymDefault
All of my user-defined AST nodes are GADTs, usually with multiple constructors, where the a parameter always satisfies the constraint for compileSymDefault:
data ADDITIVE a where
Add :: (Num a) => ADDITIVE (a :-> a :-> Full a)
Sub :: (Num a) => ADDITIVE (a :-> a :-> Full a)
As a result, I found that all of my instances for EvalEnv look like:
instance EvalEnv ADDITIVE env where
compileSym p Add = compileSymDefault p Add
compileSym p Sub = compileSymDefault p Sub
This boilerplate instance is identical for all AST nodes, and each of the GADT constructors needs to be listed separately, as the GADT constructor signature implies the compileSymDefault constraints.
Is there any way I can avoid having to list out each constructor for every node type I make?
If I understand the issue correctly, the boilerplate arises from the need to use pattern matching against each constructor to bring the required context in scope. Apart from the constructor name, all the case branches are identical.
The code below uses a removeBoilerplate rank-2 function which can be used to bring the context in scope. Two example functions are first defined using boilerplate code and then converted to use the helper removeBoilerplate function.
If you have many GADTs, you will need a custom removeBoilerplate for each one. So this approach is beneficial if you need to remove the boilerplate more than once for each type.
I am not familiar with syntactic to be 100% sure this will work, but it looks it has good chances. You will probably need to adapt the type of the removeBoilerplate function a bit.
{-# LANGUAGE GADTs , ExplicitForAll , ScopedTypeVariables ,
FlexibleContexts , RankNTypes #-}
class Class a where
-- Random function requiring the class
requiresClass1 :: Class a => a -> String
requiresClass1 _ = "One!"
-- Another one
requiresClass2 :: Class a => a -> String
requiresClass2 _ = "Two!"
-- Our GADT, in which each constructor puts Class in scope
data GADT a where
Cons1 :: Class (GADT a) => GADT a
Cons2 :: Class (GADT a) => GADT a
Cons3 :: Class (GADT a) => GADT a
-- Boring boilerplate
boilerplateExample1 :: GADT a -> String
boilerplateExample1 x#Cons1 = requiresClass1 x
boilerplateExample1 x#Cons2 = requiresClass1 x
boilerplateExample1 x#Cons3 = requiresClass1 x
-- More boilerplate
boilerplateExample2 :: GADT a -> String
boilerplateExample2 x#Cons1 = requiresClass2 x
boilerplateExample2 x#Cons2 = requiresClass2 x
boilerplateExample2 x#Cons3 = requiresClass2 x
-- Scrapping Boilerplate: let's list the constructors only here, once for all
removeBoilerplate :: GADT a -> (forall b. Class b => b -> c) -> c
removeBoilerplate x#Cons1 f = f x
removeBoilerplate x#Cons2 f = f x
removeBoilerplate x#Cons3 f = f x
-- No more boilerplate!
niceBoilerplateExample1 :: GADT a -> String
niceBoilerplateExample1 x = removeBoilerplate x requiresClass1
niceBoilerplateExample2 :: GADT a -> String
niceBoilerplateExample2 x = removeBoilerplate x requiresClass2
You can't scrap your boilerplate, but you can reduce it slightly. Neither the scrap your boilerplate nor the newer GHC Generics code can derive instances for GADTs like yours. One could generate EvalEnv instances with template haskell, but I won't discuss that.
We can reduce the amount of boilerplate we are writing very slightly. The idea we are having trouble capturing is that forall a there is a Signature a instance for any ADDITIVE a. Let's make the class of things for which this is true.
class Signature1 f where
signatureDict :: f a -> Dict (Signature a)
Dict is a GADT that captures a constraint. Defining it requires {-# LANGUAGE ConstraintKinds #-}. Alternatively, you can import it from Data.Constraint in the constraints package.
data Dict c where
Dict :: c => Dict c
To use the constraint captured by the Dict constructor, we must pattern match against it. We can then write compileSym in terms of signatureDict and compileSymDefault.
compileSymSignature1 :: (Eval sym, Signature1 sym) =>
proxy env -> sym sig -> DenotationM (Reader env) sig
compileSymSignature1 p s =
case signatureDict s of
Dict -> compileSymDefault p s
Now we can write out ADDITIVE and its instances, capturing the idea that there is always a Signature a instance for any ADDITIVE a.
data ADDITIVE a where
Add :: (Num a) => ADDITIVE (a :-> a :-> Full a)
Sub :: (Num a) => ADDITIVE (a :-> a :-> Full a)
instance Eval ADDITIVE where
evalSym Add = (+)
evalSym Sub = (-)
instance Signature1 ADDITIVE where
signatureDict Add = Dict
signatureDict Sub = Dict
instance EvalEnv ADDITIVE env where
compileSym = compileSymSignature1
Writing out the Signature1 instance doesn't have much benefit over writing out the EvalEnv instance. The only benefits we have gained are that we have captured an idea that might be useful elsewhere and the Signature1 instance is slightly simpler to write.
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))
I want to generically create applicative constructors for haskell records in order to create a parser for the record.
Consider the record:
data Record = Record {i :: Int, f :: Float}
the constructor I want:
Record <$> pInt <*> pFloat
Parsers for basic types are given:
class Parseable a where
getParser :: Parser a
instance Parseable Int where
getParser = pInt
instance Parseable Float where
getParser = pFloat
Are there any libraries that can already do this? Is it maybe possible to define getParser for a record? Thanks in advance.
This can be done using, for instance, the regular library. Working with this library generally requires some language extensions:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
import Control.Applicative
import Generics.Regular
At least two of the most popular parser-combinator libraries come with an applicative-functor interface: see, for instance, uu-parsinglib and parsec, but to keep things easy, let's use simple list-of-successes parsers here.
newtype Parser a = Parser {runParser :: ReadS a}
instance Functor Parser where
fmap f p = Parser $ \s -> [(f x, s') | (x, s') <- runParser p s]
instance Applicative Parser where
pure x = Parser $ \s -> [(x, s)]
p <*> q = Parser $ \s ->
[(f x, s'') | (f, s') <- runParser p s, (x, s'') <- runParser q s']
instance Alternative Parser where
empty = Parser $ \_ -> []
p <|> q = Parser $ \s -> runParser p s ++ runParser q s
(Note that type ReadS a = String -> [(a, String)].)
pSym :: Char -> Parser Char
pSym c = Parser $ \s -> case s of
(c' : s') | c == c' -> [(c', s')]
_ -> []
pInt :: Parser Int
pInt = Parser reads
pFloat :: Parser Float
pFloat = Parser reads
Straightforwardly, we have:
class Parseable a where
getParser :: Parser a
instance Parseable Int where
getParser = pInt
instance Parseable Float where
getParser = pFloat
And, for your record type, as desired:
data Record = Record {i :: Int, f :: Float}
instance Parseable Record where
getParser = Record <$> pInt <* pSym ' ' <*> pFloat
Now, how do we generically generate such a parser?
First, we define the so-called pattern functor of Record (see the documentation of regular for details):
type instance PF Record = K Int :*: K Float
Then, we make Record an instance of the type class Regular:
instance Regular Record where
from (Record n r) = K n :*: K r
to (K n :*: K r) = Record n r
Next, we define a generic parser:
class ParseableF f where
getParserF :: Parser a -> Parser (f a)
instance ParseableF (K Int) where
getParserF _ = K <$> pInt
instance ParseableF (K Float) where
getParserF _ = K <$> pFloat
instance (ParseableF f, ParseableF g) => ParseableF (f :*: g) where
getParserF p = (:*:) <$> getParserF p <* pSym ' ' <*> getParserF p
(To cover all regular types, you will have to provide some more instances, but these will do for your example.)
Now, we can demonstrate that every type in the class Regular (given a ParseableF instance for its pattern functor) comes with a parser:
instance (Regular a, ParseableF (PF a)) => Parseable a where
getParser = to <$> getParserF getParser
Let's take it for a spin. Drop the original instances of Parseable (i.e., the ones for Int, Float, and of course Record) and only keep the single generic instance. Here we go:
> runParser (getParser :: Parser Record) "42 3.14"
[(Record {i = 42, f = 3.14},"")]
Note: this is just a very basic example of how to derive generic parsers using the regular library. The library itself comes with a generic list-of-successes parser that does particularly nice things with records. You may want to check that one out first. Moreover, the library comes with Template Haskell support so that instances of Regular can be derived automatically. These instances include special structure types for record labels, so that you can have your generic functions treat record types really fancy. Check out the docs.
As much as I like the regular package, I want to point out that since ghc-7.2 the GHC has built-in support for deriving generic representation types, so that you do not have to rely on Template Haskell to do that.
Changes compared to the solution suggested by dblhelix are the following. You need slightly different flags and modules imported:
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
import Control.Applicative
import GHC.Generics
You still define Parser and its instances as above.
You need to derive the class Generic for your Record type:
data Record = Record { i :: Int, f :: Float }
deriving (Generic, Show)
The class Generic is very similar to the class Regular. You don't have to define PF or an instance of Regular now.
Instead of ParseableF, we define a class Parseable' that's very similar in style, yet ever so slightly different:
class Parseable' f where
getParser' :: Parser (f a)
-- covers base types such as Int and Float:
instance Parseable a => Parseable' (K1 m a) where
getParser' = K1 <$> getParser
-- covers types with a sequence of fields (record types):
instance (Parseable' f, Parseable' g) => Parseable' (f :*: g) where
getParser' = (:*:) <$> getParser' <* pSym ' ' <*> getParser'
-- ignores meta-information such as constructor names or field labels:
instance Parseable' f => Parseable' (M1 m l f) where
getParser' = M1 <$> getParser'
Finally, for Parseable, we define a generic default method:
class Parseable a where
getParser :: Parser a
default getParser :: (Generic a, Parseable' (Rep a)) => Parser a
getParser = to <$> getParser'
instance Parseable Int where
getParser = pInt
instance Parseable Float where
getParser = pFloat
Now, making the Record type parseable is as simple as providing an empty instance declaration:
instance Parseable Record
The example works as previously:
> runParser (getParser :: Parser Record) "42 3.14"
[(Record {i = 42, f = 3.14},"")]
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.