So I typed this up
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-}
import Data.Monoid
class Monoid m => Mconcat m a | a -> m where
mcon :: m -> a
instance Monoid m => Mconcat m m where
mcon m = m
instance Mconcat m a => Mconcat m (m -> a) where
mcon m m' = mcon (m `mappend` m')
and I get
[1 of 1] Compiling Main ( pad.hs, interpreted )
pad.hs:8:10:
Functional dependencies conflict between instance declarations:
instance Monoid m => Mconcat m m -- Defined at pad.hs:8:10
instance Mconcat m a => Mconcat m (m -> a)
-- Defined at pad.hs:11:10
Failed, modules loaded: none.
The thing is though, m and m->a cannot be equal! Why is it giving me a conflict? (Also, any tips as to how to make a polyvariadic mconcat (in the style of the printf library)?
You can make this compile and do what you want by changing the second instance declaration and adding UndecidableInstances:
{-# LANGUAGE UndecidableInstances #-}
...
instance {-# OVERLAPS #-} (Mconcat m a, o ~ (m -> a)) => Mconcat m o where
or on earlier versions of GHC this should work (untested)
{-# LANGUAGE UndecidableInstances, OverlappingInstances #-}
...
instance (Mconcat m a, o ~ (m -> a)) => Mconcat m o where
This works because GHC only looks at the head of an instance to determine if it satisfies the coverage condition, but you can (almost) always achieve the same instance by making this transformation. It even handles polymorphic cases!
>:set +t
>mcon [1] [2] [34,34,2,53] [34,23,43]
[1,2,34,34,2,53,34,23,43]
it :: Num t => [t]
>mcon "a" "b" "c" "d" "e"
"abcde"
it :: [Char]
Related
I'm writing a distributed programming DSL and I'd like to allow implementations to choose their serialization method (if any, as it might not even be needed for a simulated execution).
Trying to solve this by adding a type family led to the problem below for a standard function I have. I imagine that it would work if I could require, and have the type checker understand, that if two values are serializable their pairing is also serializable. However, adding that as a quantified constraint doesn't seem to work. Can this be solved or is there a better solution for the problem?
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Kind
class (Monad (DistrM t)) => Distributed (t :: *) where
type Sendable t :: * -> Constraint
type DistrM t :: * -> *
-- ...
data FromSendable t a where
FromSendable :: (Sendable t b)
=> (b -> DistrM t a)
-> b
-> FromSendable t a
pairWith :: ( Sendable t a
, Distributed t
, forall a b. (Sendable t a, Sendable t b) => Sendable t (a,b)
)
=> a
-> FromSendable t b
-> FromSendable t (a,b)
pairWith a (FromSendable f b) =
FromSendable (\(a,b) -> (a,) <$> f b) (a,b)
-- >>> Could not deduce: Sendable t (a1, b1) ...
Edit 1
It type checks if I do
pairWith :: ( Sendable t a
, Distributed t
, st ~ Sendable t
, forall a b. (st a, st b) => st (a,b)
)
=> ...
It would get cumbersome to have to repeat these types of constraints, so I tried a type synonym but that doesn't work:
type Cs t = forall (st :: * -> Constraint).
(Sendable t ~ st, forall a b. (st a, st b) => st (a,b))
-- >>> Expected a constraint, but ‘st (a, b)’ has kind ‘*’
This looks weird. I only have a partial answer, but I'll post it anyway.
I simplified your code to
class C t where -- (*)
data T t where
T :: C t => (a -> t) -> a -> T t
foo ::
( C u
, forall a b . (C a , C b) => C (a, b) )
=> u -> T t -> T (u, t)
foo i (T f x) = T (\(a,b) -> (a, f b)) (i, x)
and, in this version, it compiles fine. However, if we replace
class C t where
with
type instance C :: * -> Constraint
then we get an error telling us that C (a, b) can not be deduced.
I can't completely understand what's going on here, but it looks like quantified constraints do not mix well with type families.
It looks like the above type family is treated like it were
type instance C (t :: *) :: Constraint
and in such case, I can't understand what's wrong. Since C now does not refer to a single type class, it is impossible to implement a quantified constraint like forall a b . (C a , C b) => C (a, b) by (say) passing a pointer to a specific instance, since the three C constraints could be anything at all, in an open world.
I still do not understand why type family C :: * -> Constraint is handled in the same way.
Perhaps GHC should reject quantified constraints involving type families ... -> Constraint in such way? I not sure.
I think you've pushed your code to the edges of GHC's type system here. You can fix the kind error on Cs by writing:
type Cs t = (forall (st :: * -> Constraint).
(Sendable t ~ st, forall a b. (st a, st b) => st (a,b))) :: Constraint
but then you run up against "GHC doesn't yet support impredicative polymorphism". Until GHC adds support for class families as per issue 14860, you're maybe out of luck with this approach.
However, you did ask about alternative approaches. Doesn't making Sendable t a a multiparameter type class accomplish basically the same thing?
Certainly, the following type-checks:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Kind
class (Monad (DistrM t)) => Distributed (t :: *) where
type DistrM t :: * -> *
-- ...
class Sendable t a where
data FromSendable t a where
FromSendable :: (Sendable t b)
=> (b -> DistrM t a)
-> b
-> FromSendable t a
type Cs t = forall a b. (Sendable t a, Sendable t b) => Sendable t (a,b) :: Constraint
pairWith :: ( Sendable t a
, Distributed t
, Cs t
)
=> a
-> FromSendable t b
-> FromSendable t (a,b)
pairWith a (FromSendable f b) =
FromSendable (\(a,b) -> (a,) <$> f b) (a,b)
I'm trying to use type class to simulate ad-hoc polymorphism and solve generic cases involving higher kinded types and so far can't figure out the correct solution.
What I'm looking for is to define something similar to:
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
infixl 0 >>>
-- | Type class that allows applying a value of type #fn# to some #m a#
class Apply m a fn b | a fn -> b where
(>>>) :: m a -> fn -> m b
-- to later use it in following manner:
(Just False) >>> True -- same as True <$ ma
(Just True) >>> id -- same as id <$> ma
Nothing >>> pure Bool -- same as Nothing >>= const $ pure Bool
(Just "foo") >>> (\a -> return a) -- same as (Just "foo") >>= (\a -> return a)
So far I've tried multiple options, none of them working.
Just a straight forward solution obviously fails:
instance (Functor m) => Apply m a b b where
(>>>) m b = b <$ m
instance (Monad m) => Apply m a (m b) b where
(>>>) m mb = m >>= const mb
instance (Functor m) => Apply m a (a -> b) b where
(>>>) m fn = fmap fn m
instance (Monad m, a' ~ a) => Apply m a (a' -> m b) b where
(>>>) m fn = m >>= fn
As there are tons of fundep conflicts (all of them) related to the first instance that gladly covers all the cases (duh).
I couldn't work out also a proper type family approach:
class Apply' (fnType :: FnType) m a fn b | a fn -> b where
(>>>) :: m a -> fn -> m b
instance (Functor m) => Apply' Const m a b b where
(>>>) m b = b <$ m
instance (Monad m) => Apply' ConstM m a (m b) b where
(>>>) m mb = m >>= const mb
instance (Functor m, a ~ a') => Apply' Fn m a (a' -> b) b where
(>>>) m mb = m >>= const mb
instance (Functor m, a ~ a') => Apply' Fn m a (a' -> m b) b where
(>>>) m fn = m >>= fn
data FnType = Const | ConstM | Fn | FnM
type family ApplyT a where
ApplyT (m a) = ConstM
ApplyT (a -> m b) = FnM
ApplyT (a -> b) = Fn
ApplyT _ = Const
Here I have almost the same issue, where the first instance conflicts with all of them through fundep.
The end result I want to achieve is somewhat similar to the infamous magnet pattern sometimes used in Scala.
Update:
To clarify the need for such type class even further, here is a somewhat simple example:
-- | Monad to operate on
data Endpoint m a = Endpoint { runEndpoint :: Maybe (m a) } deriving (Functor, Applicative, Monad)
So far there is no huge need to have mentioned operator >>> in place, as users might use the standard set of <$ | <$> | >>= instead. (Actually, not sure about >>= as there is no way to define Endpoint in terms of Monad)
Now to make it a bit more complex:
infixr 6 :::
-- | Let's introduce HList GADT
data HList xs where
HNil :: HList '[]
(:::) :: a -> HList as -> HList (a ': as)
-- Endpoint where a ~ HList
endpoint :: Endpoint IO (HList '[Bool, Int]) = pure $ True ::: 5 ::: HNil
-- Some random function
fn :: Bool -> Int -> String
fn b i = show b ++ show i
fn <$> endpoint -- doesn't work, as fn is a function of a -> b -> c, not HList -> c
Also, imagine that the function fn might be also defined with m String as a result. That's why I'm looking for a way to hide this complexity away from the API user.
Worth mentioning, I already have a type class to convert a -> b -> c into HList '[a, b] -> c
If the goal is to abstract over HLists, just do that. Don't muddle things by introducing a possible monad wrapper at every argument, it turns out to be quite complicated indeed. Instead do the wrapping and lifting at the function level with all the usual tools. So:
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
data HList a where
HNil :: HList '[]
(:::) :: x -> HList xs -> HList (x : xs)
class ApplyArgs args i o | args i -> o, args o -> i where
apply :: i -> HList args -> o
instance i ~ o => ApplyArgs '[] i o where
apply i _ = i
instance (x ~ y, ApplyArgs xs i o) => ApplyArgs (x:xs) (y -> i) o where
apply f (x ::: xs) = apply (f x) xs
I'm trying to make my use of Finites completely safe and non-partial, by using Proxys in place of Integers like so:
-- SO test case, re: my use of ghc-typelits-natnormalise package.
--
-- David Banas <capn.freako#gmail.com>
-- February 9, 2018
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
module Bogus.NewFin where
import GHC.TypeLits
import Data.Proxy
import Data.Finite
import Data.Finite.Internal (Finite(..))
import Data.Reflection
-- A safer form of `finite`.
finite' :: (KnownNat n, KnownNat m, n `CmpNat` m ~ 'GT) => Proxy m -> Finite n
finite' p = Finite $ natVal p
-- A safer form of `getFinite`.
getFinite' :: KnownNat n => Finite n -> (forall m. (KnownNat m, n `CmpNat` m ~ 'GT) => Proxy m -> r) -> r
getFinite' x f = reifyNat (getFinite x) f
And I'm getting this compiler error:
Davids-Air-2:test dbanas$ stack ghc -- -c so_natnorm.hs
so_natnorm.hs:28:41: error:
• Couldn't match type ‘CmpNat n n1’ with ‘'GT’
arising from a use of ‘f’
• In the second argument of ‘reifyNat’, namely ‘f’
In the expression: reifyNat (getFinite x) f
In an equation for ‘getFinite'’:
getFinite' x f = reifyNat (getFinite x) f
• Relevant bindings include
f :: forall (m :: Nat).
(KnownNat m, CmpNat n m ~ 'GT) =>
Proxy m -> r
(bound at so_natnorm.hs:28:14)
x :: Finite n (bound at so_natnorm.hs:28:12)
getFinite' :: Finite n
-> (forall (m :: Nat).
(KnownNat m, CmpNat n m ~ 'GT) =>
Proxy m -> r)
-> r
(bound at so_natnorm.hs:28:1)
I'm guessing that my problem is trying to relate a universally and an existentially quantified type, through the mechanisms provided by the ghc-typelits-natnormalise package. Is that correct?
It seems to me that this ought to be allowed, since the caller is responsible for assigning both:
the value of n, and
the maximum value of m.
Where is my reasoning about this faulty?
reifyNat takes as an argument a function which works for any natural. A function of type forall m. (KnownNat m, n `CmpNat` m ~ 'GT) => Proxy m -> r doesn't work on any natural; it only works on naturals less than some other n.
Since you are calling getFinite to produce the actual value, you know that value is less than n. Unfortunately, you have no way to prove this to the typechecker. Fortunately, you are allowed to tell the typechecker to trust you:
import Type.Reflection ((:~:)(..))
import Unsafe.Coerce
...
getFinite'' :: KnownNat n => Finite n -> (forall m. (KnownNat m) => Proxy m -> n `CmpNat` m :~: 'GT -> r) -> r
getFinite'' x f = reifyNat (getFinite x) $ \p -> f p (unsafeCoerce Refl)
getFinite' :: forall n r . KnownNat n => Finite n -> (forall m. (KnownNat m, n `CmpNat` m ~ 'GT) => Proxy m -> r) -> r
getFinite' x f = getFinite'' x $ \p Refl -> f p
I have a list of heterogeneous types (or at least that's what I have in mind):
data Nul
data Bits b otherBits where
BitsLst :: b -> otherBits -> Bits b otherBits
NoMoreBits :: Bits b Nul
Now, given an input type b, I want to go through all the slabs of Bits with type b and summarize them, ignoring other slabs with type b' /= b:
class Monoid r => EncodeBit b r | b -> r where
encodeBit :: b -> r
class AbstractFoldable aMulti r where
manyFold :: r -> aMulti -> r
instance (EncodeBit b r, AbstractFoldable otherBits r) =>
AbstractFoldable (Bits b otherBits ) r where
manyFold r0 (BitsLst bi other) = manyFold (r0 `mappend` (encodeBit bi)) other
manyFold b0 NoMoreBits = b0
instance AbstractFoldable otherBits r =>
AbstractFoldable (Bits nb otherBits ) r where
manyFold r0 (BitsLst _ other) = manyFold r0 other
manyFold b0 NoMoreBits = b0
But the compiler wants none of it. And with good reason, since both instance declarations have the same head. Question: what is the correct way of folding over Bits with an arbitrary type?
Note: the above example is compiled with
{-# LANGUAGE MultiParamTypeClasses,
FunctionalDependencies,
GADTs,
DataKinds,
FlexibleInstances,
FlexibleContexts
#-}
Answering your comment:
Actually, I can do if I can filter the heterogeneous list by type. Is that possible?
You can filter the heterogeneous list by type if you add a Typeable constraint to b.
The main idea is we will use Data.Typeable's cast :: (Typeable a, Typeable b) => a -> Maybe b to determine if each item in the list is of a certain type. This will require a Typeable constraint for each item in the list. Instead of building a new list type with this constraint built in, we will make the ability to check if All types in a list meet some constraint.
Our goal is to make the following program output [True,False], filtering a heterogeneous list to only its Bool elements. I will endevour to place the language extensions and imports with the first snippet they are needed for
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
example :: HList (Bool ': String ': Bool ': String ': '[])
example = HCons True $ HCons "Jack" $ HCons False $ HCons "Jill" $ HNil
main = do
print (ofType example :: [Bool])
HList here is a fairly standard definition of a heterogeneous list in haskell using DataKinds
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
data HList (l :: [*]) where
HCons :: h -> HList t -> HList (h ': t)
HNil :: HList '[]
We want to write ofType with a signature like "if All things in a heterogeneous list are Typeable, get a list of those things of a specific Typeable type.
import Data.Typeable
ofType :: (All Typeable l, Typeable a) => HList l -> [a]
To do this, we need to develop the notion of All things in a list of types satisfying some constraint. We will store the dictionaries for satisfied constraints in a GADT that either captures both the head constraint dictionary and constraints for All of the the tail or proves that the list is empty. A type list satisfies a constraint for All it's items if we can capture the dictionaries for it.
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
-- requires the constraints† package.
-- Constraint is actually in GHC.Prim
-- it's just easier to get to this way
import Data.Constraint (Constraint)
class All (c :: * -> Constraint) (l :: [*]) where
allDict :: p1 c -> p2 l -> DList c l
data DList (ctx :: * -> Constraint) (l :: [*]) where
DCons :: (ctx h, All ctx t) => DList ctx (h ': t)
DNil :: DList ctx '[]
DList really is a list of dictionaries. DCons captures the dictionary for the constraint applied to the head item (ctx h) and all the dictionaries for the remainder of the list (All ctx t). We can't get the dictionaries for the tail directly from the constructor, but we can write a function that extracts them from the dictionary for All ctx t.
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Proxy
dtail :: forall ctx h t. DList ctx (h ': t) -> DList ctx t
dtail DCons = allDict (Proxy :: Proxy ctx) (Proxy :: Proxy t)
An empty list of types trivially satisfies any constraint applied to all of its items
instance All c '[] where
allDict _ _ = DNil
If the head of a list satisfies a constraint and all of the tail does too, then everything in the list satisfies the constraint.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
instance (c h, All c t) => All c (h ': t) where
allDict _ _ = DCons
We can now write ofType, which requires foralls for scoping type variables with ScopedTypeVariables.
import Data.Maybe
ofType :: forall a l. (All Typeable l, Typeable a) => HList l -> [a]
ofType l = ofType' (allDict (Proxy :: Proxy Typeable) l) l
where
ofType' :: forall l. (All Typeable l) => DList Typeable l -> HList l -> [a]
ofType' d#DCons (HCons x t) = maybeToList (cast x) ++ ofType' (dtail d) t
ofType' DNil HNil = []
We are zipping the HList together with its dictionaries with maybeToList . cast and concatenating the results. We can make that explicit with RankNTypes.
{-# LANGUAGE RankNTypes #-}
import Data.Monoid (Monoid, (<>), mempty)
zipDHWith :: forall c w l p. (All c l, Monoid w) => (forall a. (c a) => a -> w) -> p c -> HList l -> w
zipDHWith f p l = zipDHWith' (allDict p l) l
where
zipDHWith' :: forall l. (All c l) => DList c l -> HList l -> w
zipDHWith' d#DCons (HCons x t) = f x <> zipDHWith' (dtail d) t
zipDHWith' DNil HNil = mempty
ofType :: (All Typeable l, Typeable a) => HList l -> [a]
ofType = zipDHWith (maybeToList . cast) (Proxy :: Proxy Typeable)
†constraints
I'm messing around with the SPECIALIZE pragma while trying to find a solution to this problem.
I came up with this example:
{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving #-}
import Data.Vector
import qualified Data.Vector.Generic as V
class Foo a
newtype Phantom m = T Int deriving (Show)
instance (Foo m) => Num (Phantom m)
f :: (Num r, V.Vector v r) => v r -> v r -> v r
{-# SPECIALIZE f :: (Foo m) => Vector (Phantom m) -> Vector (Phantom m) -> Vector (Phantom m) #-}
f x y = V.zipWith (+) x y
main = print "hello"
which fails to compile (GHC 7.6.2) because
Forall'd constraint `Foo m' is not bound in RULE lhs.
Googling only turned up a couple of GHC bug reports from years ago. I didn't see anything about "forall'd constraints" while reading about SPECIALIZE or RULE. My specialize signature does seem less polymorphic than the original, and it satisfies the "if-and-only-if" rule.
replace with
{-# SPECIALIZE f :: (Num (Phantom m)) => Vector (Phantom m) -> Vector (Phantom m) -> Vector (Phantom m) #-}
and it will work. The r in Num r is Phantom m not m, thus you can't add the constraint Num m. This is logical--Num (Phantom m) does not imply Num m and you could get other instances under the open world assumption.
EDIT:
You actually don't need any constraint at all in this case
{-# SPECIALIZE f :: Vector (Phantom m) -> Vector (Phantom m) -> Vector (Phantom m) #-}
anyway, the basic problem if I understand what you are trying to do is that you can't constrain when you perform an optimization based on phantom type parameters.