Монада ContT в картинках (Haskell)

На хабре уже были статьи про продолжения и монаду ContT. Я решил поделиться своим пониманием этого вопроса и снабдить его соответствующими иллюстрациями. В отличие от приведенной выше статьи, мне бы хотелось больше внимания уделить внутреннему устройству монады ContT и разобраться, как же она работает.

ContT изнутри

Для начала взглянем на определение ContT.

newtype ContT r m a = ContT {runContT :: ((a -> m r) -> m r)}

Глядя на тип, как-то сразу становится не по себе. А от типа callCC становится еще больше не по себе.

callCC :: ((a -> m b) -> m a) -> m a

Давайте разбираться.
Для начала стоит заметить, что если у вас есть переменная типа "(a->m r)->m r", то это почти то же самое, как если бы у вас была переменная типа «a». Вот смотрите. Допустим, у вас есть переменная типа «a» и функция «a-> m r». Вы можете применить одно к другому и получить результат «m r»:

a -> m r                 $            a         =             m r

А теперь представьте, что у вас переменная типа "(a->m r)->m r" и функция «a -> m r». Вы точно так же можете применить одно к другому и получить свой результат:

(a -> m r) -> m r        $      (a -> m r)      =             m r

Перейдем к картинкам.
Вот таким кружочком со стрелочкой мы будем обозначать некоторый объект типа «a»


Функция типа «a->b» будет выглядеть, как кружочек, который имеет вход и выход:


Тогда наш ContT будет выглядеть, как колечко:


Если мы применим функцию «a->b» к объекту "(a->m r) -> m r", то получится следующее:


А сейчас самое главное. Мы помним, что ContT — это монада, значит для неё определены функции return и bind. Посмотрим, что же они делают.

С return все довольно просто. Она подставляет объект в передаваемую функцию, а результат напрямую возвращает наружу.
А вот так работает bind.

Как видите, одно колечко вложилось в другое. Т.е. каждое новое вычисление вкладывается в предыдущее. Тут есть, над чем подумать. Текущее вычисление получает все последующие вычисления в качестве функции. Это значит, что оно может вызвать эту функцию, чтобы вычислить результат. Или вызвать её несколько раз, а результаты скомбинировать. А может и не вызывать вовсе, а сразу вернуть результат.

Примеры

Работа с файлами

Допустим, нам нужно открыть файл, прочитать в нем имя другого файла, потом открыть его, в нем прочитать имя третьего файла, открыть третий файл и вывести содержимое на экран. Обычно мы написали бы что-то вроде этого.

withFileContent :: FilePath -> (String -> IO a) -> IO a 
withFileContent file fun = withFile file ReadMode $ \h -> hGetContents h >>= fun

main = do 
	withFileContent "1.txt" $ \file1_content -> do 
		withFileContent file1_content $ \file2_content -> do 
			withFileContent file2_content $ \file3_content -> do 
				print file3_content

Здесь видно, как увеличиваются отступы с каждым новым открытым файлом. Было бы здорово переписать этот кусок, чтобы все файлы открывались внутри одной монады. Посмотрим на функцию withFileContent. Мы видим, что её тип очень похож на тип ContT. Давайте теперь перепишем наш пример с помощью монады ContT.

doContT cont = runContT cont (const $ return ()) 

main = doContT $ do 
	file1_content <- ContT $ withFileContent "1.txt" 
	file2_content <- ContT $ withFileContent file1_content  
	file3_content <- ContT $ withFileContent file2_content
	liftIO $ print file3_content 

Так уже гораздо красивее. Отгадайте, как будет работать эта программа? Файлы сначала откроются в заданной последовательности, потом результат выведется на экран, а потом файлы закроются в обратной последовательности. Разве не здорово!

Конструкторы, деструкторы

Допустим, для работы с некоторым объектом нам нужно сначала вызвать для него конструктор, а после работы — деструктор. Создадим класс типов для таких объектов.

class Constructed a where 
	constructor :: a -> IO ()
	destructor :: a -> IO ()

Создадим какой-нибудь тестовый объект.

newtype Obj a = Obj a

instance (Show a) => Constructed (Obj a) where 
	constructor (Obj a) = putStr $ "constructor for " ++ (show a) ++ "\n"
	destructor (Obj a) = putStr $ "destructor for " ++ (show a) ++ "\n"

Напишем функцию withConstructed для работы с такими объектами в ContT. Теперь у них автоматически будут вызываться конструкторы и деструкторы (в обратном порядке).

