I am still a newbie to Haskell and I think I am over my head right now. I have code that looks like the following.
data World = World {
intStack :: [Int],
boolStack :: [Bool]
} deriving Show
instance IntStack World where
getIntStack = intStack
putIntStack ints (World _ bools) = World ints bools
instance BoolStack World where
getBoolStack = boolStack
putBoolStack bools (World ints _) = World ints bools
class IntStack a where
getIntStack :: a -> [Int]
putIntStack :: [Int] -> a -> a
class BoolStack a where
getBoolStack :: a -> [Bool]
putBoolStack :: [Bool] -> a -> a
(<=>) :: (IntStack c, BoolStack c) => c -> c
(<=>) w = putIntStack xs . putBoolStack ((x == x'):bs) $ w
where (x:x':xs) = getIntStack w
bs = getBoolStack w
(<+>) :: (IntStack c) => c -> c
(<+>) w = putIntStack ((x+x'):xs) w
where (x:x':xs) = getIntStack w
My focus (For now ignoring error cases in the functions) is being able to chain together functions like (<=>) and (<+>) assuming that the underlying data type implements the function's required interfaces.
I feel like I can clean this up a lot with a state monad, but I am not sure how to structure it to allow changes to whatever data type that implements IntStack, BoolStack, etc..
I know that this is a horribly vague description, but I feel like the code I have above is probably the absolutely wrong way to go about it.
Thanks for any feedback!
class IntStack a where
getIntStack :: a -> [Int]
putIntStack :: [Int] -> a -> a
class BoolStack a where
getBoolStack :: a -> [Bool]
putBoolStack :: [Bool] -> a -> a
Congratulations, you've just invented lenses! Abstract the [Int] and [Bool] types, and use data instead of class, and you get something like
data Lens a b = Lens
{ get :: a -> b
, put :: b -> a -> a
}
...which is implemented in half a dozen packages on Hackage. Most offer at least:
the ability to derive projection lenses like your getIntStack/putIntStack and getBoolStack/putBoolStack directly from a data declaration
horizontal composition (running first one lens, then a second lens -- e.g. first picking a World out of some larger structure, then picking the intStack out of the World) and vertical composition (running two lenses in parallel, each on one side of a pair)
some interface with State and StateT (e.g. something of type Lens a b -> State b r -> State a r), which would let you write computations on a [Bool] or [Int] and run them as if they were computations on a World
So, check out hackage! There's the data-lens family, which includes a core, the deriving ability, and the stateful interface; the lens package; and the pointless-lenses package. There are probably some I forgot, too.
You could implement push and pop operations in the state monad, and use them to implement your functions:
popInt :: IntStack c => State c Int
popInt = do
(x:xs) <- getIntStack <$> get
modify $ putIntStack xs
return x
pushInt :: IntStack c => Int -> State c ()
pushInt x = do
xs <- getIntStack <$> get
modify $ putIntStack (x:xs)
(<+>) :: IntStack c => State c ()
(<+>) = do
x <- popInt
x' <- popInt
pushInt (x + x')
Related
I have a bunch of data structures like data Foo = Foo {a :: Type1, b :: Type2} deriving (Something) with Type1 and Type2 being always different (generally primitive types but it's irrelevant) and in different numbers.
I came to have a bunch of functions like
justFooify :: Maybe Type1 -> Maybe Type2 -> Maybe Foo
justFooify f b =
| isNothing f = Nothing
| isNothing b = Nothing
| otherwise = Just $ Foo (fromJust f) (fromJust b)
Is there something I'm missing? After the third such function I wrote I came to think that maybe it could be too much.
You need applicatives!
import Control.Applicative
justFooify :: Maybe Type1 -> Maybe Type2 -> Maybe Foo
justFooify f b = Foo <$> f <*> b
Or you can use liftA2 in this example:
justFooify = liftA2 Foo
It acts like liftM2, but for Applicative. If you have more parameters, just use more <*>s:
data Test = Test String Int Double String deriving (Eq, Show)
buildTest :: Maybe String -> Maybe Int -> Maybe Double -> Maybe String -> Maybe Test
buildTest s1 i d s2 = Test <$> s1 <*> i <*> d <*> s2
What are Applicatives? They're basically a more powerful Functor and a less powerful Monad, they fall right in between. The definition of the typeclass is
class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
-- plus a few more things that aren't important right now
If your Applicative is also a Monad, then pure is the same as return (in fact, some people feel that having return is incorrect, we should only have pure). The <*> operator is what makes them more powerful than Functors, though. It gives you a way to put a function in your data structure, then apply that function to values also wrapped in your data structure. So when you have something like
> :t Test -- Our construct
Test :: String -> Int -> Double -> String -> Test
> :t fmap Test -- also (Test <$>), since (<$>) = fmap
fmap Test :: Functor f => f String -> f (Int -> Double -> String -> Test)
We see that it constructs a function inside of a Functor, since Test takes multiple arguments. So Test <$> Just "a" has the type Maybe (Int -> Double -> String -> Test). With just Functor and fmap, we can't apply anything to the inside of that Maybe, but with <*> we can. Each application of <*> applies one argument to that inner Functor, which should now be considered an Applicative.
Another handy thing about it is that it works with all Monads (that currently define their Applicative instance). This means lists, IO, functions of one argument, Either e, parsers, and more. For example, if you were getting input from the user to build a Test:
askString :: IO String
askInt :: IO Int
askDouble :: IO Double
-- whatever you might put here to prompt for it, or maybe it's read from disk, etc
askForTest :: IO Test
askForTest = Test <$> askString <*> askInt <*> askDouble <*> askString
And it'd still work. This is the power of Applicatives.
FYI, in GHC 7.10 there will be implemented the Functor-Applicative-Monad Proposal. This will change the definition of Monad from
class Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
to
class Applicative m => Monad m where
return :: a -> m a
return = pure
(>>=) :: m a -> (a -> m b) -> m b
join :: m (m a) -> m a
(more or less). This will break some old code, but many people are excited for it as it will mean that all Monads are Applicatives and all Applicatives are Functors, and we'll have the full power of these algebraic objects at our disposal.
I would like to programmatically generate random Haskell functions and evaluate them. It seems to me that the only way to do this is to basically generate Haskell code programatically and run it using the GHC API or an external process, returning a string, and parsing it back into a Haskell data type. Is this true?
My reasoning is that as follows. The functions are polymorphic so I can't use Typeable. More importantly, even if I write my own type checker and annotate each function with its type, I can't prove to the Haskell compiler that my type checker is correct. For example, when I pull two functions out of a heterogenous collection of functions and apply one to the other, I need to provide the compiler with a guarantee that the function I'm using to choose these functions only chooses functions with corresponding types. But there is no way to do this, right?
DarkOtter's comment mentions QuickCheck's Arbitrary and CoArbitrary classes, which are certainly the first thing you should try. QuickCheck has this instance:
instance (CoArbitrary a, Arbitrary b) => Arbitrary (a -> b) where ...
As it happens, I was just yesterday reading the QuickCheck code to understand how this works, so I can just share what I learned while it's fresh in my mind. QuickCheck is built around a type that looks like this (and this won't be exactly the same):
type Size = Int
-- | A generator for random values of type #a#.
newtype Gen a =
MkGen { -- | Generate a random #a# using the given randomness source and
-- size.
unGen :: StdGen -> Size -> a
}
class Arbitrary a where
arbitrary :: a -> Gen a
The first trick is that QuickCheck has a function that works like this (and I didn't work out exactly how it's implemented):
-- | Use the given 'Int' to \"perturb\" the generator, i.e., to make a new
-- generator that produces different pseudorandom results than the original.
variant :: Int -> Gen a -> Gen a
Then they use this to implement various instances of this CoArbitrary class:
class CoArbitrary a where
-- | Use the given `a` to perturb some generator.
coarbitrary :: a -> Gen b -> Gen b
-- Example instance: we just treat each 'Bool' value as an 'Int' to perturb with.
instance CoArbitrary Bool where
coarbitrary False = variant 0
coarbitrary True = variant 1
Now with these pieces in place, we want this:
instance (Coarbitrary a, Arbitrary b) => Arbitrary (a -> b) where
arbitrary = ...
I won't write out the implementation, but the idea is this:
Using the CoArbitrary instance of a and the Arbitrary instance of b we can make the function \a -> coarbitrary a arbitrary, which has type a -> Gen b.
Remember that Gen b is a newtype for StdGen -> Size -> b, so the type a -> Gen b is isomorphic to a -> StdGen -> Size -> b.
We can trivially write a function that takes any function of that latter type and switches the argument order around to return a function of type StdGen -> Size -> a -> b.
This rearranged type is isomorphic to Gen (a -> b), so voilà, we pack the rearranged function into a Gen, and we got our random function generator!
I would recommend that you read the source of QuickCheck to see this for yourself. When you tackle that, you're only going to run into two extra details that might slow you down. First, the Haskell RandomGen class has this method:
-- | The split operation allows one to obtain two distinct random generators.
split :: RandomGen g => g -> (g, g)
This operation is used in the Monad instance for Gen, and is rather important. One of the tricks here is that the StdGen is a pure pseudo random number generator; the way Gen (a -> b) works is that for each possible value of a we perturb a b generator, use that perturbed generator to generate the b result, but then we never advance the perturbed generator's state; basically the generated a -> b function is a closure over a pseudo-random seed, and each time we call it with some a we use that specific a to deterministically create a new seed, and then use that to deterministically generate a b that depends on a and the hidden seed.
The abbreviated type Seed -> a -> b more or less sums up what's going on—a pseudo-random function is a rule for generating a b from a pseudo-random seed and an a. This won't work with imperative-style stateful random number generators.
Second: instead of directly having a (a -> StdGen -> Size -> b) -> StdGen -> Size -> a -> b function as I describe above, the QuickCheck code has promote :: Monad m => m (Gen a) -> Gen (m a), which is the generalization of that to any Monad. When m is the function instance of Monad, promote coincides with (a -> Gen b) -> Gen (a -> b), so it's really the same as I sketch above.
Thanks for the very thorough answers above! None of the responses, quite did what I was looking for though. I followed up on DarkOtter's suggestion in the comment the question, and used unsafeCoerce avoid the type checker. The basic idea is that we create a GADT that packages up Haskell functions with their types; the type system I use follows pretty closely Mark P. Jones' "Typing Haskell in Haskell." Whenever I want a collection of Haskell functions, I first coerce them into Any types, then I do what I need to do, stitching them together randomly. When I go to evaluate the new functions, first I coerce them back to the type I wanted. Of course, this isn't safe; if my type checker is wrong or I annotate the haskell functions with incorrect types, then I end up with nonsense.
I've pasted the code I tested this with below. Note that there are two local modules being imported Strappy.Type and Strappy.Utils. The first is the type system mentioned above. The second brings in helpers for the stochastic programs.
Note: in the code below I'm using the combinatory logic as the basic language. That's why my expression language only has application and no variables or lambda abstraction.
{-# Language GADTs, ScopedTypeVariables #-}
import Prelude hiding (flip)
import qualified Data.List as List
import Unsafe.Coerce (unsafeCoerce)
import GHC.Prim
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans
import Control.Monad.Identity
import Control.Monad.Random
import Strappy.Type
import Strappy.Utils (flip)
-- | Helper for turning a Haskell type to Any.
mkAny :: a -> Any
mkAny x = unsafeCoerce x
-- | Main data type. Holds primitive functions (Term), their
-- application (App) and annotations.
data Expr a where
Term :: {eName :: String,
eType :: Type,
eThing :: a} -> Expr a
App :: {eLeft :: (Expr (b -> a)),
eRight :: (Expr b),
eType :: Type} -> Expr a
-- | smart constructor for applications
a <> b = App a b (fst . runIdentity . runTI $ typeOfApp a b)
instance Show (Expr a) where
show Term{eName=s} = s
show App{eLeft=el, eRight=er} = "(" ++ show el ++ " " ++ show er ++ ")"
-- | Return the resulting type of an application. Run's type
-- unification.
typeOfApp :: Monad m => Expr a -> Expr b -> TypeInference m Type
typeOfApp e_left e_right
= do t <- newTVar Star
case mgu (eType e_left) (eType e_right ->- t) of
(Just sub) -> return $ toType (apply sub (eType e_left))
Nothing -> error $ "typeOfApp: cannot unify " ++
show e_left ++ ":: " ++ show (eType e_left)
++ " with " ++
show e_right ++ ":: " ++ show (eType e_right ->- t)
eval :: Expr a -> a
eval Term{eThing=f} = f
eval App{eLeft=el, eRight=er} = (eval el) (eval er)
filterExprsByType :: [Any] -> Type -> TypeInference [] Any
filterExprsByType (e:es) t
= do et <- freshInst (eType (unsafeCoerce e :: Expr a))
let e' = unsafeCoerce e :: Expr a
case mgu et t of
Just sub -> do let eOut = unsafeCoerce e'{eType = apply sub et} :: Any
return eOut `mplus` rest
Nothing -> rest
where rest = filterExprsByType es t
filterExprsByType [] t = lift []
----------------------------------------------------------------------
-- Library of functions
data Library = Library { probOfApp :: Double, -- ^ probability of an expansion
libFunctions :: [Any] }
cInt2Expr :: Int -> Expr Int
-- | Convert numbers to expressions.
cInt2Expr i = Term (show i) tInt i
-- Some basic library entires.
t = mkTVar 0
t1 = mkTVar 1
t2 = mkTVar 2
t3 = mkTVar 3
cI = Term "I" (t ->- t) id
cS = Term "S" (((t2 ->- t1 ->- t) ->- (t2 ->- t1) ->- t2 ->- t)) $ \f g x -> (f x) (g x)
cB = Term "B" ((t1 ->- t) ->- (t2 ->- t1) ->- t2 ->- t) $ \f g x -> f (g x)
cC = Term "C" ((t2 ->- t1 ->- t2 ->- t) ->- t1 ->- t2 ->- t) $ \f g x -> (f x) g x
cTimes :: Expr (Int -> Int -> Int)
cTimes = Term "*" (tInt ->- tInt ->- tInt) (*)
cPlus :: Expr (Int -> Int -> Int)
cPlus = Term "+" (tInt ->- tInt ->- tInt) (+)
cCons = Term ":" (t ->- TAp tList t ->- TAp tList t) (:)
cAppend = Term "++" (TAp tList t ->- TAp tList t ->- TAp tList t) (++)
cHead = Term "head" (TAp tList t ->- t) head
cMap = Term "map" ((t ->- t1) ->- TAp tList t ->- TAp tList t1) map
cEmpty = Term "[]" (TAp tList t) []
cSingle = Term "single" (t ->- TAp tList t) $ \x -> [x]
cRep = Term "rep" (tInt ->- t ->- TAp tList t) $ \n x -> take n (repeat x)
cFoldl = Term "foldl" ((t ->- t1 ->- t) ->- t ->- (TAp tList t1) ->- t) $ List.foldl'
cNums = [cInt2Expr i | i <- [1..10]]
-- A basic library
exprs :: [Any]
exprs = [mkAny cI,
mkAny cS,
mkAny cB,
mkAny cC,
mkAny cTimes,
mkAny cCons,
mkAny cEmpty,
mkAny cAppend,
-- mkAny cHead,
mkAny cMap,
mkAny cFoldl,
mkAny cSingle,
mkAny cRep
]
++ map mkAny cNums
library = Library 0.3 exprs
-- | Initializing a TypeInference monad with a Library. We need to
-- grab all type variables in the library and make sure that the type
-- variable counter in the state of the TypeInference monad is greater
-- that that counter.
initializeTI :: Monad m => Library -> TypeInference m ()
initializeTI Library{libFunctions=es} = do put (i + 1)
return ()
where go n (expr:rest) = let tvs = getTVars (unsafeCoerce expr :: Expr a)
getTVars expr = tv . eType $ expr
m = maximum $ map (readId . tyVarId) tvs
in if null tvs then 0 else go (max n m) rest
go n [] = n
i = go 0 es
----------------------------------------------------------------------
----------------------------------------------------------------------
-- Main functions.
sampleFromExprs :: (MonadPlus m, MonadRandom m) =>
Library -> Type -> TypeInference m (Expr a)
-- | Samples a combinator of type t from a stochastic grammar G.
sampleFromExprs lib#Library{probOfApp=prApp, libFunctions=exprs} tp
= do initializeTI lib
tp' <- freshInst tp
sample tp'
where sample tp = do
shouldExpand <- flip prApp
case shouldExpand of
True -> do t <- newTVar Star
(e_left :: Expr (b -> a)) <- unsafeCoerce $ sample (t ->- tp)
(e_right :: Expr b) <- unsafeCoerce $ sample (fromType (eType e_left))
return $ e_left <> e_right -- return application
False -> do let cs = map fst . runTI $ filterExprsByType exprs tp
guard (not . null $ cs)
i <- getRandomR (0, length cs - 1)
return $ unsafeCoerce (cs !! i)
----------------------------------------------------------------------
----------------------------------------------------------------------
main = replicateM 100 $
do let out = runTI $ do sampleFromExprs library (TAp tList tInt)
x <- catch (liftM (Just . fst) out)
(\_ -> putStrLn "error" >> return Nothing)
case x of
Just y -> putStrLn $ show x ++ " " ++ show (unsafeCoerce (eval y) :: [Int])
Nothing -> putStrLn ""
Would something along these lines meet your needs?
import Control.Monad.Random
randomFunction :: (RandomGen r, Random a, Num a, Floating a) => Rand r (a -> a)
randomFunction = do
(a:b:c:d:_) <- getRandoms
fromList [(\x -> a + b*x, 1), (\x -> a - c*x, 1), (\x -> sin (a*x), 1)]
-- Add more functions as needed
main = do
let f = evalRand randomFunction (mkStdGen 1) :: Double -> Double
putStrLn . show $ f 7.3
EDIT: Building on that idea, we could incorporate functions that have different numbers and types of parameters... as long as we partially apply them so that they all have the same result type.
import Control.Monad.Random
type Value = (Int, Double, String) -- add more as needed
type Function = Value -> String -- or whatever the result type is
f1 :: Int -> Int -> (Int, a, b) -> Int
f1 a b (x, _, _) = a*x + b
f2 :: String -> (a, b, String) -> String
f2 s (_, _, t) = s ++ t
f3 :: Double -> (a, Double, b) -> Double
f3 a (_, x, _) = sin (a*x)
randomFunction :: RandomGen r => Rand r Function
randomFunction = do
(a:b:c:d:_) <- getRandoms -- some integers
(w:x:y:z:_) <- getRandoms -- some floats
n <- getRandomR (0,100)
cs <- getRandoms -- some characters
let s = take n cs
fromList [(show . f1 a b, 1), (show . f2 s, 1), (show . f3 w, 1)]
-- Add more functions as needed
main = do
f <- evalRandIO randomFunction :: IO Function
g <- evalRandIO randomFunction :: IO Function
h <- evalRandIO randomFunction :: IO Function
putStrLn . show $ f (3, 7.3, "hello")
putStrLn . show $ g (3, 7.3, "hello")
putStrLn . show $ h (3, 7.3, "hello")
Is there some way to write a function f :: (a -> b -> ... -> t) -> (Monad m => m a -> m b -> ... -> m t), basically liftMn for any n?
(EDIT: fixed nonsensical example.)
I'm writing an FRP library, and thought it'd be neat if I could have code vaguely like:
main = do
input1 <- signalFromTextBoxTheUserMayTypeANumberInto
input2 <- signalFromAnotherTextBox
divided <- signal div input1 input2
signal (\x -> showTextAlert ("input1 `div` input2 is " ++ show x)) divided
I've been fiddling with type families to get it working, but I'm starting to think that it's actually not doable. I'm currently doing something like this:
type Action a = IORef a -> IO ()
type Listener = IO ()
newtype Signal a = Signal (IORef (SigData a))
data SigData a = SigData {
trigger :: Action a,
output :: IORef a,
listeners :: [Listener]
}
class Sig a where
type S a
mkSig :: [AnySignal] -> a -> S a
instance Sig b => Sig (a -> b) where
type S (a -> b) = Signal a -> S b
mkSig dependencies f =
\s#(Signal sig) ->
let x = unsafePerformIO $ readIORef sig >>= readIORef . output
in mkSig (AnySignal s : dependencies) (f x)
instance Sig Int where
type S Int = IO (Signal Int)
out <- newIORef x
self <- Signal <$> (newIORef $ SigData {
trigger = \ref -> writeIORef ref $! x,
output = out,
listeners = []
})
mapM_ (self `listensTo`) deps
return self
This obviously doesn't work, as the unsafePerformIO gets evaluated once and then keeps that value, and if did work it'd still be ugly, hacky and generally evil. Is there a way to do this, or will I just have to let go of the idea?
I'm kind of new to all of this, so forgive me if this is a silly answer, but isn't this exactly what applicative functors are for?
Applicatives let you do something like:
f :: a -> b -> ... -> c
f2 :: Applicative p => p a -> p b ... -> p c
f2 x ... y = f <$> x <*> ... <*> y
if I'm not mistaken. (The ellipses are any number of types/arguments)
How about the Strathclyde Haskell Environment preprocessor, which lets you use idiom brackets, the original notation for applicative functors? This lets you use (| f a b c |) for f <$> a <*> b <*> c. Your example would be (| input1 `div` input2 |).
By the way, it's probably a bad idea for your Signal type to have a Monad instance; this causes the well-known (in the FRP community) problem of time leaks; see this blog post for more information. An Applicative interface is OK, but a Monad interface is not. There are several solutions that prevent time leaks while still allowing the same dynamic event switching behaviour, involving things like an additional type parameter or another monad (as seen in, e.g. the sodium library).
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)
Is there a traditional way to map over a function that uses IO? Specifically, I'd like to map over a function that returns a random value of some kind. Using a normal map will result in an output of type ([IO b]), but to unpack the values in the list from IO, I need a something of type (IO [b]). So I wrote...
mapIO :: (a -> IO b) -> [a] -> [b] -> IO [b]
mapIO f [] acc = do return acc
mapIO f (x:xs) acc = do
new <- f x
mapIO f xs (new:acc)
... which works fine. But it seems like there ought to be a solution for this built into Haskell. For instance, an example use case:
getPercent :: Int -> IO Bool
getPercent x = do
y <- getStdRandom (randomR (1,100))
return $ y < x
mapIO (\f -> getPercent 50) [0..10] []
The standard way is via:
Control.Monad.mapM :: (Monad m) => (a -> m b) -> [a] -> m [b]
which is implemented in terms of sequence:
sequence :: (Monad m) => [m a] -> m [a]
Just to add to Don's answer, hake a look to the mapM_ function as well, which does exactly what mapM does but discards all the results so you get only side-effects.
This is useful if you want the have computations executed (for example IO computations) but are not interested in the result (for example, unlinking files).
And also see forM and forM_.