On Vox: Ограниченное - часть 1

[migmit]

Некоторое время тому назад уважаемый hsenag описал способ превратить так называемую "ограниченную монаду" (restricted monad) в настоящую. Я в комментах там описал способ попроще и поэлегантнее; позднее я его расширил и теперь представляю интересующимся.

Что такое, собственно, ограниченная монада? Это то же самое, что и обычная монада, но имеющая смысл только тогда, когда тип, который она содержит, относится к некоторому классу. Характерный пример - множество, "Set". Мы не можем образовать "Set a", если "a" не относится к классу "Ord". В то же время, "Set" не так уж сильно отличается от "[]", и можно ожидать, что стандартный "do"-синтаксис окажется полезным и здесь. Однако, из-за указанного ограничения, превратить "Set" в монаду нельзя.

То, что я сказал, можно превратить в описание класса "OrdMonad" и его инстанса для "Set":

> module OrdMonadSet where
> import qualified Data.Set as Set

> class OrdMonad m where
>     ordReturn :: Ord a => a -> m a
>     ordBind :: (Ord a, Ord b) => m a -> (a -> m b) -> m b

> instance OrdMonad Set.Set where
>     ordReturn = Set.singleton
>     s `ordBind` f = Set.fold (\v ret -> f v `Set.union` ret) Set.empty s

Далее, в соответствии с тем, что сделано для монады "[]", можно также объявить аналог "MonadPlus":

> class OrdMonad m => OrdMonadPlus m where
>     ordMZero :: Ord a => m a
>     ordMPlus :: Ord a => m a -> m a -> m a

> instance OrdMonadPlus Set.Set where
>     ordMZero = Set.empty
>     ordMPlus = Set.union

В дальнейшем нам пригодится аналог функции "msum":

> ordMSum :: (OrdMonadPlus m, Ord a) => [m a] -> m a

> ordMSum = foldr ordMPlus ordMZero

Как же заставить "do"-синтаксис работать с такими "ограниченными монадами"? Ну, один из вариантов - использовать Template Haskell и руками преобразовать do-нотацию в выражение с "ordReturn" и "ordBind". Однако, использовать TH - значит признать своё поражение; мы поищем другой способ.

Один из способов сделать это внутри хаскеля описан в посте, на который выше стоит ссылка. Желающие могут посмотреть, как это сделано; я же изложу собственный вариант.

Для начала нам потребуются GADT-ы (без них, увы, никуда, разве что existential types вспомнить, а это то же самое).

> {-# LANGUAGE GADTs #-}
> module Rest1 where
> import Control.Monad
> import qualified Data.Set as Set
> import OrdMonadSet

Последний импорт - это импорт того модуля, который приведён выше; он содержит, в частности, класс "OrdMonad".

Тип данных, который мы будем использовать, содержит, собственно, два конструктора - аналоги >>= и return. Однако, поскольку цепочка >>= будет всегда начинаться с чего-то, относящегося к классу "Ord", мы можем ограничить один из типов:

> data OrdM m a where
>     ReturnOrdM :: a -> OrdM m a
>     BindOrdM :: Ord a => m a -> (a -> OrdM m b) -> OrdM m b

Теперь несложно объявить этот тип монадой. При этом мы будем использовать монадические законы - например, то, что "return x >>= f = f x". Именно эти законы предопределяют определение ">>=" для нашего типа "OrdM".

> instance Monad (OrdM m) where
>     return = ReturnOrdM
>     ReturnOrdM x >>= f = f x
>     BindOrdM mx g >>= f = BindOrdM mx $ \x -> g x >>= f

Далее, нужно найти способ перегнать нашу "ограниченную монаду" в настоящую:

> embed :: Ord a => m a -> OrdM m a
> embed mx = BindOrdM mx return

и обратно:

> unembed :: (OrdMonad m, Ord a) => OrdM m a -> m a
> unembed (ReturnOrdM x) = ordReturn x
> unembed (BindOrdM mx g) = mx `ordBind` (unembed . g)

Уже неплохо. Однако, нам нужно работать ещё и с "OrdMonadPlus". Увы, даже если есть инстанс "OrdMonadPlus" для "m", превратить "OrdM m" в инстанс "MonadPlus" не удаётся.

Решение по ссылке выше - добавить в "OrdM" парочку конструкторов, скажем, "OrdMZero" и "OrdMPlus". Мне это решение не нравится, так как не учитывает законы, связанные с "mzero" и "mplus" - например, ассоциативность. Вместо этого я буду просто хранить список, элементы которого - по сути те же, что и раньше. "mzero" превратится в пустой список, а "mplus" - в конкатенацию.

> data OrdPlusData m a where
>     ReturnOrdPlus :: a -> OrdPlusData m a
>     BindOrdPlus :: Ord a => m a -> (a -> OrdP m b) -> OrdPlusData m b

> newtype OrdP m a = OrdP {fromOrdP :: [OrdPlusData m a]}

Для "OrdP" я объявлю - по сути, точно так же - инстанс класса "Monad":

> instance Monad (OrdP m) where
>     return x = OrdP [ReturnOrdPlus x]
>     OrdP omxs >>= f = OrdP $ omxs >>= handleOmx
>         where handleOmx (ReturnOrdPlus x) = fromOrdP $ f x
>               handleOmx (BindOrdPlus mx g) = [BindOrdPlus mx $ \x -> g x >>= f]

Правда, разбор случаев пришлось упаковать во вспомогательную функцию "handleOmx"; заметьте, что в выражении ">>= handleOmx" оператор ">>=" - это ">>=" для монады-списка, то есть, по сути, "concatMap".

Теперь можно определить и инстанс "MonadPlus":

> instance MonadPlus (OrdP m) where
>     mzero = OrdP []
>     OrdP omxs1 `mplus` OrdP omxs2 = OrdP $ omxs1 ++ omxs2

Наконец, нам понадобятся варианты функций "embed" и "unembed" для "OrdP":

> embedPlus :: Ord a => m a -> OrdP m a
> embedPlus mx = OrdP [BindOrdPlus mx return]

> unembedPlus :: (OrdMonadPlus m, Ord a) => OrdP m a -> m a
> unembedPlus (OrdP omxs) = ordMSum $ map handleOmx omxs
>     where handleOmx (ReturnOrdPlus x) = ordReturn x
>           handleOmx (BindOrdPlus mx g) = mx `ordBind` (unembedPlus . g)

Это те же определения, что и для "OrdM", только опять-таки разбор случаев запихнут в ">>= handleOmx"

Теперь можно писать такие, например, вещи:

> test = unembedPlus $ do x <- embedPlus $ Set.fromList [6, 2, 3]
>                         (do y <- return x
>                             z <- embedPlus $ Set.fromList [1..2]
>                             guard $ y < 5
>                             return $ y + z)
>                         `mplus` return 10

Запускаем, получаем:

*Rest1> test
fromList [3,4,5,10]

Originally posted on migmit.vox.com