withConstructed :: (Constructed a) => a -> ContT r IO a 
withConstructed obj = ContT $ \fun -> do 
	constructor obj
	rez <- fun obj
	destructor obj
	return rez

main = doContT $ do 
	a <- withConstructed $ Obj "ObjectA" 
	b <- withConstructed $ Obj "ObjectB" 
	c <- withConstructed $ Obj "ObjectC" 
	liftIO $ putStr "do something\n"
{- результат:
constructor for "ObjectA"
constructor for "ObjectB"
constructor for "ObjectC"
do something
destructor for "ObjectC"
destructor for "ObjectB"
destructor for "ObjectA"
-}

Прерывание вычислений

Предыдущие примеры были довольно простыми и, по сути, одинаковыми. А как нам с помощью ContT вернуть некоторый результат, не дожидаясь окончания вычислений? Рассмотрим пример. Допустим, имеется некоторое вычисление в ContT.

calc :: ContT r m Int
calc = do 
	x <- return 10
	y <- return $ x*2
	z <- return $ x + y
	return z

main = runContT calc print  
-- результат: 30

Перепишем calc следующим образом

calc = ContT $ \k -> runContT (do     -- <- убрали/добавили конструктор
	x <- return 10
	y <- return $ x*2
	z <- return $ x + y
	return z) k

main = runContT calc print  
-- результат: 30

Мы ничего не поменяли, просто убрали конструктор, а потом снова завернули в конструктор.
Теперь добавим строчку.

calc = ContT $ \k -> runContT (do 
	x <- return 10
	y <- return $ x*2
	ContT $ \c -> c 5     -- <- добавили строчку (эквивалентно "return 5")
	z <- return $ x + y
	return z) k

main = runContT calc print  
-- результат: 30

Результат по-прежнему не изменился. Не удивительно, ведь строка «ContT $ \c -> c 5» эквивалентна строке «return 5».
А теперь самое сложное. Давайте заменим «c» на «k».

calc = ContT $ \k -> runContT (do 
	x <- return 10
	y <- return $ x*2
	ContT $ \c -> k 5         --  <- здесь мы поменяли "c" на "k"
	z <- return $ x + y
	return z) k

main = runContT calc print    -- <- функция "print" передается в ContT
-- результат: 5               -- <- результат изменился

Мы видим, что результат теперь равен 5. Довольно сложно объяснить, что же тут произошло, но я попытаюсь. Рассмотрим рисунок.

Оранжевое колечко — это наша локальная переменная «c». Это те вычисления, которые идут после строки «ContT $ \c -> k 5». Зеленый кружочек — это наша переменная «k». Если мы посмотрим дальше по коду, то увидим, что «k» — это ни что иное, как функция print.
Таким образом, мы передаем наше значение «5» в переменную «c», которая в свою очередь использует функцию print, чтобы вывести результат на экран. Если мы заменим «c» на «k», то получим следующую картину.

Теперь мы игнорируем все последующие вычисления и сразу передаем значение «5» в функцию «print».
Далее я больше не буду менять поведение программы, а буду просто производить эквивалентные преобразования кода. Для начала «вынесем за скобки» нашу константу «5».

calc = ContT $ \k -> runContT (do 
	x <- return 10
	y <- return $ x*2
	(\a -> ContT $ \c -> k a) 5    -- <- абстрагировались по переменной "a"
	z <- return $ x + y
	return z) k

Вынесем за скобки лямбду "(\a -> ContT $ \c -> k a)".

calc = ContT $ \k -> runContT ((\exit -> do   -- <- абстрагировались по переменной "exit"
	x <- return 10
	y <- return $ x*2
	exit 5
	z <- return $ x + y
	return z) (\a -> ContT $ \c -> k a)) k

Теперь вынесем все выражение "\exit -> do… return z".

calc = (\f -> ContT $ \k -> runContT (f (\a -> ContT $ \c -> k a)) k) $ \exit -> do  
--       ^ абстрагировались по переменной "f"
	x <- return 10
	y <- return $ x*2
	exit 5
	z <- return $ x + y
	return z

Надо бы создать отдельную функцию с телом "(\f -> ContT… k a)) k)". Кстати, поздравляю! Мы только что изобрели велосипед функцию callCC.

callCC f = ContT $ \k -> runContT (f (\a -> ContT $ \_ -> k a)) k 

calc = callCC $ \exit -> do    -- <- вынесли в отдельную функцию "callCC"
	x <- return 10
	y <- return $ x*2
	exit 5
	z <- return $ x + y
	return z

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

P.S.

Попытался таким же образом вывести тело функции getCC и понял, что мозгов на это уже не хватает. Может у вас получится.