Encoding Typeclass Default Methods in Purescript

The cons is, always in need of annotations.

module Main where

import Prelude

import Effect (Effect)
import Effect.Console (log)
import Data.Array

newtype F f = F {fmap :: forall a b. (a -> b) -> f a -> f b}

newtype MBase m = MBase {
    return :: forall a. a -> m a
    , join :: forall a. m (m a) -> m a
}

newtype M m = M {
    mcomp :: forall a b c. (a -> m b) -> (b -> m c) -> (a -> m c)
, return :: forall a. a -> m a
, join :: forall a. m (m a) -> m a
}

class Implicit label i | label -> i where
inst :: label -> i

data MD = MD
data MBaseD = MBaseD
data FD = FD

mkM :: forall m.
    F m ->
    MBase m ->
    M m

mkM (F functor) (MBase mbase) =
M {
    return: \x -> mbase.return x
, join: \x -> mbase.join x
, mcomp: \k1 k2 a -> mbase.join $ functor.fmap k2 (k1 a)
}

instance implicitFDM ::
    ( Implicit FD (F m)
    , Implicit MBaseD (MBase m)
    )  => Implicit MD (M m) where
    inst _ = mkM functor mbase

    where functor = inst FD
            mbase   = inst MBaseD

instance functorList :: Implicit FD (F Array) where
inst _ = F {fmap: map}

instance monadList :: Implicit MBaseD (MBase Array) where
inst _
    = MBase {
    return: singleton
    , join: concat
    }

bind :: forall m a b. Implicit MD (M m) => m a -> (a -> m b) -> m b
bind m k =
let (M r) = inst MD in
(r.mcomp (\unit -> m) k) unit

l :: Implicit MD (M Array) => Array Int
l = bind (r.return 1) $ \x -> [x, x]
where M r = inst MD

main :: Effect Unit
main =
log $ show l -- [1, 1]