When working with a Bifunctor, we gain access to the first and second "map" functions. So basically it is a Functor that allows us to fmap in two different ways.
Is there something like this for Monoid? Some concept that allows us to append in two different ways?
For example, imagine an opaque Matrix type. It is not a list of lists or a vector of vectors, we have no clue how it is structured inside, but we know that we can append rows and columns to it.
Would there be some type class that allowed to do this?
class X a where
firstAppend :: a -> a -> a
secondAppend :: a -> a -> a
instance X Matrix where
firstAppend = appendRow
secondAppend = appendColumn
I guess you could do something like this with indexed Monoids:
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module IndexedMonoids where
class MonoidIx (m :: k -> *) where
type Null m :: k
type Mult m (i :: k) (j :: k) :: k
nullIx :: m (Null m)
multIx :: m i -> m j -> m (Mult m i j)
class MonoidIx2 (m :: k -> l -> *) where
type Null1 m :: k
type Null2 m :: l
type Mult1 m (i :: k) (j :: k) :: k
type Mult2 m (p :: l) (q :: l) :: l
null1Ix :: m (Null1 m) p
null2Ix :: m i (Null2 m)
mult1Ix :: m i p -> m j p -> m (Mult1 m i j) p
mult2Ix :: m i p -> m i q -> m i (Mult2 m p q)
You'd expect a bunch of laws (identity, associativity, commutativity when you put 4 blocks together). A trivial example of an indexed Monoid: the one where the index does not matter:
newtype Dummy (m :: *) (i :: k) = Dummy { getDummy :: m }
instance Monoid m => MonoidIx (Dummy m :: * -> *) where
type Null (Dummy m) = ()
type Mult (Dummy m) i j = ()
nullIx = Dummy mempty
multIx (Dummy i) (Dummy j) = Dummy $ mappend i j
I'll let you implement the instance for matrices ;)
Related
I thought join of Control.Monad had the same capability of Array.flat in JavaScript.
https://developer.mozilla.org/docs/Web/JavaScript/Reference/Global_Objects/Array/flat
However, it's against my expectation and the actual behavior is
f :: Maybe a -> Maybe a
f = \a -> join (Just a) -- works as I expected
f' :: a -> Maybe a
f' = \a -> join (Just a) -- I thought it returns Maybe a
-- Occurs check: cannot construct the infinite type: a ~ Maybe a
-- Expected type: Maybe (Maybe a)
-- Actual type: Maybe a
Is there flatten function available instead or any workaround?
join flattens always exactly two layers down to one. Ideally we would like to express something like “recursively flatten any nested layers; if we're down to one layer, don't do anything”. This would require a type like
type family Flattened x where
Flattened (m (m a)) = Flattened (m a)
Flattened (m a) = m a
flatten :: x -> Flattened x
Actually, this can't (AFAIK) be implemented as such though, we need some heavy machinery:
{-# LANGUAGE TypeFamilies, GADTs, ConstraintKinds
, MultiParamTypeClasses, FlexibleInstances
, RankNTypes, UnicodeSyntax
, ScopedTypeVariables, AllowAmbiguousTypes, TypeApplications #-}
import Control.Monad
type family Stripped m x where
Stripped m (m a) = Stripped m a
Stripped m x = x
type Bare m x = Stripped m x ~ x
data DepthSing m x where
BareSing :: Bare m x => DepthSing m x
DeepSing :: KnownDepth m x => DepthSing m (m x)
class KnownDepth m x where
depth :: DepthSing m x
flatten :: ∀ m x . (Monad m, KnownDepth m x) => m x -> m (Stripped m x)
flatten p = case depth #m #x of
BareSing -> p
DeepSing -> flatten $ join p
instance KnownDepth m Char where
depth = BareSing
instance KnownDepth m a => KnownDepth m (m a) where
depth = DeepSing
Now
*Main> flatten (Just (Just 'v'))
Just 'v'
*Main> flatten (Just (Just (Just 'w')))
Just 'w'
*Main> flatten (Just 'i')
Just 'i'
Awkward is that we need a dedicated KnownDepth instance for every “primitive” type.
instance KnownDepth m Int where depth = BareSing
instance KnownDepth m Bool where depth = BareSing
...
Perhaps -XIncoherentInstances could help, but that's an extension I'm not touching.
A worse problem is that this doesn't work for flattening e.g. Maybe (Maybe [Int]) to Maybe [Int], we need quadratically many instances:
instance KnownDepth Maybe [x] where depth = BareSing
instance KnownDepth Maybe (Either c x) where depth = BareSing
...
instance KnownDepth [] (Maybe x) where depth = BareSing
instance KnownDepth [] (Either c x) where depth = BareSing
...
instance KnownDepth (Either c) [x] where depth = BareSing
instance KnownDepth (Either c) (Maybe x) where depth = BareSing
...
...
If you also want the behaviour 'w' -> Just 'w', this can be accomplished by
flatten' :: ∀ m x . (Monad m, KnownDepth m x) => x -> m (Stripped m x)
flatten' p = case depth #m #x of
BareSing -> return p
DeepSing -> flatten p
I'm wondering what the appropriate type signature is for g. The one I've got currently doesn't compile. I presume a forall. is needed somewhere but I'm not exactly sure where.
{-# LANGUAGE TypeFamilies #-}
import Control.Monad.ST (ST, runST)
data D
class C t where
type M t :: * -> *
f :: t -> M t D
g :: (C t, M t ~ ST s) => t -> D
g x = runST (f x)
main = return ()
(Added example in response to comment by #cirdec)
{-# LANGUAGE TypeFamilies #-}
import Control.Monad.ST (ST, runST)
data D = D
class C t where
type M t :: * -> *
f :: t -> M t D
data T (m :: (* -> *)) = T
instance (Monad m) => C (T m) where
type M (T m) = m
f _ = return D
main = const (return ()) (runST (f T))
I then replace main with the following:
g x = runST (f x)
main = const (return ()) (g T)
By the looks of it, this should compile, as g T == runST (f T) by definition of g. But it does not. I assume g needs a signature but I'm not sure what it is.
(Added background in response to comment by #cirdec)
Basically in my code C is a class of datatypes that can be treated as monadic disjoint Int sets (I know there are packages on hackage already but my approach has a few more features). C has functions like union and find etc. The actual implementation of these differ depending on whether the user knows their size at creation time or whether they need to dynamically grow, hence the type class. However once these data types are created they can be roughly treated the same. All this occurs in monad code, generally ST or IO, but technically anything that's in the MonadRef will suffice. Then C has a function freeze of result type M t D, where D is some result datatype. For example, for IO freeze will have the type (C t) => t -> IO D but for ST freeze will look more like (C t) => t -> ST s D. In the latter case, one should be able to run runST on the result of freeze to get the raw result data.
The following file compiles for me:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
import Control.Monad.ST (ST, runST)
data D = D
class C t where
type M t :: * -> *
f :: t -> M t D
data T (m :: (* -> *)) = T
instance (Monad m) => C (T m) where
type M (T m) = m
f _ = return D
data Equal a b where Refl :: Equal a a
convert :: Equal f g -> f a -> g a
convert Refl v = v
data Box s where
Box :: C t => Equal (M t) (ST s) -> t -> Box s
g :: (forall s. Box s) -> D
g box = runST (case box of Box eq x -> convert eq (f x))
main = const (return ()) (g (Box Refl T))
As an exercise, I'm trying to create a Vector typeclass as an exercise:
class Vector v where
vplus :: v -> v -> v
vnegate :: v -> v
type V3 a = (a,a,a)
instance (Num a) => Vector (V3 a) where
(a,b,c) `vplus` (d,e,f) = (a+d, b+e, c+f)
vnegate (a,b,c) = ((-a), (-b), (-c))
I want to add a dot function on the typeclass. On the V3 example above, I'd implement it as follows:
dot :: (Num a) => V3 a -> V3 a -> a
(a,b,c) `dot` (d,e,f) = a*d + b*e + c*f
However, it appears I don't have access to the type parameter a from within Vector, so I can't have dot operate over Vector the way I want. How would I access the a type parameter?
Another solution, which requires no extensions, is to use a higher-kinded class. Thus:
class Vector v where
vplus :: Num a => v a -> v a -> v a
vnegate :: Num a => v a -> v a
Then it's easy to add a dot-product method:
dot :: Num a => v a -> v a -> a
The instance method implementations won't have to change, though the instance declaration itself would have to change:
instance Vector V3 where
-- method implementations are the same as before
You want to use TypeFamilies for this to create an associated type:
{-# LANGUAGE TypeFamilies, TypeSynonymInstances, FlexibleInstances #-}
class Vector v where
-- Declares a family of types called Item, parametrized on the
-- instance v of Vector, and the kind of Item v must be *,
-- meaning that it must be a type, not a type constructor
-- (e.g. Maybe Int :: * vs Maybe :: * -> *)
type family Item v :: *
dot :: v -> v -> Item v
...
instance (Num a) => Vector (V3 a) where
type Item (V3 a) = a
dot (a, b, c) (d, e, f) = a*d + b*e + c*f
...
Then you can do
> dot (1, 2, 3) ((4, 5, 6) :: V3 Int)
32
Although I would recommend against using a type synonym instance, you'd be better off using a data type:
data V3 a = V3 a a a deriving (Eq, Show)
instance Functor V3 where
fmap f (V3 a b c) = V3 (f a) (f b) (f c)
instance (Num a) => Vector (V3 a) where
type Item (V3 a) = a
(V3 a b c) `vplus` (V3 d e f) = V3 (a + d) (b + e) (c + f)
vnegate v = fmap negate v
dot (V3 a b c) (V3 d e f) = a*d + b*e + c*f
This helps out the type checker a lot, in particular it means you wouldn't need the explicit type signature above. It also means your inferred types won't be (a, a, a) but V3 a (like when you see [Char] instead of String), which is easier to follow. It's not crucial, but helpful.
In case you're wondering, this is how GHC.Exts.IsList (for use with the new OverloadedLists extension) does it:
class IsList l where
type family GHC.Exts.Item l :: *
fromList :: [GHC.Exts.Item l] -> l
fromListN :: Int -> [GHC.Exts.Item l] -> l
toList :: l -> [GHC.Exts.Item l]
Using type families, we can define the function fold over a type and the underlying algebra for that type represented as an n-tuple of functions and constant values. This permits the definition of a generalized foldr function, defined in the Foldable type class:
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.Set as S
import qualified Data.Map as M
class Foldable m where
type Algebra m b :: *
fold :: Algebra m b -> m -> b
instance (Ord a) => Foldable (Set a) where
type Algebra (Set a) b = (b, a -> b -> b)
fold = uncurry $ flip S.fold
instance (Ord k) => Foldable (Map k a) where
type Algebra (Map k a) b = (b, k -> a -> b -> b)
fold = uncurry $ flip M.foldWithKey
Similarly, constraint kinds permit the definition of a generalized map function. The map function differs from fmap by considering each value field of an algebraic data type:
class Mappable m where
type Contains m :: *
type Mapped m r b :: Constraint
map :: (Mapped m r b) => (Contains m -> b) -> m -> r
instance (Ord a) => Mappable (Set a) where
type Contains (Set a) = a
type Mapped (Set a) r b = (Ord b, r ~ Set b)
map = S.map
instance (Ord k) => Mappable (Map k a) where
type Contains (Map k a) = (k, a)
type Mapped (Map k a) r b = (Ord k, r ~ Map k b)
map = M.mapWithKey . curry
From the user's perspective, neither function is particularly friendly. In particular, neither technique permits the definition of curried functions. This means that the user cannot easily apply either fold or the mapped function partially. What I would like is a type-level function that curries tuples of functions and values, in order to generate curried versions of the above. Thus, I would like to write something approximating the following type-function:
Curry :: Product -> Type -> Type
Curry () m = m
Curry (a × as) m = a -> (Curry as m b)
If so, we could generate a curried fold function from the underlying algebra. For instance:
fold :: Curry (Algebra [a] b) ([a] -> b)
≡ fold :: Curry (b, a -> b -> b) ([a] -> b)
≡ fold :: b -> (Curry (a -> b -> b)) ([a] -> b)
≡ fold :: b -> (a -> b -> b -> (Curry () ([a] -> b))
≡ fold :: b -> ((a -> b -> b) -> ([a] -> b))
map :: (Mapped (Map k a) r b) => (Curry (Contains (Map k a)) b) -> Map k a -> r
≡ map :: (Mapped (Map k a) r b) => (Curry (k, a) b) -> Map k a -> r
≡ map :: (Mapped (Map k a) r b) => (k -> (Curry (a) b) -> Map k a -> r
≡ map :: (Mapped (Map k a) r b) => (k -> (a -> Curry () b)) -> Map k a -> r
≡ map :: (Mapped (Map k a) r b) => (k -> (a -> b)) -> Map k a -> r
I know that Haskell doesn't have type functions, and the proper representation of the n-tuple would probably be something like a type-level length-indexed list of types. Is this possible?
EDIT: For completeness, my current attempt at a solution is attached below. I am using empty data types to represent products of types, and type families to represent the function Curry, above. This solution appears to work for the map function, but not the fold function. I believe, but am not certain, that Curry is not being reduced properly when type checking.
data Unit
data Times a b
type family Curry a m :: *
type instance Curry Unit m = m
type instance Curry (Times a l) m = a -> Curry l m
class Foldable m where
type Algebra m b :: *
fold :: Curry (Algebra m b) (m -> b)
instance (Ord a) => Foldable (Set a) where
type Algebra (Set a) b = Times (a -> b -> b) (Times b Unit)
fold = S.fold
instance (Ord k) => Foldable (Map k a) where
type Algebra (Map k a) b = Times (k -> a -> b -> b) (Times b Unit)
fold = M.foldWithKey
class Mappable m where
type Contains m :: *
type Mapped m r b :: Constraint
map :: (Mapped m r b) => Curry (Contains m) b -> m -> r
instance (Ord a) => Mappable (Set a) where
type Contains (Set a) = Times a Unit
type Mapped (Set a) r b = (Ord b, r ~ Set b)
map = S.map
instance (Ord k) => Mappable (Map k a) where
type Contains (Map k a) = Times k (Times a Unit)
type Mapped (Map k a) r b = (Ord k, r ~ Map k b)
map = M.mapWithKey
Ok, if I understand you correctly, you can create inconvenient folds, but want to have convenient curried folds.
Below is an explanation how to achieve this as a separate step. Yes, it can also be done all at once, I've done something similar before. However, I think the separate phase makes it clearer what's going on.
We need the following language extensions:
{-# LANGUAGE TypeFamilies, TypeOperators, FlexibleInstances #-}
I'm using the following product and unit types:
data U = U
data a :*: b = a :*: b
infixr 8 :*:
As an example, let's assume we have an inconvenient version of a fold on lists:
type ListAlgType a r = (U -> r)
:*: (a :*: r :*: U -> r)
:*: U
inconvenientFold :: ListAlgType a r -> [a] -> r
inconvenientFold (nil :*: cons :*: U) [] = nil U
inconvenientFold a#(nil :*: cons :*: U) (x : xs) = cons (x :*: inconvenientFold a xs :*: U)
We have a nested product type, and we want to curry both levels. I'm defining two type classes for this, one for each layer. (It might be doable with one more general function, I haven't tried in this case.)
class CurryInner a where
type CurryI a k :: *
curryI :: (a -> b) -> CurryI a b
uncurryI :: CurryI a b -> a -> b
class CurryOuter a where
type CurryO a k :: *
curryO :: (a -> b) -> CurryO a b
uncurryO :: CurryO a b -> (a -> b) -- not really required here
Each type class implements the isomorphism between the curried and uncurried types. The type classes look identical, but CurryOuter will call CurryInner for each component of the outer nested tuple.
The instances are relatively straightforward:
instance CurryInner U where
type CurryI U k = k
curryI f = f U
uncurryI x = \ U -> x
instance CurryInner ts => CurryInner (t :*: ts) where
type CurryI (t :*: ts) k = t -> CurryI ts k
curryI f = \ t -> curryI (\ ts -> f (t :*: ts))
uncurryI f = \ (t :*: ts) -> uncurryI (f t) ts
instance CurryOuter U where
type CurryO U k = k
curryO f = f U
uncurryO x = \ U -> x
instance (CurryInner a, CurryOuter ts) => CurryOuter ((a -> b) :*: ts) where
type CurryO ((a -> b) :*: ts) k = CurryI a b -> CurryO ts k
curryO f = \ t -> curryO (\ ts -> f (uncurryI t :*: ts))
uncurryO f = \ (t :*: ts) -> uncurryO (f (curryI t)) ts
That's it. Note that
*Main> :kind! CurryO (ListAlgType A R) ([A] -> R)
CurryO (ListAlgType A R) ([A] -> R) :: *
= R -> (A -> R -> R) -> [A] -> R
(for suitably defined placeholder types A and R). We can use it as follows:
*Main> curryO inconvenientFold 0 (+) [1..10]
55
Edit: I now see you're actually only asking about currying the outer layer. You then only need one class, but can use the same idea. I used this example because I had written something for a sum-of-product based generic programming library which needed two levels of currying before, and thought at first you are in the same setting.
Ok, I think my other answer isn't actually really an answer to your question. Sorry for that.
In your final code, compare the types of fold and map:
fold :: Curry (Algebra m b) (m -> b)
map :: (Mapped m r b) => Curry (Contains m) b -> m -> r
There's a substantial difference here. The type of fold is just a type family application, whereas the type of map contains the final m -> r, mentioning the class parameter m. So in the case of map, it's easy for GHC to learn at which type you want to instance the class from the context.
Not so in the case of fold, unfortunately, because type families need not be injective, and therefore aren't easy to invert. So by seeing a particular type you use fold at, it's impossible for GHC to infer what m is.
The standard solution to this problem is to use a proxy argument that fixes the type of m, by defining
data Proxy m = P
and then giving fold this type instead:
fold :: Proxy m -> Curry (Algebra m b) (m -> b)
You have to adapt the instances to take and discard the proxy argument. Then you can use:
fold (P :: Proxy (Set Int)) (+) 0 (S.fromList [1..10])
or similar to call the fold function on sets.
To see more clearly why this situation is difficult for GHC to solve, consider this toy example instead:
class C a where
type F a :: *
f :: F a
instance C Bool where
type F Bool = Char -> Char
f = id
instance C () where
type F () = Char -> Char
f = toUpper
Now, if you call f 'x', there's no meaningful way for GHC to detect which instance you meant. The proxy would help here as well.
A type-level list is exactly what you need! You got very close, but you need the full power of both DataKinds and ScopedTypeVariables for this to work properly:
{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts, FlexibleInstances, TypeFamilies, TypeOperators, ScopedTypeVariables #-}
import GHC.Exts (Constraint)
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.Set as S
import qualified Data.Map as M
-- | A "multifunction" from a list of inhabitable types to an inhabitable type (curried from the start).
type family (->>) (l :: [*]) (y :: *) :: *
type instance '[] ->> y = y
type instance (x ': xs) ->> y = x -> (xs ->> y)
class Foldable (m :: *) where
type Algebra m (b :: *) :: [*]
fold :: forall (b :: *). Algebra m b ->> (m -> b)
instance (Ord a) => Foldable (Set a) where
type Algebra (Set a) b = '[(a -> b -> b), b]
fold = S.fold :: forall (b :: *). (a -> b -> b) -> b -> Set a -> b
instance (Ord k) => Foldable (Map k a) where
type Algebra (Map k a) b = '[(k -> a -> b -> b), b]
fold = M.foldWithKey :: forall (b :: *). (k -> a -> b -> b) -> b -> Map k a -> b
class Mappable m where
type Contains m :: [*]
type Mapped m (b :: *) (r :: *) :: Constraint
map :: forall (b :: *) (r :: *). Mapped m b r => (Contains m ->> b) -> m -> r
instance (Ord a) => Mappable (Set a) where
type Contains (Set a) = '[a]
type Mapped (Set a) b r = (Ord b, r ~ Set b)
map = S.map :: forall (b :: *). (Ord b) => (a -> b) -> Set a -> Set b
instance (Ord k) => Mappable (Map k a) where
type Contains (Map k a) = '[k, a]
type Mapped (Map k a) b r = r ~ Map k b
map = M.mapWithKey :: forall (b :: *). (k -> a -> b) -> Map k a -> Map k b
What is the type-class equivalent to the following existentially quantified dictionary, inspired by the Pipe type:
{-# LANGUAGE ExistentialQuantification, PolymorphicComponents #-}
data PipeD p = forall cat . PipeD {
isoI :: forall a b m r . Iso (->) (p a b m r) (cat m r a b),
categoryI :: forall m r . (Monad m) => CategoryI (cat m r) ,
monadI :: forall a b m . (Monad m) => MonadI (p a b m) ,
monadTransI :: forall a b . MonadTransI (p a b) }
The rough idea I'm going for is trying to say that given the (PipeLike p) constraint, we can then infer (MonadTrans (p a b), Monad (p a b m) and (using pseudo-code) (Category "\a b -> p a b m r").
The CategoryI and MonadI are just the dictionary equivalents of those type-classes that I use to express the idea that Category, Monad, and MonadTrans are (sort of) super-classes of this PipeLike type.
The Iso type is just the following dictionary storing an isomorphism:
data Iso (~>) a b = Iso {
fw :: a ~> b ,
bw :: b ~> a }
If this is indeed a type class, then the dictionary value is determined solely by the type p. In particular, the type cat is determined solely by p. This can be expressed using an associated data type. In a class definition, an associated data type is written like a data definition without a right-hand side.
Once you express cat as a type, the other members can easily be changed to type classes, as I've shown for Monad and MonadTrans. Note that I prefer to use explicit kind signatures for complicated kinds.
{-# LANGUAGE TypeFamilies, FlexibleInstances, UndecidableInstances #-}
class Pipe (p :: * -> * -> (* -> *) -> * -> *) where
data Cat p :: (* -> *) -> * -> * -> * -> *
isoI :: forall a b m r. Iso (->) (p a b m r) (Category p m r a b)
categoryI :: forall a b m. Monad m => CategoryI (Category p m r)
instance (Pipe p, Monad m) => Monad (p a b m)
instance Pipe p => MonadTrans (p a b)