I have two properties that a function foo must satisfy:
prop_1 :: [Int] -> Bool
prop_1 xs = foo xs id == xs
prop_2 :: [Int] -> (Int -> Int) -> (Int -> Int) -> Bool
prop_2 xs f g = foo (foo xs f) g == foo xs (g . f)
I am trying to check whether the above properties satisfy the following function using quickCheck:
foo :: [a] -> (a -> b) -> [b]
foo xs f = []
When I tried running quickCheck with prop_2 I get the following error:
quickCheck(prop_2)
<interactive>:18:1: error:
No instance for (Show (Int -> Int))
arising from a use of 'quickCheck'
(maybe you haven't applied a function to enough arguments?)
In the expression: quickCheck (prop_2)
In an equation for 'it': it = quickCheck (prop_2)
I am not sure why I am getting this error and how I can resolve it. Any insights are appreciated.
You can use QuickCheck's support for generation of random shrinkable, showable functions by changing the property to
prop_2 :: [Int] -> Fun Int Int -> Fun Int Int -> Bool
prop_2 xs (Fn f) (Fn g) = foo (foo xs f) g == foo xs (g . f)
and then you'll see something more useful than <function> for counterexamples.
As the documentation on QuickCheck says:
However, before we can test such a property, we must see to it that function values can be printed (in case a counter-example is found). That is, function types must be instances of class Show. To arrange this, you must import module ShowFunctions into every module containing higher-order properties of this kind. If a counter-example is found, function values will be displayed as "<function>"
So you can fix this by importing a module like:
import Text.Show.Functions
prop_1 :: [Int] -> Bool
prop_1 xs = foo xs id == xs
prop_2 :: [Int] -> (Int -> Int) -> (Int -> Int) -> Bool
prop_2 xs f g = foo (foo xs f) g == foo xs (g . f)
I was trying to write a QuickCheck test for the identity
f $ y = f y
My initial plan was to write an arbitrary generator that returns functions & Integer, having the signature Gen (Int -> Int, Int)
and in the prop_DollerDoesNothing test that function application with / without the $ gives the same result.
This was my code:
prop_DollarDoesNothing :: Property
prop_DollarDoesNothing =
forAll arbitraryFuncInt (\(f, y) -> (f $ y) == (f y))
arbitraryFuncInt :: Gen (Int -> Int, Int)
arbitraryFuncInt = do
f <- elements [(\x -> x*2), (\x -> x+3), (\x -> x-2)]
y <- arbitrary :: Gen Int
return (f, y)
And it generated the following helpful error message:
* No instance for (Show (Int -> Int))
arising from a use of `forAll'
(maybe you haven't applied a function to enough arguments?)
* In the expression:
forAll arbitraryFuncInt (\ (f, y) -> (f $ y) == (f y))
In an equation for `prop_DollarDoesNothing':
prop_DollarDoesNothing
= forAll arbitraryFuncInt (\ (f, y) -> (f $ y) == (f y))
So, I fixed the error and got the test working by applying the arbitrary function and returning a pair of ints from arbitraryFuncInt
prop_DollarDoesNothing :: Property
prop_DollarDoesNothing =
forAll arbitraryFuncInt (\(x, y) -> x == y)
arbitraryFuncInt :: Gen (Int, Int)
arbitraryFuncInt = do
f <- elements [(\x -> x*2), (\x -> x+3), (\x -> x-2)]
y <- arbitrary :: Gen Int
return (f $ y, f y)
My questions are:
is it simply not possible to return arbitrary functions that aren't fully applied due to not having an instance for Show?
Can I write an instance for Show (Int -> Int) to make # 1 possible?
Can QuickCheck generate arbitrary functions given a type signature, for cases where I'm testing identities that are true for all functions (of a given type). Above, I specify the 3 test functions by hand, I'd like to automate that somehow, ideally something like this f <- arbitrary :: Gen (Int -> Int)
QuickCheck has support to generate, shrink and show functions, using the Fun type. CoArbitrary enables generation of functions. It is then converted to a (possibly infinite) trie-like structure, that can be inspected and shrunk to a finite value (because a test failure only depends on finitely many inputs), which can then be shown as a counterexample.
Concretely, you can write properties as function that take a Fun argument, which is a wrapper around (->) using the mechanism I described. Deconstruct it with the Fn pattern to get a function.
prop_dollarDoesNothing :: Property
prop_dollarDoesNothing = property $ \(Fn (f :: Int -> Int)) x ->
(f $ x) === f x
For more information
The QuickCheck implementation: https://hackage.haskell.org/package/QuickCheck-2.11.3/docs/Test-QuickCheck-Function.html
The paper "Shrinking and showing functions" by Koen Claessen, which appears to be paywalled, but his talk is online: https://www.youtube.com/watch?v=CH8UQJiv9Q4
Arbitrary can generate functions just fine (provided the arguments are instances of CoArbitrary), it's just the showing part that doesn't work. There's not really a good way to show a function.
This is a common problem, and therefore QuickCheck provides the Blind modifier. It basically fakes a Show instances for any type, not actually showing any information about the value. Of course this somewhat diminishes the debugging-usefulness of a failing test case, but there's not much that can done about this.
I was reading through the announcement of ClassyPrelude and got to here:
instance (b ~ c, CanFilterFunc b a) => CanFilter (b -> c) a where
filter = filterFunc
The writer then mentioned that this would not work:
instance (CanFilterFunc b a) => CanFilter (c -> c) a where
filter = filterFunc
Which makes sense to me, as c is completely unrelated to the constraint on the left.
However, what isn't mentioned in the article and what I don't understand is why this wouldn't work:
instance (CanFilterFunc b a) => CanFilter (b -> b) a where
filter = filterFunc
Could someone explain why this is different to the first mentioned definition? Perhaps a worked example of GHC type inference would be helpful?
Michael already gives a good explanation in his blog article, but I'll try to illustrate it with a (contrived, but relatively small) example.
We need the following extensions:
{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
Let's define a class that is simpler than CanFilter, with just one parameter. I'm defining two copies of the class, because I want to demonstrate the difference in behaviour between the two instances:
class Twice1 f where
twice1 :: f -> f
class Twice2 f where
twice2 :: f -> f
Now, let's define an instance for each class. For Twice1, we fix the type variables to be the same directly, and for Twice2, we allow them to be different, but add an equality constraint.
instance Twice1 (a -> a) where
twice1 f = f . f
instance (a ~ b) => Twice2 (a -> b) where
twice2 f = f . f
In order to show the difference, let us define another overloaded function like this:
class Example a where
transform :: Int -> a
instance Example Int where
transform n = n + 1
instance Example Char where
transform _ = 'x'
Now we are at a point where we can see a difference. Once we define
apply1 x = twice1 transform x
apply2 x = twice2 transform x
and ask GHC for the inferred types, we get that
apply1 :: (Example a, Twice1 (Int -> a)) => Int -> a
apply2 :: Int -> Int
Why is that? Well, the instance for Twice1 only fires when source and target type of the function are the same. For transform and the given context, we don't know that. GHC will only apply an instance once the right hand side matches, so we are left with the unresolved context. If we try to say apply1 0, there will be a type error saying that there is still not enough information to resolve the overloading. We have to explicitly specify the result type to be Int in this case to get through.
However, in Twice2, the instance is for any function type. GHC will immediately resolve it (GHC never backtracks, so if an instance clearly matches, it's always chosen), and then try to establish the preconditions: in this case, the equality constraint, which then forces the result type to be Int and allows us to resolve the Example constraint, too. We can say apply2 0 without further type annotations.
So this is a rather subtle point about GHC's instance resolution, and the equality constraint here helps GHC's type checker along in a way that requires fewer type annotations by the user.
to complete the #kosmikus answer
same applies to purescript - you need equality constraint to derive type properly (you can try here http://try.purescript.org)
module Main where
import Prelude
-- copied from https://github.com/purescript/purescript-type-equality/blob/master/src/Type/Equality.purs
class TypeEquals a b | a -> b, b -> a where
to :: a -> b
from :: b -> a
instance refl :: TypeEquals a a where
to a = a
from a = a
-----------------
class Twice1 f where
twice1 :: f -> f
class Twice2 f where
twice2 :: f -> f
instance mytwice1 :: Twice1 (a -> a) where
twice1 f = f >>> f
instance mytwice2 :: TypeEquals a b => Twice2 (a -> b) where
twice2 f = f >>> from >>> f
class Example a where
transform :: Int -> a
instance exampleInt :: Example Int where
transform n = n + 1
instance exampleChar :: Example Char where
transform _ = 'x'
{--
-- will raise error
-- No type class instance was found for Main.Twice1 (Int -> t1)
apply1 x = twice1 transform x
-- to resolve error add type declaration
apply1 :: Int -> Int
--}
-- compiles without error and manual type declaration, has type Int -> Int automatically
apply2 x = twice2 transform x
But in idris you don't
module Main
import Prelude
interface Twice f where
twice : f -> f
Twice (a -> a) where
twice f = f . f
interface Example a where
transform : Int -> a
Example Int where
transform n = n + 1
Example Char where
transform _ = 'x'
-- run in REPL to see that it derives properly:
-- $ idris src/15_EqualityConstraint_Twice_class.idr
-- *src/15_EqualityConstraint_Twice_class> :t twice transform
-- twice transform : Int -> Int
-- Summary:
-- in idris you dont need equality constaint to derive type of such functions properly
I was reading through the announcement of ClassyPrelude and got to here:
instance (b ~ c, CanFilterFunc b a) => CanFilter (b -> c) a where
filter = filterFunc
The writer then mentioned that this would not work:
instance (CanFilterFunc b a) => CanFilter (c -> c) a where
filter = filterFunc
Which makes sense to me, as c is completely unrelated to the constraint on the left.
However, what isn't mentioned in the article and what I don't understand is why this wouldn't work:
instance (CanFilterFunc b a) => CanFilter (b -> b) a where
filter = filterFunc
Could someone explain why this is different to the first mentioned definition? Perhaps a worked example of GHC type inference would be helpful?
Michael already gives a good explanation in his blog article, but I'll try to illustrate it with a (contrived, but relatively small) example.
We need the following extensions:
{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
Let's define a class that is simpler than CanFilter, with just one parameter. I'm defining two copies of the class, because I want to demonstrate the difference in behaviour between the two instances:
class Twice1 f where
twice1 :: f -> f
class Twice2 f where
twice2 :: f -> f
Now, let's define an instance for each class. For Twice1, we fix the type variables to be the same directly, and for Twice2, we allow them to be different, but add an equality constraint.
instance Twice1 (a -> a) where
twice1 f = f . f
instance (a ~ b) => Twice2 (a -> b) where
twice2 f = f . f
In order to show the difference, let us define another overloaded function like this:
class Example a where
transform :: Int -> a
instance Example Int where
transform n = n + 1
instance Example Char where
transform _ = 'x'
Now we are at a point where we can see a difference. Once we define
apply1 x = twice1 transform x
apply2 x = twice2 transform x
and ask GHC for the inferred types, we get that
apply1 :: (Example a, Twice1 (Int -> a)) => Int -> a
apply2 :: Int -> Int
Why is that? Well, the instance for Twice1 only fires when source and target type of the function are the same. For transform and the given context, we don't know that. GHC will only apply an instance once the right hand side matches, so we are left with the unresolved context. If we try to say apply1 0, there will be a type error saying that there is still not enough information to resolve the overloading. We have to explicitly specify the result type to be Int in this case to get through.
However, in Twice2, the instance is for any function type. GHC will immediately resolve it (GHC never backtracks, so if an instance clearly matches, it's always chosen), and then try to establish the preconditions: in this case, the equality constraint, which then forces the result type to be Int and allows us to resolve the Example constraint, too. We can say apply2 0 without further type annotations.
So this is a rather subtle point about GHC's instance resolution, and the equality constraint here helps GHC's type checker along in a way that requires fewer type annotations by the user.
to complete the #kosmikus answer
same applies to purescript - you need equality constraint to derive type properly (you can try here http://try.purescript.org)
module Main where
import Prelude
-- copied from https://github.com/purescript/purescript-type-equality/blob/master/src/Type/Equality.purs
class TypeEquals a b | a -> b, b -> a where
to :: a -> b
from :: b -> a
instance refl :: TypeEquals a a where
to a = a
from a = a
-----------------
class Twice1 f where
twice1 :: f -> f
class Twice2 f where
twice2 :: f -> f
instance mytwice1 :: Twice1 (a -> a) where
twice1 f = f >>> f
instance mytwice2 :: TypeEquals a b => Twice2 (a -> b) where
twice2 f = f >>> from >>> f
class Example a where
transform :: Int -> a
instance exampleInt :: Example Int where
transform n = n + 1
instance exampleChar :: Example Char where
transform _ = 'x'
{--
-- will raise error
-- No type class instance was found for Main.Twice1 (Int -> t1)
apply1 x = twice1 transform x
-- to resolve error add type declaration
apply1 :: Int -> Int
--}
-- compiles without error and manual type declaration, has type Int -> Int automatically
apply2 x = twice2 transform x
But in idris you don't
module Main
import Prelude
interface Twice f where
twice : f -> f
Twice (a -> a) where
twice f = f . f
interface Example a where
transform : Int -> a
Example Int where
transform n = n + 1
Example Char where
transform _ = 'x'
-- run in REPL to see that it derives properly:
-- $ idris src/15_EqualityConstraint_Twice_class.idr
-- *src/15_EqualityConstraint_Twice_class> :t twice transform
-- twice transform : Int -> Int
-- Summary:
-- in idris you dont need equality constaint to derive type of such functions properly
Is it possible to have a function that takes a foreign function call where some of the foreign function's arguments are CString and return a function that accepts String instead?
Here's an example of what I'm looking for:
foreign_func_1 :: (CDouble -> CString -> IO())
foreign_func_2 :: (CDouble -> CDouble -> CString -> IO ())
externalFunc1 :: (Double -> String -> IO())
externalFunc1 = myFunc foreign_func_1
externalFunc2 :: (Double -> Double -> String -> IO())
externalFunc2 = myFunc foreign_func_2
I figured out how to do this with the C numeric types. However, I can't figure out a way to do it that can allow string conversion.
The problem seems to be fitting in IO functions, since everything that converts to CStrings such as newCString or withCString are IO.
Here is what the code looks like to just handle converting doubles.
class CConvertable interiorArgs exteriorArgs where
convertArgs :: (Ptr OtherIrrelevantType -> interiorArgs) -> exteriorArgs
instance CConvertable (IO ()) (Ptr OtherIrrelevantType -> IO ()) where
convertArgs = doSomeOtherThingsThatArentCausingProblems
instance (Real b, Fractional a, CConvertable intArgs extArgs) => CConvertable (a->intArgs) (b->extArgs) where
convertArgs op x= convertArgs (\ctx -> op ctx (realToFrac x))
Is it possible to have a function that takes a foreign function call where some of the foreign function's arguments are CString and return a function that accepts String instead?
Is it possible, you ask?
<lambdabot> The answer is: Yes! Haskell can do that.
Ok. Good thing we got that cleared up.
Warming up with a few tedious formalities:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
Ah, it's not so bad though. Look, ma, no overlaps!
The problem seems to be fitting in IO functions, since everything that converts to CStrings such as newCString or withCString are IO.
Right. The thing to observe here is that there are two somewhat interrelated matters with which to concern ourselves: A correspondence between two types, allowing conversions; and any extra context introduced by performing a conversion. To deal with this fully, we'll make both parts explicit and shuffle them around appropriately. We also need to take heed of variance; lifting an entire function requires working with types in both covariant and contravariant position, so we'll need conversions going in both directions.
Now, given a function we wish to translate, the plan goes something like this:
Convert the function's argument, receiving a new type and some context.
Defer the context onto the function's result, to get the argument how we want it.
Collapse redundant contexts where possible
Recursively translate the function's result, to deal with multi-argument functions
Well, that doesn't sound too difficult. First, explicit contexts:
class (Functor f, Cxt t ~ f) => Context (f :: * -> *) t where
type Collapse t :: *
type Cxt t :: * -> *
collapse :: t -> Collapse t
This says we have a context f, and some type t with that context. The Cxt type function extracts the plain context from t, and Collapse tries to combine contexts if possible. The collapse function lets us use the result of the type function.
For now, we have pure contexts, and IO:
newtype PureCxt a = PureCxt { unwrapPure :: a }
instance Context IO (IO (PureCxt a)) where
type Collapse (IO (PureCxt a)) = IO a
type Cxt (IO (PureCxt a)) = IO
collapse = fmap unwrapPure
{- more instances here... -}
Simple enough. Handling various combinations of contexts is a bit tedious, but the instances are obvious and easy to write.
We'll also need a way to determine the context given a type to convert. Currently the context is the same going in either direction, but it's certainly conceivable for it to be otherwise, so I've treated them separately. Thus, we have two type families, supplying the new outermost context for an import/export conversion:
type family ExpCxt int :: * -> *
type family ImpCxt ext :: * -> *
Some example instances:
type instance ExpCxt () = PureCxt
type instance ImpCxt () = PureCxt
type instance ExpCxt String = IO
type instance ImpCxt CString = IO
Next up, converting individual types. We'll worry about recursion later. Time for another type class:
class (Foreign int ~ ext, Native ext ~ int) => Convert ext int where
type Foreign int :: *
type Native ext :: *
toForeign :: int -> ExpCxt int ext
toNative :: ext -> ImpCxt ext int
This says that two types ext and int are uniquely convertible to each other. I realize that it might not be desirable to always have only one mapping for each type, but I didn't feel like complicating things further (at least, not right now).
As noted, I've also put off handling recursive conversions here; probably they could be combined, but I felt it would be clearer this way. Non-recursive conversions have simple, well-defined mappings that introduce a corresponding context, while recursive conversions need to propagate and merge contexts and deal with distinguishing recursive steps from the base case.
Oh, and you may have noticed by now the funny wiggly tilde business going on up there in the class contexts. That indicates a constraint that the two types must be equal; in this case it ties each type function to the opposite type parameter, which gives the bidirectional nature mentioned above. Er, you probably want to have a fairly recent GHC, though. On older GHCs, this would need functional dependencies instead, and would be written as something like class Convert ext int | ext -> int, int -> ext.
The term-level conversion functions are pretty simple--note the type function application in their result; application is left-associative as always, so that's just applying the context from the earlier type families. Also note the cross-over in names, in that the export context comes from a lookup using the native type.
So, we can convert types that don't need IO:
instance Convert CDouble Double where
type Foreign Double = CDouble
type Native CDouble = Double
toForeign = pure . realToFrac
toNative = pure . realToFrac
...as well as types that do:
instance Convert CString String where
type Foreign String = CString
type Native CString = String
toForeign = newCString
toNative = peekCString
Now to strike at the heart of the matter, and translate whole functions recursively. It should come as no surprise that I've introduced yet another type class. Actually, two, as I've separated import/export conversions this time.
class FFImport ext where
type Import ext :: *
ffImport :: ext -> Import ext
class FFExport int where
type Export int :: *
ffExport :: int -> Export int
Nothing interesting here. You may be noticing a common pattern by now--we're doing roughly equal amounts of computing at both the term and type level, and we're doing them in tandem, even to the point of mimicking names and expression structure. This is pretty common if you're doing type-level calculation for things involving real values, since GHC gets fussy if it doesn't understand what you're doing. Lining things up like this reduces headaches significantly.
Anyway, for each of these classes, we need one instance for each possible base case, and one for the recursive case. Alas, we can't easily have a generic base case, due to the usual bothersome nonsense with overlapping. It could be done using fundeps and type equality conditionals, but... ugh. Maybe later. Another option would be to parameterize the conversion function by a type-level number giving the desired conversion depth, which has the downside of being less automatic, but gains some benefit from being explicit as well, such as being less likely to stumble on polymorphic or ambiguous types.
For now, I'm going to assume that every function ends with something in IO, since IO a is distinguishable from a -> b without overlap.
First, the base case:
instance ( Context IO (IO (ImpCxt a (Native a)))
, Convert a (Native a)
) => FFImport (IO a) where
type Import (IO a) = Collapse (IO (ImpCxt a (Native a)))
ffImport x = collapse $ toNative <$> x
The constraints here assert a specific context using a known instance, and that we have some base type with a conversion. Again, note the parallel structure shared by the type function Import and term function ffImport. The actual idea here should be pretty obvious--we map the conversion function over IO, creating a nested context of some sort, then use Collapse/collapse to clean up afterwards.
The recursive case is similar, but more elaborate:
instance ( FFImport b, Convert a (Native a)
, Context (ExpCxt (Native a)) (ExpCxt (Native a) (Import b))
) => FFImport (a -> b) where
type Import (a -> b) = Native a -> Collapse (ExpCxt (Native a) (Import b))
ffImport f x = collapse $ ffImport . f <$> toForeign x
We've added an FFImport constraint for the recursive call, and the context wrangling has gotten more awkward because we don't know exactly what it is, merely specifying enough to make sure we can deal with it. Note also the contravariance here, in that we're converting the function to native types, but converting the argument to a foreign type. Other than that, it's still pretty simple.
Now, I've left out some instances at this point, but everything else follows the same patterns as the above, so let's just skip to the end and scope out the goods. Some imaginary foreign functions:
foreign_1 :: (CDouble -> CString -> CString -> IO ())
foreign_1 = undefined
foreign_2 :: (CDouble -> SizedArray a -> IO CString)
foreign_2 = undefined
And conversions:
imported1 = ffImport foreign_1
imported2 = ffImport foreign_2
What, no type signatures? Did it work?
> :t imported1
imported1 :: Double -> String -> [Char] -> IO ()
> :t imported2
imported2 :: Foreign.Storable.Storable a => Double -> AsArray a -> IO [Char]
Yep, that's the inferred type. Ah, that's what I like to see.
Edit: For anyone who wants to try this out, I've taken the full code for the demonstration here, cleaned it up a bit, and uploaded it to github.
This can be done with template haskell. In many ways it is simpler than the
alternatives involving classes, since it is easier pattern match on
Language.Haskell.TH.Type than do the same thing with instances.
{-# LANGUAGE TemplateHaskell #-}
-- test.hs
import FFiImport
import Foreign.C
foreign_1 :: CDouble -> CString -> CString -> IO CString
foreign_2 :: CDouble -> CString -> CString -> IO (Int,CString)
foreign_3 :: CString -> IO ()
foreign_1 = undefined; foreign_2 = undefined; foreign_3 = undefined
fmap concat (mapM ffimport ['foreign_1, 'foreign_2, 'foreign_3])
Inferred types of the generated functions are:
imported_foreign_1 :: Double -> String -> String -> IO String
imported_foreign_2 :: Double -> String -> String -> IO (Int, String)
imported_foreign_3 :: String -> IO ()
Checking the generated code by loading test.hs with -ddump-splices (note that
ghc still seems to miss some parentheses in the pretty printing) shows that
foreign_2 writes a definition which after some prettying up looks like:
imported_foreign_2 w x y
= (\ (a, b) -> ((return (,) `ap` return a) `ap` peekCString b) =<<
join
(((return foreign_2 `ap`
(return . (realToFrac :: Double -> CDouble)) w) `ap`
newCString x) `ap`
newCString y))
or translated to do notation:
imported_foreign_2 w x y = do
w2 <- return . (realToFrac :: Double -> CDouble) w
x2 <- newCString x
y2 <- newCString y
(a,b) <- foreign_2 w2 x2 y2
a2 <- return a
b2 <- peekCString b
return (a2,b2)
Generating code the first way is simpler in that there are less variables to
track. While foldl ($) f [x,y,z] doesn't type check when it would mean
((f $ x) $ y $ z) = f x y z
it's acceptable in template haskell which involves only a handful of different
types.
Now for the actual implementation of those ideas:
{-# LANGUAGE TemplateHaskell #-}
-- FFiImport.hs
module FFiImport(ffimport) where
import Language.Haskell.TH; import Foreign.C; import Control.Monad
-- a couple utility definitions
-- args (a -> b -> c -> d) = [a,b,c]
args (AppT (AppT ArrowT x) y) = x : args y
args _ = []
-- result (a -> b -> c -> d) = d
result (AppT (AppT ArrowT _) y) = result y
result y = y
-- con (IO a) = IO
-- con (a,b,c,d) = TupleT 4
con (AppT x _) = con x
con x = x
-- conArgs (a,b,c,d) = [a,b,c,d]
-- conArgs (Either a b) = [a,b]
conArgs ty = go ty [] where
go (AppT x y) acc = go x (y:acc)
go _ acc = acc
The splice $(ffimport 'foreign_2) looks at the type of foreign_2 with reify to
decide on which functions to apply to the arguments or result.
-- Possibly useful to parameterize based on conv'
ffimport :: Name -> Q [Dec]
ffimport n = do
VarI _ ntype _ _ <- reify n
let ty :: [Type]
ty = args ntype
let -- these define conversions
-- (ffiType, (hsType -> IO ffiType, ffiType -> IO hsType))
conv' :: [(TypeQ, (ExpQ, ExpQ))]
conv' = [
([t| CString |], ([| newCString |],
[| peekCString |])),
([t| CDouble |], ([| return . (realToFrac :: Double -> CDouble) |],
[| return . (realToFrac :: CDouble -> Double) |]))
]
sequenceFst :: Monad m => [(m a, b)] -> m [(a,b)]
sequenceFst x = liftM (`zip` map snd x) (mapM fst x)
conv' <- sequenceFst conv'
-- now conv' :: [(Type, (ExpQ, ExpQ))]
Given conv' above, it's somewhat straightforward to apply those functions when
the types match. The back case would be shorter if converting components of
returned tuples wasn't important.
let conv :: Type -- ^ type of v
-> Name -- ^ variable to be converted
-> ExpQ
conv t v
| Just (to,from) <- lookup t conv' =
[| $to $(varE v) |]
| otherwise = [| return $(varE v) |]
-- | function to convert result types back, either
-- occuring as IO a, IO (a,b,c) (for any tuple size)
back :: ExpQ
back
| AppT _ rty <- result ntype,
TupleT n <- con rty,
n > 0, -- for whatever reason $(conE (tupleDataName 0))
-- doesn't work when it could just be $(conE '())
convTup <- map (maybe [| return |] snd .
flip lookup conv')
(conArgs rty)
= do
rs <- replicateM n (newName "r")
lamE [tupP (map varP rs)]
[| $(foldl (\f x -> [| $f `ap` $x |])
[| return $(conE (tupleDataName n)) |]
(zipWith (\c r -> [| $c $(varE r)|]) convTup rs))
|]
| AppT _ nty <- result ntype,
Just (_,from) <- nty `lookup` conv' = from
| otherwise = [| return |]
Finally, put both parts together in a function definition:
vs <- replicateM (length ty) (newName "v")
liftM (:[]) $
funD (mkName $ "imported_"++nameBase n)
[clause
(map varP vs)
(normalB [| $back =<< join
$(foldl (\x y -> [| $x `ap` $y |])
[| return $(varE n) |]
(zipWith conv ty vs))
|])
[]]
Here's a horrible two typeclass solution. The first part (named, unhelpfully, foo) will take things of types like Double -> Double -> CString -> IO () and turn them into things like IO (Double -> IO (Double -> IO (String -> IO ()))). So each conversion is forced into IO just to keep things fully uniform.
The second part, (named cio for "collapse io) will take those things and shove all the IO bits to the end.
class Foo a b | a -> b where
foo :: a -> b
instance Foo (IO a) (IO a) where
foo = id
instance Foo a (IO b) => Foo (CString -> a) (IO (String -> IO b)) where
foo f = return $ \s -> withCString s $ \cs -> foo (f cs)
instance Foo a (IO b) => Foo (Double -> a) (IO (Double -> IO b)) where
foo f = return $ \s -> foo (f s)
class CIO a b | a -> b where
cio :: a -> b
instance CIO (IO ()) (IO ()) where
cio = id
instance CIO (IO b) c => CIO (IO (a -> IO b)) (a -> c) where
cio f = \a -> cio $ f >>= ($ a)
{-
*Main> let x = foo (undefined :: Double -> Double -> CString -> IO ())
*Main> :t x
x :: IO (Double -> IO (Double -> IO (String -> IO ())))
*Main> :t cio x
cio x :: Double -> Double -> String -> IO ()
-}
Aside from being a generally terrible thing to do, there are two specific limitations. The first is that a catchall instance of Foo can't be written. So for every type you want to convert, even if the conversion is just id, you need an instance of Foo. The second limitation is that a catchall base case of CIO can't be written because of the IO wrappers around everything. So this only works for things that return IO (). If you want it to work for something returning IO Int you need to add that instance too.
I suspect that with sufficient work and some typeCast trickery these limitations can be overcome. But the code is horrible enough as is, so I wouldn't recommend it.
It's definitely possible. The usual approach is to create lambdas to pass to withCString. Using your example:
myMarshaller :: (CDouble -> CString -> IO ()) -> CDouble -> String -> IO ()
myMarshaller func cdouble string = ...
withCString :: String -> (CString -> IO a) -> IO a
The inner function has type CString -> IO a, which is exactly the type after applying a CDouble to the C function func. You've got a CDouble in scope too, so that's everything you need.
myMarshaller func cdouble string =
withCString string (\cstring -> func cdouble cstring)