Interfaces - the Golden Path of Haskell?
Wvv
vitea3v at rambler.ru
Sat Jul 6 20:10:38 CEST 2013
We already could define
{-# LANGUAGE PolyKinds, FlexibleContexts, TypeFamilies, FlexibleInstances,
UndecidableInstances, RankNTypes #-}
module Monoids where
import Control.Monad
import Control.Arrow
class Monoid (a :: k) where
type PrE a :: *
mempty :: PrE a
mappend :: PrE a -> PrE a -> PrE a
instance Monoid [b] where
type PrE [b] = [b]
mempty = []
mappend = (++)
instance (Monad m, MonadPlus m) => Monoid ( m b ) where
type PrE (m b) = m b
mempty = mzero
mappend = mplus
instance (Arrow a, ArrowPlus a, ArrowZero a) => Monoid ( a b c ) where
type PrE (a b c) = a b c
mempty = zeroArrow
mappend = (<+>)
And this program is valid.
We can't use it at all, but as we see, the GHC is already has most features
to implement -XClassInterfaces extension.
I suggest to write this program like this:
{-# LANGUAGE ClassInterfaces, PolyKinds, FlexibleContexts, TypeFamilies,
FlexibleInstances, UndecidableInstances, RankNTypes #-}
module Monoids where
import Control.Monad
import Control.Arrow
class interface Monoid (a :: k) where
type PrE a :: *
mempty :: PrE a
mappend :: PrE a -> PrE a -> PrE a
class Monoid [b] where
type PrE [b] = [b]
mempty = []
mappend = (++)
class (Monad m, MonadPlus m) => Monoid (forall b. m b ) where
type PrE (m b) = m b
mempty = mzero
mappend = mplus
class (Arrow a, ArrowPlus a, ArrowZero a) => Monoid (forall b, c. a b c)
where
type PrE (a b c) = a b c
mempty = zeroArrow
mappend = (<+>)
that's all!
--
View this message in context: http://haskell.1045720.n5.nabble.com/Interfaces-the-Golden-Path-of-Haskell-tp5732208p5732515.html
Sent from the Haskell - Haskell-prime mailing list archive at Nabble.com.
More information about the Haskell-prime
mailing list