Search code examples
haskelltypeclass

Complex ad-hoc polymorphism in Haskell


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


Solution

  • 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