When is a generic function not generic? - haskell

I'm working on a Haskell server using scotty and persistent. Many handlers need access to the database connection pool, so I've taken to passing the pool around throughout the app, in this sort of fashion:
main = do
runNoLoggingT $ withSqlitePool ":memory:" 10 $ \pool ->
liftIO $ scotty 7000 (app pool)
app pool = do
get "/people" $ do
people <- liftIO $ runSqlPool getPeople pool
renderPeople people
get "/foods" $ do
food <- liftIO $ runSqlPool getFoods pool
renderFoods food
where getPeople and getFoods are appropriate persistent database actions that return [Person] and [Food] respectively.
The pattern of calling liftIO and runSqlPool on a pool becomes tiresome after a while - wouldn't it be great if I could refactor them into a single function, like Yesod's runDB, which would just take the query and return the appropriate type. My attempt at writing something like this is:
runDB' :: (MonadIO m) => ConnectionPool -> SqlPersistT IO a -> m a
runDB' pool q = liftIO $ runSqlPool q pool
Now, I can write this:
main = do
runNoLoggingT $ withSqlitePool ":memory:" 10 $ \pool ->
liftIO $ scotty 7000 $ app (runDB' pool)
app runDB = do
get "/people" $ do
people <- runDB getPeople
renderPeople people
get "/foods" $ do
food <- runDB getFoods
renderFoods food
Except that GHC complains:
Couldn't match type `Food' with `Person'
Expected type: persistent-2.1.1.4:Database.Persist.Sql.Types.SqlPersistT
IO
[persistent-2.1.1.4:Database.Persist.Class.PersistEntity.Entity
Person]
Actual type: persistent-2.1.1.4:Database.Persist.Sql.Types.SqlPersistT
IO
[persistent-2.1.1.4:Database.Persist.Class.PersistEntity.Entity
Food]
In the first argument of `runDB', namely `getFoods'
It seems like GHC is saying that in fact the type of runDB becomes specialised somehow. But then how are functions like runSqlPool defined? Its type signature looks similar to mine:
runSqlPool :: MonadBaseControl IO m => SqlPersistT m a -> Pool Connection -> m a
but it can be used with database queries that return many different types, as I was doing originally. I think there's something fundamental I'm misunderstanding about types here, but I have no idea how to find out what it is! Any help would be greatly appreciated.
EDIT:
at Yuras' suggestion, I've added this:
type DBRunner m a = (MonadIO m) => SqlPersistT IO a -> m a
runDB' :: ConnectionPool -> DBRunner m a
app :: forall a. DBRunner ActionM a -> ScottyM ()
which required -XRankNTypes for the typedef. However, the compiler error is still identical.
EDIT:
Victory to the commentors. This allows the code to compile:
app :: (forall a. DBRunner ActionM a) -> ScottyM ()
For which I'm grateful, but still mystified!
The code is currently looking like this and this.

It seems like GHC is saying that in fact the type of runDB becomes specialised somehow.
Your guess is right. Your original type was app :: (MonadIO m) => (SqlPersistT IO a -> m a) -> ScottyM (). This means that your runDB argument of type SqlPersistT IO a -> m a can be used at any one type a. However, the body of app wants to use the runDB argument at two different types (Person and Food) so instead we need to pass an argument that can work for any number of different types in the body. Thus app needs the type
app :: MonadIO m => (forall a. SqlPersistT IO a -> m a) -> ScottyM ()
(I would suggest keeping the MonadIO constraint outside the forall but you can also put it inside.)
EDIT:
What's going on behind the scenes is the following:
(F a -> G a) -> X means forall a. (F a -> G a) -> X, which means /\a -> (F a -> G a) -> X. /\ is the type-level lambda. That is, the caller gets to pass in a single type a and a function of type F a -> G a for that particular choice of a.
(forall a. F a -> G a) -> X means (/\a -> F a -> G a) -> X and the caller has to pass in a function which the callee can specialise to many choices of a.

Lets play the game:
Prelude> let f str = (read str, read str)
Prelude> f "1" :: (Int, Float)
(1,1.0)
Works as expected.
Prelude> let f str = (read1 str, read1 str) where read1 = read
Prelude> f "1" :: (Int, Float)
(1,1.0)
Works too.
Prelude> let f read1 str = (read1 str, read1 str)
Prelude> f read "1" :: (Int, Float)
<interactive>:21:1:
Couldn't match type ‘Int’ with ‘Float’
Expected type: (Int, Float)
Actual type: (Int, Int)
In the expression: f read "1" :: (Int, Float)
In an equation for ‘it’: it = f read "1" :: (Int, Float)
But this doesn't. What the difference?
The last f has the next type:
Prelude> :t f
f :: (t1 -> t) -> t1 -> (t, t)
So it doesn't work for clear reason, both elements of the tuple should have the same type.
The fix is like that:
Prelude> :set -XRankNTypes
Prelude> let f read1 str = (read1 str, read1 str); f :: (Read a1, Read a2) => (forall a . Read a => str -> a) -> str -> (a1, a2)
Prelude> f read "1" :: (Int, Float)
(1,1.0)
Unlikely I can come with good explanation of RankNTypes, so I'd not even try. There is enough resources in web.

To really answer the title question that apparently continues to mystify you: Haskell always chooses the most generic rank-1 type for a function, when you don't supply an explicit signature. So for app in the expression app (runDB' pool), GHC would attempt to have type
app :: DBRunner ActionM a -> ScottyM ()
which is in fact shorthand for
app :: forall a. ( DBRunner ActionM a -> ScottyM () )
This is rank-1 polymorphic, because all type variables are introduced outside of the signature (there is no quantification going on in the signature itself; the argument DBRunner ActionM a is in fact monomorphic since a is fixed at that point). Actually, it is the most generic type possible: it can work with a polymorphic argument like (runDB' pool), but would also be ok with monomorphic arguments.
But it turns out the implementation of app can't offer that generality: it needs a polymorphic action, otherwise it can't feed two different types of a values to that action. Therefore you need to manually request the more specific type
app :: (forall a. DBRunner ActionM a) -> ScottyM ()
which is rank-2, because it has a signature which contains a rank-1 polymorphic argument. GHC can't really know this is the type you want – there's no well defined “most general possible rank-n type” for an expression, since you can always push in extra quantifiers. So you must manually specify the rank-2 type.

Related

GHCi ignores type signature

Prelude> let myprint = putStrLn . show
Prelude> :t myprint
myprint :: () -> IO ()
OK, nothing too unusual here. Just GHCi type defaulting rules, I guess...
Prelude> let myprint = (putStrLn . show) :: Show x => x -> IO ()
Prelude> :t myprint
myprint :: () -> IO ()
What sorcery is this?? You're point-blank ignoring my type declaration?! O_O
Is there some way I can convince GHCi to do what I actually intended?
Adding a type annotation to an expression as in
e :: type
makes the compiler check that e has that type, as well as use that type to drive type variables instantiation and instance selection. However, if the type is polymorphic it can still be instantiated later on. Consider e.g.
(id :: a -> a) "hello"
Above, a will be instantiated to String, despite my annotation. Further,
foo :: Int -> Int
foo = (id :: a -> a)
will make a to be instantiated to Int later on. The above id annotation does not give any information to GHC: it already knows that id has that type.
We could remove it without affecting the type checking at all. That is, the expressions id and id :: a->a are not only dynamically equivalent, but also statically such.
Similarly, the expressions
putStrLn . show
and
(putStrLn . show) :: Show x => x -> IO ()
are statically equivalent: we are just annotating the code with the type GHC can infer. In other words, we are not providing any information to GHC it does not already know.
After the annotation is type checked, GHC can then instantiate x further. The monomorphism restriction does that in your example. To prevent that, use an annotation for the binding you are introducing, not for the expression:
myprint :: Show x => x -> IO ()
myprint = (putStrLn . show)
We can do the following, with monomorphism restriction on:
>let myprint :: Show x => x -> IO (); myprint = putStrLn . show
>:t myprint
myprint :: Show x => x -> IO ()
This is not the same as let myprint = putStrLn . show :: Show x => x -> IO (). In the former case we have a binding with a type signature, in the latter case we a have a let binding with a type annotation inside the right hand side. Monomorphism checks top-level type signatures, but not local annotations.

Monomorphism restriction in pattern bindings

{-# LANGUAGE NoMonomorphismRestriction #-}
module Try where
f :: IO (a -> IO String)
f = return $ const getLine
main :: IO ()
main = do
g <- f
:: IO (a -> IO String)
g "String" >>= print
g 5 >>= print
Even with the NoMonomorphismRestriction flag and explicit type signature, this module fails to compile with Couldn't match expected type ‘[Char]’ with actual type ‘Int’, despite g being fully polymorphic.
This is not what the monomorphism restriction means. The monomorphism restriction says that if a definition has no type signature and has a left-hand side with no parameters, it will be specialized to a monomorphic type (or rather just monomorphic enough to get rid of any class constraints). You have given type signatures so it doesn't apply.
The problem here is that you have given the wrong type to f.
f :: IO (a -> IO String)
actually means
f :: forall a. IO (a -> IO String)
That is, first pick a type a, then you can bind to get a monomorphic function of type a -> IO String for that a. There is no trouble with this program, for example:
main = do
g <- f
g "String" >>= print
g' <- f
g' 5 >>= print
But your usage example requires this type:
f :: IO (forall a. a -> IO String)
That is, you want to bind first and pick the type later, i.e. use the function at multiple types. This is called an "impredicative type" and unfortunately GHC has not supported them for quite a while, as far as I know.
The way to solve this problem is to make a newtype wrapper that explicitly quantifies the inner polymorphic type:
newtype R = R { getR :: forall a. a -> IO String }
f :: IO R
f = return $ R (const getLine)
main :: IO ()
main = do
g <- f
getR g "String" >>= print
getR g 5 >>= print

Why is there a nested IO monad, IO (IO ()), as the return value of my function?

Why does this function have the type:
deleteAllMp4sExcluding :: [Char] -> IO (IO ())
instead of deleteAllMp4sExcluding :: [Char] -> IO ()
Also, how could I rewrite this so that it would have a simpler definition?
Here is the function definition:
import System.FilePath.Glob
import qualified Data.String.Utils as S
deleteAllMp4sExcluding videoFileName =
let dirGlob = globDir [compile "*"] "."
f = filter (\s -> S.endswith ".mp4" s && (/=) videoFileName s) . head . fst
lst = f <$> dirGlob
in mapM_ removeFile <$> lst
<$> when applied to IOs has type (a -> b) -> IO a -> IO b. So since mapM_ removeFile has type [FilePath] -> IO (), b in this case is IO (), so the result type becomes IO (IO ()).
To avoid nesting like this, you should not use <$> when the function you're trying to apply produces an IO value. Rather you should use >>= or, if you don't want to change the order of the operands, =<<.
Riffing on sepp2k's answer, this is an excellent example to show the difference between Functor and Monad.
The standard Haskell definition of Monad goes something like this (simplified):
class Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
However, this is not the only way the class could have been defined. An alternative runs like this:
class Functor m => Monad m where
return :: a -> m a
join :: m (m a) -> m a
Given that, you can define >>= in terms of fmap and join:
(>>=) :: Monad m => m a -> (a -> m b) -> m b
ma >>= f = join (f <$> ma)
We'll look at this in a simplified sketch of the problem you're running into. What you're doing can be schematized like this:
ma :: IO a
f :: a -> IO b
f <$> ma :: IO (IO b)
Now you're stuck because you need an IO b, and the Functor class has no operation that will get you there from IO (IO b). The only way to get where you want is to dip into Monad, and the join operation is precisely what solves it:
join (f <$> ma) :: IO b
But by the join/<$> definition of >>=, this is the same as:
ma >>= f :: IO a
Note that the Control.Monad library comes with a version of join (written in terms of return and (>>=)); you could put that in your function to get the result you want. But the better thing to do is to recognize that what you're trying to do is fundamentally monadic, and thus that <$> is not the right tool for the job. You're feeding the result of one action to another; that intrinsically requires you to use Monad.

Compile error while generalizing function - complex error message

I had a function that runs in IO monad:
withDB :: (forall c. IConnection c => c -> IO b) -> IO b
withDB fn = bracket (connectSqlite3 "int/db.sqlite3") disconnect fn
And now I decided to generalize it to run in some MonadIO m. I did it following way, re-inventing bracket with my scope (do you know some from library?):
scope :: MonadIO m => m a -> (a -> m b) -> (a -> m c) -> m c
scope before after action = do
x <- before
r <- action x
_ <- after x
return r
withDB :: MonadIO m => (forall c. IConnection c => c -> m b) -> m b
withDB fn = liftIO $ scope
(liftIO $ connectSqlite3 "int/db.sqlite3")
(\x -> liftIO $ disconnect x) fn
I got the error:
Could not deduce (m ~ IO)
from the context (MonadIO m)
bound by the type signature for
withDB :: MonadIO m => (forall c. IConnection c => c -> m b) -> m b
at src\...
'm' is a rigid type variable bound by
the signature for
withDB :: MonadIO m => (forall c. IConnection c => c -> m b) -> m b
Expected type: IO b
Actual type: m b
In the third argument of 'scope' namely 'fn'
In the second argument of '($)', namely
'scope
(liftIO $ connectSqlite3 "int/db.sqlite3")
(\x -> liftIO $ disconnect x)
fn'
And now my questions:
What does mean m ~ IO? What first two lines of error say? Also, I saw this ~ construction in haskell code but can't find what is it. Extension? What is rigid type variable?
I found error and fixed it. It's enough to remove liftIO $ before scope. But it was just try-recompile cycle. Where in this error message told about the place of the error? I see something wrong with 'fn'. OK, I thought about it a bit and have a guess: GHC infers type from top to bottom. And it inferred from using liftIO that m should be IO but fn has general type m so it is error. Does any haskell compiler infers from top to bottom? And (more important) can I see types that GHC infers for sub expressions in output?
Thank you for reading this long question!
liftIO :: (MonadIO m) => IO a -> m a takes an IO action, so by saying liftIO $ scope ..., you're saying that scope ... must have the type IO b. That means that the arguments to scope must use the IO monad. Since your use of scope ensures that m must be IO, you can think of scope as having this type in context:
scope :: IO a -> (a -> IO b) -> (a -> IO c) -> IO b
Because of this, the liftIOs inside the scope call do nothing; they're merely converting from IO a to IO a, and you can't use fn, because it works in m, not IO. Removing the liftIO fixed it because it ran scope directly inside m, rather than running it in IO (impossible, because fn runs in m) and lifting that action into m.

Haskell Polyvariadic Function With IO

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)

Resources