Интуиция тайпкласса Traversable

Тайпкласс Data.Traversable базируется на функториальных, фолдабельных абстракциях и представляет собой такие (часто контейнерные) структуры данных, которые можно последовательно погрузить в некоторый аппликативный контекст с сохранением формы структуры.

Проще говоря, траверсабельные контейнеры позволяют замапить все элементы структуры в вычислительный контекст, произвести эти вычисления слева-направо и собрать результат в контексте внутри точно такого-же контейнера.

Если Data.Foldable подразумевает полное разрушение формы контейнера в процессе последовательной свёртки, т. е. создания дайджеста, то Data.Traversable гарантирует полную целостность формы контейнера в процессе последовательного выполнения аппликативных вычислений над его содержимым.

Базовый интерфейс траверсабельных типов - это функция traverse, имеющая следующую сигнатуру:

traverse :: Applicative f => (a -> f b) -> t a -> f (t b)

Реализация

Для того чтобы получить доступ к интерфейсу тайпкласса Traversable достаточно реализовать одну из следующих двух функций:

class (Functor t, Foldable t) => Traversable t where
  -- Замапить элементы в вычисления, выполнить их слева-направо и собрать результат
  traverse :: Applicative f => (a -> f b) -> t a -> f (t b)

  -- | Выполнить каждое вычисление внутри самой структуры и собрать результат
  sequenceA :: Applicative f => t (f a) -> f (t a)

Ниже мы напишем обе эти функции для уже знакомого нам типа List a:

-- Тип для нашего списка
data List a = Cons a (List a) | Nil

-- Пример списка
li = Cons 1 (Cons 2 (Cons 3 (Cons 4 (Cons 5 Nil))))

Как видно из объявления тайпкласса Traversable выше, все траверсабельные типы должны быть фолдабельными функторами, поэтому для начала создадим эти instances.

instance Functor List

Применяем функцию к вершине и продолжаем с хвостом рекурсивно:

instance Functor List where
  -- Functor f => (a -> b) -> f a -> f b
  fmap _ Nil = Nil
  fmap f (Cons x li) = Cons (f x) (fmap f li)

Результат:

> fmap (+100) li
Cons 101 (Cons 102 (Cons 103 (Cons 104 (Cons 105 Nil))))

instance Foldable List

Ранее мы уже создавали такую реализацию:

instance Foldable List where
  -- foldr :: (a -> b -> b) -> b -> t a -> b
  foldr _ acc Nil = acc
  foldr f acc (Cons x li) = f x (foldr f acc li)

Результат:

> foldMap Sum li
Sum {getSum = 15}
> foldr (+) 100 li
115

instance Traversable List

Реализация при помощи traverse

Вспомним функцию liftA2 (то же, что и f <$> a <*> b):

-- Втягивание обычных бинарных функций в данный аппликативный контекст
liftA2 :: (a -> b -> c) -> f a -> f b -> f c

Используем её для погружения в данный аппликативный контекст функцию-конструктор нашего списка Cons :: a -> List a -> List a, то есть бинарную операцию от двух разных типов: a (элемента) и List a (хвоста списка). Нетрудно догадаться, что мы можем просто сделать свёртку по liftA2, получив копию нашего списка в аппликативном контексте:

> foldr (\x acc -> liftA2 Cons (pure x) acc) (pure Nil) li
Cons 1 (Cons 2 (Cons 3 (Cons 4 (Cons 5 Nil)))) -- как-будто в контексте

Однако в traverse имеется своя функция, которая используется для генерации аппликативного функтора. Её и будем применять к первому аргументу Cons:

instance Traversable List where
  -- traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
  traverse f li = foldr (\x acc -> liftA2 Cons (f x) acc) (pure Nil) li

Или после эта-редукции в point-free стиле:

instance Traversable List where
  traverse f = foldr (liftA2 Cons . f) (pure Nil)

Результат:

> traverse (\x -> print x >> return (100 + x)) li
1
2
3
4
5
Cons 101 (Cons 102 (Cons 103 (Cons 104 (Cons 105 Nil))))

> -- аналог цикла for в императивных языках
> forM li (const (putStr "*BEEP* ")) >> putStrLn "*END*"
*BEEP* *BEEP* *BEEP* *BEEP* *BEEP* *END*

Стоить напомнить один замечательный математический факт: все монады являются аппликативными функторами!

Реализация при помощи sequenceA

В данной функции нам дан наш контейнер, внутри (не снаружи!) которого лежат элементы в аппликативном контексте. Что ж, воспользуемся конструктором для пересборки всего списка в таком контексте, рекурсивно ветвясь вправо как при foldr:

instance Traversable List where
  -- sequenceA :: Applicative f => t (f a) -> f (t a) 
  sequenceA Nil = pure Nil
  sequenceA (Cons fx li) = liftA2 Cons fx (sequenceA li)

Результат идентичный:

> forM li (const (putStr "*BEEP* ")) >> putStrLn "*END*"
*BEEP* *BEEP* *BEEP* *BEEP* *BEEP* *END*

Data.Bitraversable

Битраверсабельные структуры дают возможность параллельного traverse не на одном (и единственном) наборе элементов, а на всех двух наборах, может быть имеющих различные типы:

class (Bifunctor t, Bifoldable t) => Bitraversable t where
  bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)

Аппликативный контекст при этом, разумеется, один и тот же. Для любого битраверсабельного типа, соответственно, bitraverse определяет “аппликативный обход” каждой из двух его проекций. В стандартной библиотеке Haskell не так уж много Data.Bitraversable:

instance Bitraversable (,) where
  bitraverse f g (a, b) = liftA2 (,) (f a) (g b)

instance Bitraversable Either where
  bitraverse f _ (Left a) = Left <$> f a
  bitraverse _ g (Right b) = Right <$> g b

Создадим реализацию Data.Bitraversable для простого типа пар, изоморфного (a, b):

data Pair a b = Pair a b

Bifunctor Pair

Простейший бифунктор:

instance Bifunctor Pair where
  -- bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
  bimap f1 f2 (Pair a b) = Pair (f1 a) (f2 b) 

Bifoldable

С бифолдабельностью интереснее, поскольку при разрушении структуры встаёт выбор проекций: обе они равноправны. Воспользуемся моноидальностью и просто склеим проекции!

instance Bifoldable Pair where
  -- bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
  -- bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m
  bifoldMap f1 f2 (Pair a b) = f1 a `mappend` f2 b

Моноид должен быть один:

> bifoldMap Sum Sum  (100, 200)
Sum {getSum = 300}

Bitraversable Pair

Реконструкция пары в аппликативном контексте:

instance Bitraversable Pair where
   bitraverse f1 f2 (Pair a b) = liftA2 Pair (f1 a) (f2 b)

Пример:

>let mm = map . map
> bitraverse (mm toUpper) (mm toLower) (["FirstOfPair"], ["SecondOfPair"])
[("FIRSTOFPAIR","secondofpair")]