Call a function inside a class without declaring an instance - haskell

I want to create a function in Haskell that does different things depending the data type it is given. I thought classes should do what I want, but now I ran into a problem. What I would like to be able to do is something similar to:
let x1 = myFunction :: MyInstance1
let x2 = myFunction :: MyInstance2
and it does different things depending on the given instance.
My current approach is
class MyClass a where
create :: Int -> a
doSomething :: a -> [Int]
myFunction :: [Int]
myFunction = doSomething $ create 4
instance MyClass MyInstance1 where
-- implementation of create and doSomething
instance MyClass MyInstance2 where
-- implementation of create and doSomething
However, the compiler tells me "The type variable a0 is ambiguous in the ambiguity check for 'myFunction'" and from what I've been reading this is related to the compiler not knowing what instance of 'doSomething' to call.
So is there a way to call 'doSomething' in a "generic" way and enforce the data type later? Or do I need an entirely different approach for my problem?
--- EDIT ---
So I applied chi's answer to my problem, but it does not solve it completely yet. Here's my code
{-# LANGUAGE AllowAmbiguousTypes #-}
class C a where
myFunction :: Int
create :: Int -> a
doSomething :: a -> Int
-- anotherFunction :: Int -> Int
-- anotherFunction x = doSomething $ create 4
instance C Int where
myFunction = 1
create x = 2 * x
doSomething x = x + 4
instance C Bool where
myFunction = 2
create x = True
doSomething x = if x then 42 else 24
This compiles and I in the prompt
create # Bool 4
create # Int 4
returns the expected results. However, anotherFunction does not compile properly giving the error message
Test.hs:8:23: error:
• Could not deduce (C a0) arising from a use of ‘doSomething’
from the context: C a
bound by the class declaration for ‘C’ at Test.hs:(3,1)-(8,44)
The type variable ‘a0’ is ambiguous
These potential instances exist:
instance C Bool -- Defined at Test.hs:15:10
instance C Int -- Defined at Test.hs:10:10
• In the expression: doSomething $ create 4
In an equation for ‘anotherFunction’:
anotherFunction x = doSomething $ create 4
Failed, modules loaded: none.
Is it simply not possible to use doSomething in this context? My idea is to implement the function in the same manner for all instances and then write
anotherFunction # Bool 4
anotherFunction # Int 6

You need a couple of extensions to do that, but it is doable. Here's a GHCi session showing that:
> :set -XAllowAmbiguousTypes
> class C a where myFunction :: Int
> instance C Int where myFunction = 1
> instance C Bool where myFunction = 2
> :set -XTypeApplications
> myFunction # Int
1
> myFunction # Bool
2
An "old" solution would be to add a proxy argument
class C a where myFunction :: proxy a -> Int
but hopefully this will fade out of style in a few years -- I find passing types explicitly clearer than passing proxies.
Full code, with another example:
{-# LANGUAGE AllowAmbiguousTypes, TypeApplications, ScopedTypeVariables #-}
class C a where
myFunction :: Int
create :: Int -> a
doSomething :: a -> Int
anotherFunction :: Int -> Int
anotherFunction x = doSomething $ create # a 4
instance C Int where
myFunction = 1
create x = 2 * x
doSomething x = x + 4
instance C Bool where
myFunction = 2
create x = True
doSomething x = if x then 42 else 24
Tests:
> :set -XTypeApplications
> anotherFunction # Bool 4
42
> anotherFunction # Int 6
12

Related

Type families: top level vs. associated

I am just starting to learn type families. The GHC documentation states that top level and associated type families have the same functionality, but the code I am writing behaves differently in top level than it does when the families are associated. This compiles and runs fine:
{-# LANGUAGE TypeFamilies #-}
module Test where
-- type family R a
-- type instance R Maybe = Int
class C' a where
type R a
getInt' :: a Int
getBool' :: R a -> a Bool
instance C' Maybe where
type R Maybe = Int
getInt' = Just 3
getBool' i = Just $ i < 10
printer :: IO ()
printer = print $ (getBool' 5 :: Maybe Bool)
but this gives me a type error:
{-# LANGUAGE TypeFamilies #-}
module Test where
type family R a
type instance R Maybe = Int
class C' a where
-- type R a
getInt' :: a Int
getBool' :: R a -> a Bool
instance C' Maybe where
-- type R Maybe = Int
getInt' = Just 3
getBool' i = Just $ i < 10
printer :: IO ()
printer = print $ (getBool' 5 :: Maybe Bool)
These look identical to me; why is it that one compiles and the other doesn't?
The second one works if you annotate the kind:
type family R (a :: * -> *)
I don't think there's any reason why the right kind is only inferred for the associated type family.

Functional dependency: Two types determining third type

Why doesn't this code work:
class Foo a b c | a b -> c where
foo :: a -> b -> c
instance Foo Int Int Int where
foo a b = a + b
ghci > foo 4 4 -- This produces run time error
And by using functional dependency, why the following code produces compile time error:
instance Foo Float Float Int where
foo a b = a + b
I know that the above instance is an crazy example, but isn't the aim of functional dependency to help the type checker in resolving these issues ?
Actually it did resolve the ambiguity. The problem is that 4 :: Num a => a so GHC can't decide that you want to use foo :: Int -> Int -> Int. Now if instead you did
foo (4 :: Int) (4 :: Int)
> 8
Since now it is clear which instance we want to use. To make this clearer, suppose we had
class Foo a b c | a -> b, a -> c where
...
Now we could do
foo (4 :: Int) 4
> 8
since once GHC has filled in all the type variables not on the right side of an ->, it can fill in the rest.
instance Foo Float Float Int where
foo a b = a + b
This is a error even without the functional dependency. If a and b are Float, then a + b is a Float, not an Int.

MultiParamTypeClasses, FunctionalDependencies, and calling ambiguous functions

With functional dependencies, I can declare the Foo class:
class Foo a b c | a -> b where
foo1 :: a -> b -> c
foo2 :: a -> c
and when I call foo2, everything works fine. The compiler knows which instance to use because of the dependency.
But if I remove the dependency to create Foo':
class Foo' a b c where
foo1' :: a -> b -> c
foo2' :: a -> c
everything still compiles fine, but now whenever I try to call foo2' GHC throws an error about not being able to resolve which instance to use because b is ambiguous.
Is it ever possible to call foo2' without error? If so, how? If not, why doesn't it generate a compilation error?
It is impossible to call foo2' in this context, because, as Daniel Fischer says, there is no way to determine which instance to use. For example, if you had:
instance Foo' Int Int Int where
foo2' x = x
instance Foo' Int Bool Int where
foo2' x = x + 1
Both of these foo2's have the same type signature, so there is no way to determine which one to call.
The usual way around this problem is to use a proxy:
data Proxy a = Proxy
class Foo'' a b c = where
foo2'' :: Proxy b -> a -> c
Which you use like so to select which instance:
foo'' (Proxy :: Proxy Bool) 42

Haskell: how to write a monadic variadic function, with parameters using the monadic context

I'm trying to make a variadic function with a monadic return type, whose parameters also require the monadic context. (I'm not sure how to describe that second point: e.g. printf can return IO () but it's different in that its parameters are treated the same whether it ends up being IO () or String.)
Basically, I've got a data constructor that takes, say, two Char parameters. I want to provide two pointer style ID Char arguments instead, which can be automagically decoded from an enclosing State monad via a type class instance. So, instead of doing get >>= \s -> foo1adic (Constructor (idGet s id1) (idGet s id2)), I want to do fooVariadic Constructor id1 id2.
What follows is what I've got so far, Literate Haskell style in case somebody wants to copy it and mess with it.
First, the basic environment:
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> import Control.Monad.Trans.State
> data Foo = Foo0
> | Foo1 Char
> | Foo2 Bool Char
> | Foo3 Char Bool Char
> deriving Show
> type Env = (String,[Bool])
> newtype ID a = ID {unID :: Int}
> deriving Show
> class InEnv a where envGet :: Env -> ID a -> a
> instance InEnv Char where envGet (s,_) i = s !! unID i
> instance InEnv Bool where envGet (_,b) i = b !! unID i
Some test data for convenience:
> cid :: ID Char
> cid = ID 1
> bid :: ID Bool
> bid = ID 2
> env :: Env
> env = ("xy", map (==1) [0,0,1])
I've got this non-monadic version, which simply takes the environment as the first parameter. This works fine but it's not quite what I'm after. Examples:
$ mkFoo env Foo0 :: Foo
Foo0
$ mkFoo env Foo3 cid bid cid :: Foo
Foo3 'y' True 'y'
(I could use functional dependencies or type families to get rid of the need for the :: Foo type annotations. For now I'm not fussed about it, since this isn't what I'm interested in anyway.)
> mkFoo :: VarC a b => Env -> a -> b
> mkFoo = variadic
>
> class VarC r1 r2 where
> variadic :: Env -> r1 -> r2
>
> -- Take the partially applied constructor, turn it into one that takes an ID
> -- by using the given state.
> instance (InEnv a, VarC r1 r2) => VarC (a -> r1) (ID a -> r2) where
> variadic e f = \aid -> variadic e (f (envGet e aid))
>
> instance VarC Foo Foo where
> variadic _ = id
Now, I want a variadic function that runs in the following monad.
> type MyState = State Env
And basically, I have no idea how I should proceed. I've tried expressing the type class in different ways (variadicM :: r1 -> r2 and variadicM :: r1 -> MyState r2) but I haven't succeeded in writing the instances. I've also tried adapting the non-monadic solution above so that I somehow "end up" with an Env -> Foo which I could then easily turn into a MyState Foo, but no luck there either.
What follows is my best attempt thus far.
> mkFooM :: VarMC r1 r2 => r1 -> r2
> mkFooM = variadicM
>
> class VarMC r1 r2 where
> variadicM :: r1 -> r2
>
> -- I don't like this instance because it requires doing a "get" at each
> -- stage. I'd like to do it only once, at the start of the whole computation
> -- chain (ideally in mkFooM), but I don't know how to tie it all together.
> instance (InEnv a, VarMC r1 r2) => VarMC (a -> r1) (ID a -> MyState r2) where
> variadicM f = \aid -> get >>= \e -> return$ variadicM (f (envGet e aid))
>
> instance VarMC Foo Foo where
> variadicM = id
>
> instance VarMC Foo (MyState Foo) where
> variadicM = return
It works for Foo0 and Foo1, but not beyond that:
$ flip evalState env (variadicM Foo1 cid :: MyState Foo)
Foo1 'y'
$ flip evalState env (variadicM Foo2 cid bid :: MyState Foo)
No instance for (VarMC (Bool -> Char -> Foo)
(ID Bool -> ID Char -> MyState Foo))
(Here I would like to get rid of the need for the annotation, but the fact that this formulation needs two instances for Foo makes that problematic.)
I understand the complaint: I only have an instance that goes from Bool ->
Char -> Foo to ID Bool -> MyState (ID Char -> Foo). But I can't make the
instance it wants because I need MyState in there somewhere so that I can
turn the ID Bool into a Bool.
I don't know if I'm completely off track or what. I know that I could solve my basic issue (I don't want to pollute my code with the idGet s equivalents all over the place) in different ways, such as creating liftA/liftM-style functions for different numbers of ID parameters, with types like (a -> b -> ... -> z -> ret) -> ID a -> ID b -> ... -> ID z -> MyState ret, but I've spent too much time thinking about this. :-) I want to know what this variadic solution should look like.
WARNING
Preferably don't use variadic functions for this type of work. You only have a finite number of constructors, so smart constructors don't seem to be a big deal. The ~10-20 lines you would need are a lot simpler and more maintainable than a variadic solution. Also an applicative solution is much less work.
WARNING
The monad/applicative in combination with variadic functions is the problem. The 'problem' is the argument addition step used for the variadic class. The basic class would look like
class Variadic f where
func :: f
-- possibly with extra stuff
where you make it variadic by having instances of the form
instance Variadic BaseType where ...
instance Variadic f => Variadic (arg -> f) where ...
Which would break when you would start to use monads. Adding the monad in the class definition would prevent argument expansion (you would get :: M (arg -> f), for some monad M). Adding it to the base case would prevent using the monad in the expansion, as it's not possible (as far as I know) to add the monadic constraint to the expansion instance. For a hint to a complex solution see the P.S..
The solution direction of using a function which results in (Env -> Foo) is more promising. The following code still requires a :: Foo type constraint and uses a simplified version of the Env/ID for brevity.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
module Test where
data Env = Env
data ID a = ID
data Foo
= Foo0
| Foo1 Char
| Foo2 Char Bool
| Foo3 Char Bool Char
deriving (Eq, Ord, Show)
class InEnv a where
resolve :: Env -> ID a -> a
instance InEnv Char where
resolve _ _ = 'a'
instance InEnv Bool where
resolve _ _ = True
The Type families extension is used to make the matching stricter/better. Now the variadic function class.
class MApp f r where
app :: Env -> f -> r
instance MApp Foo Foo where
app _ = id
instance (MApp r' r, InEnv a, a ~ b) => MApp (a -> r') (ID b -> r) where
app env f i = app env . f $ resolve env i
-- using a ~ b makes this instance to match more easily and
-- then forces a and b to be the same. This prevents ambiguous
-- ID instances when not specifying there type. When using type
-- signatures on all the ID's you can use
-- (MApp r' r, InEnv a) => MApp (a -> r') (ID a -> r)
-- as constraint.
The environment Env is explicitly passed, in essence the Reader monad is unpacked preventing the problems between monads and variadic functions (for the State monad the resolve function should return a new environment). Testing with app Env Foo1 ID :: Foo results in the expected Foo1 'a'.
P.S.
You can get monadic variadic functions to work (to some extent) but it requires bending your functions (and mind) in some very strange ways. The way I've got such things to work is to 'fold' all the variadic arguments into a heterogeneous list. The unwrapping can then be done monadic-ally. Though I've done some things like that, I strongly discourage you from using such things in actual (used) code as it quickly gets incomprehensible and unmaintainable (not to speak of the type errors you would get).

Default type instances referring to each other

Is there a way to have default type instances defined in terms of each other? I'm trying to get something like this working:
{-# LANGUAGE DataKinds, KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
data Tag = A | B | C
class Foo (a :: *) where
type Bar a (b :: Tag)
type Bar a A = ()
type Bar a B = Bar a A
type Bar a C = Bar a A
instance Foo Int where
type Bar Int A = Bool
test :: Bar Int B
test = True
but this doesn't work:
Couldn't match type `Bar Int 'B' with `Bool'
In the expression: True
In an equation for `test': test = True
Note that this doesn't work either:
test :: Bar Int B
test = ()
Yes, default type instances can be defined in terms of each other (as you can see from your own example):
instance Foo Int where
-- So the default recursive definition will be used instead
-- type Bar Int A = Bool
test :: Bar Int B
test = ()
However when you redefine associated type synonym in your instance definition for Int you replace entire default 3-line defintion of Bar (and not just the type Bar a A = ()) with one line type Bar Int A = Bool which means Bar Int B and Bar Int C are no longer defined.
So I guess one of the ways to use recursive defaults the way you intended is to redefine specific synonyms instead (though it is rather verbose):
class Foo (a :: *) where
type Bar a (b :: Tag)
type Bar a A = BarA a
type Bar a B = BarB a
type BarA a
type BarA a = ()
type BarB a
type BarB a = Bar a A
-- This now works
instance Foo Int where
type BarA Int = Bool
test :: Bar Int B
test = True
Which can fall back to defaults:
-- As well as this one
instance Foo Int where
-- type BarA Int = Bool
test :: Bar Int B
test = ()

Resources