Miguel

20:03: Выбор как обратная связь

> module Strict where
> import Prelude hiding (id, (.))
> import Control.Arrow
> import Control.Category

Написалась тут у меня некая функция. Поведение у неё следующее:

*Strict> lft (+1) (Left 5)
Left 6
*Strict> lft (+1) (Right "aaa")
Right "aaa"

Казалось бы, ну и что? Такую функцию написать очень несложно, а проще всего — воспользоваться стандартной фунцией left.

Однако, тип у неё — другой. Именно:

*Strict> :t lft
lft :: ArrowLoop a => a x y —> a (Either x z) (Either y z)

Именно так. Не ArrowChoice, а ArrowLoop.

Вот как эта функция устроена.

> lft :: ArrowLoop a => a x y -> a (Either x z) (Either y z)
> lft a = loop $ f ^>> second (id &&& a) where
>     f (Left x, ~(x1, y1)) = (Left y1, x)
>     f (Right y, ~(x1, y1)) = (Right y, x1)

Фокус вот в чём. Допустим на вход поступило некое Left x. Функция должна выбрать некие x1 и y1. Затем x1 отбрасывается (то есть, неважно, какое x1 было выбрано), а остальное превращается в (Left y1, x). Затем первая часть (Left y1) остаётся без изменений, а вторая... вторая превращается в (x, y), где y — результат действия a на x. За счёт loop именно эта пара станет исходными (x1, y1), что означает, в частности, что y1 — это то же самое, что y, то есть результат действия a на x. Но именно Left y1 идёт на выход — получается то, что нам и нужно.

Если же на вход поступает Right y, то, опять-таки, функция выбирает некие x1 и y1, составляет пару (Right y, x1), затем первую часть оставляет без изменения, а вторую превращает в (x1, y2), где y2 — результат действия a на x1. В любом случае, на выход идёт то же самое Right y — опять, что и требуется.

К сожалению, у такой функции есть заметное отличие от left. Именно, функция left позволяет выбирать — производить ли некоторый эффект, или не стоит. В данном случае эффект производится вне зависимости от того, что именно пришло на вход, причём если на вход поступил Right y, то эффект будет произведён с неизвестно чем в качестве входного параметра. Лучше всего это видно на примере монады IO:

*Strict> runKleisli (lft (Kleisli putStrLn)) (Left "xxx")
xxx
Left ()

Тут пока всё в порядке.

*Strict> runKleisli (lft (Kleisli putStrLn)) (Right 1)
*** Exception: <<loop>>

Да, попытка напечатать неопределённую строку приводит именно к такому результату.

Ещё очень забавно смотрится монада []:

*Strict> runKleisli (lft (Kleisli (replicate 5))) (Left 1)
[Left 1,Left 1,Left 1,Left 1,Left 1]

— как и ожидалось; но

*Strict> runKleisli (lft (Kleisli (replicate 5))) (Right 2)
[Right 2,Right 2,Right 2,Right 2,Right 2]

Для сравнения, функция left ведёт себя во втором случае совершенно иначе:

*Strict> runKleisli (left (Kleisli (replicate 5))) (Right 2)
[Right 2]

В этом тесте произведённый эффект, по сути, не зависел от пришедшего параметра. Если же он будет зависеть от него,

*Strict> runKleisli (lft (Kleisli (\n —> replicate n n))) (Left 3)
[Left 3,Left 3,Left 3]

как вот здесь, то вызов

*Strict> runKleisli (lft (Kleisli (\n —> replicate n n))) (Right 4)

благополучно зависает.

Вот.

22:02: Студия
Стоит на работе Visual Studio. Используется, в основном, как текстовый редактор, но, в общем и целом, справляется.

Сегодня в какой-то момент возник глюк. А именно, перестал работать поиск. Вообще. Любая операция поиска приводила к маловразумительному сообщению об ошибке — что-то типа того, что, дескать, нет ни одного файла, в котором можно было бы искать, и вообще поиск кто-то прервал, пока он ещё начаться не успел.

На этом месте некоторые товарищи уже всё поняли. Для остальных продолжаю.

Ну, я закрыл студию. Открыл заново. Баг есть.

Закрыл студию, удалил .suo-файл. И .ncb, заодно. Открыл студию, открыл солюшен. Баг есть.

Говорят, что баг остаётся даже после того, как перегрузишь комп. Я до этого не дошёл, но был близок. К счастью, идея "подёргать гугль" пришла ко мне раньше.

Я набрёл на пост как раз с этой проблемой. Там предлагалось решение. Оно сработало. Под катом, для большего драматического эффекта:
( Read more... )

13:14: Котята нужны кому-нибудь?
Начали активно раздавать. В наличии трое: две серых-полосатых девочки, почти неотличимых внешне, и один мальчик неопределённой расцветки: родился антрацитово-чёрным, но впоследствии из под чёрной шерсти стала пробиваться белая, и, в настоящий момент, мы имеем частично седого кота.

"Активная раздача" не означает, что можно прямо сегодня приехать и забрать, но выбрать уже можно; думаю, до НГ они дойдут до кондиции.

( Фотографии: )

08:21: Политическое
Допустим, неподалёку от избирательного участка встаёт некий человек и начинает бесплатно раздавать всем, кто туда идёт, игральные кубики. На которых к шестёрке пририсована ещё одна точка.

Через какое время организаторы этого цирка врубятся?

17:28: Про объективную реальность и всякое такое
Свалю мысли в кучу, чтобы потом было, куда посылать оппонентов за прояснением моей позиции.

Итак. Есть чувственный опыт. Мой. Личный. Я чувствую клавиши под пальцами и вижу буковки на экране. Всё ещё чувствую клавиши и вижу буковки. Вижу буковки, которые складываются в слова, говорящие о том, что я вижу буковки.

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

О, заговорил. "<вырезано цензурой> <вырезано цензурой>, ты, <вырезано цензурой>". Как пример сойдёт.

Так вот, опыт этот не так-то просто описать и систематизировать. Напрямую описывать "вот, мне в уши сейчас поступили такие-то звуки" - неэффективно. Нужно выявить некие закономерности. А они не хотят выявляться без введения неких дополнительных понятий. Ну, так получается. Что поделаешь. Иными словами, нужна некая модель.

И такая модель есть. Человечество её придумало очень давно, ещё не осознавая, что оно делает. Модель эта называется "объективная реальность".

То есть, мы строим модель, согласно которой есть некая объективная реальность, и в этой реальности происходят некие события - скажем, с грохотом валится в лесу дерево. Я же воспринимаю эту реальность через неэффективные органы чувств. При этом моё восприятие - это не только огрубление объективной реальности, возможны и более сильные отклонения, но - что приятно - эти отклонения укладываются в рамки той же реальности, как вызванные несовершенством моего организма (существующего в этой же "объективной реальности"). Скажем, если в рамках "объективной реальности" я упился в стельку, моё восприятие, мой чувственный опыт может совершенно не соотноситься с этой самой "объективной реальностью".

Зачем нужна эта "объективная реальность", если то, что у меня точно есть - чувственный опыт - с этой реальностью не совпадает? А её гораздо проще описывать и систематизировать. На то существует наука. И при этом чувственный опыт всё-таки сильно коррелирован с "объективной реальностью".

Вопрос: а что на самом деле, эта "объективная реальность" действительно существует? Ответ: а определения слов "на самом деле" и "существует" дать не хотите ли? Я знаю только одно определение: "существует" - значит "существует в этой модели". То же относится к "на самом деле". В этом смысле ответ является своего рода тавтологией: да, конечно, "объективная реальность" существует в нашей модели - модель так построена.

Вы имели в виду какое-то другое "существование"? Соблаговолите объяснить, какое. Пока не услышу объяснение - отвечать не буду.

Что-что? Представить, что я, "на самом деле", всего лишь программа в большом компьютере, который эмулирует для меня эту "объективную реальность"? Да пожалуйста, я готов и такую модель рассматривать, только она а) сложнее уже существующей, б) ничего нового не даёт.

Говорите, что, дескать, должно быть какое-то "на самом деле"? А почему, собственно? Кому должно? А если даже какое-то "на самом деле", кроме того, о котором я выше говорил, имеет место - почему только одно?

В этих терминах вопрос о существовании бога решается на раз: бог в модели "объективной реальности" отсутствует. В вашей присутствует? Что ж, я вынужден заключить, что вы предпочитаете более сложные модели, не дающие ничего нового. Имеете право, но хуже от этого будет именно вам.

Вопрос "веры" в "объективную реальность" не стоит - у меня есть модель, мне не надо "верить" во что-то, чтобы ею пользоваться. Модель хорошая, так как может обеспечить мне более приятный чувственный опыт. Опять же, я могу, как в "1984", использовать двойственную астрономию - разница только в том, какой моделью пользоваться проще.

А значит, религии, не дающие своему последователю мистического опыта, отпадают сразу - это, опять же, более сложные модели с теми же результатами. Вот фокусы деда Кастанеды - это уже ближе. Правда, если принять такую модель, придётся либо строить физику заново (не факт, что получится), либо примириться с моделью, сляпанной из двух кусков. Последнее не так уж и плохо, но нужно понять, даёт ли такая модель хоть чуть-чуть более точные результаты, и оправдано ли усложнение модели этим повышением точности.

Вот. Как-то так.

17:16: Подмешиваем эффекты - практика
Продолжение. Начало здесь

> {-# LANGUAGE Arrows, GADTs, GeneralizedNewtypeDeriving, Rank2Types, TupleSections, TypeOperators #-}

Выглядит страшно, но, на самом деле, ничего серьёзного здесь нет. Лишь два расширения из этих шести добавляют настоящие возможности, а остальные четыре дают лишь удобный синтаксический сахар — позволяют использовать стрелочный синтаксис (забегая вперёд, скажу, что он нам понадобится только в примерах), позволяют автоматически выводить типы для newtype-ов, упрощают частичное применение оператора (,) и упрощают запись сложных типов. Синтаксический сахар. Но очень удобный. Но сахар. Но по пять рублей.

> module Mix where
> import Prelude hiding (id, (.))

Очень рекомендую ставить эту строчку всегда, когда используются стрелки. Дело в том, что модуль Control.Category экспортирует свои, более общие в смысле типов определения id и (.). А если есть более общие — зачем нам их конфликты с менее общими?

> import Control.Arrow
> import Control.Category

Для примеров — и только для примеров — мы будем использовать монаду State:

> import Control.Monad.State

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

> swap ~(a, b) = (b, a)
> twist ~((a, b), c) = ((a, c), b)
> assocLtoR ~((a, b), c) = (a, (b, c))
> assocRtoL ~(a, (b, c)) = ((a, b), c)

Заметим, что в модуле Data.Tuple имеется аналогичная функция swap, но она излишне строга — здесь мы используем ленивые паттерны где только можно. Не проверял, важно ли это, но для типов с одним конструктором лучше использовать ленивый паттерн всегда (если только это не newtype, потому что для него ленивый и строгий паттерн-матчинг означает одно и то же).
Ещё несколько функций, которые делают то же самое (перетасовывают элементы) со стрелками:

> arrTwist :: Arrow a => a ((ia, ib), ic) ((oa, ob), oc) -> a ((ia, ic), ib) ((oa, oc), ob)
> arrTwist a = twist ^>> a >>^ twist
> arrAssocLtoR :: Arrow a => a ((ia, ib), ic) ((oa, ob), oc) -> a (ia, (ib, ic)) (oa, (ob, oc))
> arrAssocLtoR a = assocRtoL ^>> a >>^ assocLtoR
> arrAssocRtoL :: Arrow a => a (ia, (ib, ic)) (oa, (ob, oc)) -> a ((ia, ib), ic) ((oa, ob), oc)
> arrAssocRtoL a = assocLtoR ^>> a >>^ assocRtoL
> arrCancelUnit :: Arrow a => a (i, ()) (o, ()) -> a i o
> arrCancelUnit a = (,()) ^>> a >>^ fst

Теперь начинается самое интересное. Мы вводим морфизм стрелок — как я говорил, мы будем одну стрелку переделывать в другую — в стрелку (->), чтобы быть точным.

> type f :~> g = forall i o. f i o -> g i o

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

> type Along a i o input output = a (input, i) (output, o)

Это оно самое — стрелка с двумя входами и двумя выходами, которая у нас несколько раз встречалась в диаграммах.
И, наконец, наш тип:

> data Mix a b input output where Mix :: (Along a i o :~> a) -> Along b i o input output -> Mix a b input output

В наивном варианте первый аргумент конструктора имел бы просто тип a o i, но мы используем продвинутый вариант.
Поднимаем наши исходные стрелки:

> liftA :: (ArrowLoop a, Arrow b) => a input output -> Mix a b input output
> liftA a = Mix (\al -> loop $ al >>> second a) (arr swap)

Здесь тип i будет совпадать с output, а тип o — с input.
Важно отметить, что заведомо нечистая часть идёт в этом случае после той части, которая может быть чистой. Именно за счёт этого мы избавляемся от неправильных цикловых зависимостей, когда что-то нечистое зависит от того, что реально считается позднее. Желающие могут заменить это определение на такое:

liftA a = Mix (\al -> loop $ second a >>> al) (arr $ swap . first Left)

и попробовать запустить те же примеры (приведённые ниже) в таком варианте. "Expression: <<loop>>", вот что получится в результате.

> liftB :: (Arrow a, Arrow b) => b input output -> Mix a b input output
> liftB b = Mix arrCancelUnit (first b)

Ну, далее нужно делать наши циклы стрелками. Заметим, кстати, что мы сохраняем порядок эффектов в композиции: мы хотим сначала сделать a1, а потом — a2.

> instance (Arrow a, Arrow b) => Category (Mix a b) where
>     id = liftB id
>     Mix a2 b2 . Mix a1 b1 = Mix (a2 . a1 . arrAssocRtoL) (arrAssocLtoR $ twist ^>> first b1 >>> twist ^>> first b2)
> instance (Arrow a, Arrow b) => Arrow (Mix a b) where
>     arr = liftB . arr
>     first (Mix a b) = Mix a (arrTwist $ first b)

Теперь комбинатор loop. Как я и обещал, я приведу два варианта: основной, который использую я:

> instance (Arrow a, ArrowLoop b) => ArrowLoop (Mix a b) where loop (Mix a b) = Mix a (loop $ arrTwist b)

и дополнительный:

instance (ArrowLoop a, Arrow b) => ArrowLoop (Mix a b) where loop (Mix a b) = Mix (loop . a . arrAssocRtoL) (arrAssocLtoR b)

Внимательный читатель уже заметил, что они отличаются контекстом. При наивном подходе дополнительный вариант имел бы контекст (Arrow a, Arrow b), но работал бы хуже — те маленькие примеры, которые работали бы с первым вариантом, не могли бы работать со вторым, но не наоборот. А вот в продвинутом подходе разницы, похоже, нет.
Далее, мы хотим преобразовывать одну стрелку в другую. Казалось бы разумным использовать тип (b :~> c) -> (Mix a b :~> Mix a c) Это возможно, но мы поступим несколько более общим образом. Мне, в моём домашнем проектике, эта общность пригодилась. Кроме того, мы уберём такую функцию в класс — впоследствии пригодится.

> class AlongMap f where
>     alongMap :: (Arrow b, Arrow c) => (Along b input1 output1 :~> Along c input2 output2) -> (Along (f b) input1 output1 :~> Along (f c) input2 output2)
> instance AlongMap (Mix a) where alongMap h (Mix a b) = Mix a (arrTwist $ h $ arrTwist b)

И, наконец, если "чистая" стрелка представляет собой всего лишь функцию, то мы можем закрутить наш цикл и извлечь стрелку a:

> unMix :: Arrow a => Mix a (->) :~> a
> unMix (Mix a b) = a $ arr b

Да, именно так. Нам не требуется здесь замыкать цикл — в определении функции liftA это уже сделано. Все нужные циклы уже есть, ожидают, пока мы ими воспользуемся — вот мы ими и пользуемся.
Несколько примеров. Я введу специальную стрелку для тестов и уберу в класс те функции, которые нам потребуются:

> newtype Test input output = Test {runTest :: Mix (Kleisli IO) (Kleisli (State String)) input output}
>     deriving (Category, Arrow, ArrowLoop)
> class ArrowLoop a => ArrowTest a where
>     rd :: a () String -- ввести строку с клавиатуры
>     wr :: a String () -- вывести строку на экран
>     gt :: a () String -- прочитать текущее состояние
>     pt :: a String () -- изменить текущее состояние
> instance ArrowTest Test where
>     rd = Test {runTest = liftA $ Kleisli $ const $ putStr "::: " >> getLine}
>     wr = Test {runTest = liftA $ Kleisli putStrLn}
>     gt = Test {runTest = liftB $ Kleisli $ const get}
>     pt = Test {runTest = liftB $ Kleisli put}

Для облегчения программирования я введу такой морфизм стрелок:

> stMorphism :: s -> Kleisli (State s) :~> (->)
> stMorphism s al i_input = evalState (runKleisli al i_input) s

И нам потребуется функция, которая запускает тест:

> doTest :: Test input output -> input -> IO output
> doTest t = runKleisli (arrCancelUnit $ unMix $ alongMap (stMorphism "") $ runTest $ first t)

Здесь надо учесть, что большой морфизм unMix . alongMap (stMorphism "") . runTest, увы, работает с типом Along — то есть, требует, чтобы входы и выходы были парами (чего угодно), и чтобы аргумент его был также стрелкой, обрабатывающей пары. Ну, добавить вторым компонентом тип () нам нетрудно — что мы и делаем при помощи функций arrCancelUnit и first.
Собственно тесты. Их будет три:

> test1, test2, test3 :: ArrowTest a => a () ()

Первый тест — почти простое эхо: мы вводим строку с клавиатуры, сохраняем её в состояние, вытаскиваем из состояния и выводим на экран:

> test1 =
>     proc () ->
>         do line <- rd -< ()
>            pt -< line
>            line' <- gt -< ()
>            wr -< line'

Запускаем:

*Mix> doTest test1 ()
::: aaa
aaa

Однако, работает.
Что интересно, "чистые" стрелки вполне можно переставлять с настоящими эффектами. Например:

> test2 =
>     proc () ->
>         do rec {pt -< line;
>                 line <- rd -< ();}
>            rec {line' <- gt -< ();
>                 wr -< line';}
>            returnA -< ()

Запускаем:

*Mix> doTest test2 ()
::: bbb
bbb

Ничего не изменилось.
Разумеется, если мы переставим эффекты одной природы, получится плохо:

> test3 =
>     proc () ->
>         do line <- rd -< ()
>            rec {line' <- gt -< ();
>                 pt -< line;}
>            wr -< line'

Запуск показывает, что вместо эха мы выводим пустую строку — что ожидаемо, так как мы забираем текущее состояние ДО того, как записываем новое:

*Mix> doTest test3 ()
::: ccc

Однако, во всём этом зияет один провал. У нас нет ветвлений. Нет ArrowChoice. И с данным типом мы его не получим — ну, по крайней мере, у меня не получилось. Однако, сделать это всё-таки можно. Один из вариантов — вместо Along a i o :~> a использовать тип Along i (Either o i) :~> a Тогда всё получится. Действительно, нам необходимо, если на вход поступило что-то посторонее, что нужно пропустить неизменным, откуда-то взять этот самый тип o. Обычно мы получали его из входных данных, при помощи стрелки b, но если на входе мусор, то это не получится. Поэтому, мы просто используем тот же самый тип i.
Однако, при этом усложнится построение композиции — нужно будет постоянно разбирать эти Either, а потом собирать их обратно. Я предпочитаю другой вариант — добавить функцию типа i -> o. В простых случаях это будет то самое Right :: i -> Either o i, а в более сложных мы получим некоторую свободу. Всё это выливается в такой вот код:

> data MixC a b input output where MixC :: (i -> o) -> (Along a i o :~> a) -> Along b i o input output -> MixC a b input output
> liftCA :: (ArrowChoice a, ArrowLoop a, Arrow b) => a input output -> MixC a b input output
> liftCA a = MixC Right (\al -> loop $ al >>> second (a ||| id)) (arr $ swap . first Left)
> liftCB :: (Arrow a, Arrow b) => b input output -> MixC a b input output
> liftCB b = MixC id arrCancelUnit (first b)
> instance (Arrow a, Arrow b) => Category (MixC a b) where
>     id = liftCB id
>     MixC r2 a2 b2 . MixC r1 a1 b1 = MixC (r2 *** r1) (a2 . a1 . arrAssocRtoL) (arrAssocLtoR $ twist ^>> first b1 >>> twist ^>> first b2)
> instance (Arrow a, Arrow b) => Arrow (MixC a b) where
>     arr = liftCB . arr
>     first (MixC r a b) = MixC r a (arrTwist $ first b)
> instance (Arrow a, ArrowLoop b) => ArrowLoop (MixC a b) where loop (MixC r a b) = MixC r a (loop $ arrTwist b)
> instance AlongMap (MixC a) where alongMap h (MixC r a b) = MixC r a (arrTwist $ h $ arrTwist b)
> unMixC :: Arrow a => MixC a (->) :~> a
> unMixC (MixC _ a b) = a $ arr b

Прямо удивительно, насколько мало при этом меняется. Добавились кое-где манипуляции с первым аргументом конструктора, и чуть-чуть усложнилась функция liftA, требующая теперь, среди прочего, чтобы стрелка a умела делать ветвление. Всё остальное не меняется. Первый аргумент конструктора пока нигде не был нужен. Сейчас мы его используем — и это единственное место, где он проявляется:

> instance (Arrow a, ArrowChoice b) => ArrowChoice (MixC a b) where
>     left (MixC r a b) = MixC r a (f ^>> left b >>^ g) where
>         f (Left input, i) = Left (input, i)
>         f (Right z, i) = Right (z, i)
>         g (Left ~(output, o)) = (Left output, o)
>         g (Right ~(z, i)) = (Right z, r i)

И всё.
Соответственно, чтобы всё это протестировать, нам понадобится новая тестовая стрелка:

> newtype TestC input output = TestC {runTestC :: MixC (Kleisli IO) (Kleisli (State String)) input output}
>     deriving (Category, Arrow, ArrowChoice, ArrowLoop)
> instance ArrowTest TestC where
>     rd = TestC {runTestC = liftCA $ Kleisli $ const $ putStr "::: " >> getLine}
>     wr = TestC {runTestC = liftCA $ Kleisli putStrLn}
>     gt = TestC {runTestC = liftCB $ Kleisli $ const get}
>     pt = TestC {runTestC = liftCB $ Kleisli put}
> doTestC :: TestC input output -> input -> IO output
> doTestC t = runKleisli (arrCancelUnit $ unMixC $ alongMap (stMorphism "") $ runTestC $ first t)

Что-нибудь изменилось? По-моему, ничего. Желающие могут запустить первые три теста, и всё будет работать идентично первому варианту.
Проверим ветвление:

> test4 :: TestC () ()
> test4 =
>     proc () ->
>         do pt -< "Welcome"
>            passwd <- rd -< ()
>            if (passwd == "Secret Password")
>               then do line <- gt -< ()
>                       wr -< line
>               else wr -< "Go away"

Запускаем:

*Mix> doTestC test4 ()
::: ddd
Go away
*Mix> doTestC test4 ()
::: Secret Password
Welcome

Ага.
Вот, как-то так.

17:14: Подмешиваем эффекты - теория
Есть у меня один проектик, никому, кроме меня, не нужный, а потому холимый, лелеемый и регулярно вычёсываемый. Проектик большой, целых двести строк (чёрт, исходники картинок к этой статье чуть не в два раза больше, и я уж молчу про саму статью) и под десять килобайт исходников (да, я люблю длинные строки). Временами из него вычленяются отдельные куски, которые вполне можно показать людям. Вот, на днях один такой попался. Родился он из медитации над заброшенным пакетом lax с hackage, который благополучно не устанавливается cabal-ом, но при этом состоит всего из одного вполне рабочего файла, который можно просто взять и использовать (ну, прагму надо будет прописать в начале).
Окончили лирику, переходим к делу. Задачка передо мной стояла совершенно классическая — взять две стрелки, перемешать, посолить, поперчить и сделать из них одну.
Чуть более подробно. У меня была некая стрелка. Вполне себе чистенькая — писалась исключительно с использованием чистых функций. Возникла необходимость добавить к ней эффекты — то есть, пока работают "эффекты" самой стрелки, дополнительно ещё производить некое IO. То есть, наши стрелки изначально неравноправны: есть стрелка a, которая, по сути, будет ни чем иным, как Kleisli IO, и стрелка b, делающая основную работу, но при этом чистая. И мы хотим слепить из всего этого что-то одно.
Основная идея будет такой: мы организуем некий цикл, где то, что подаётся на вход, будет сразу скармливаться стрелке b, часть выхода пойдёт к стрелке a, а то, что она выдаст, будет возвращаться к b:


Разумеется, так прямо сделать нельзя. Однако, никто не мешает нам хранить те части этого цикла, которые действительно имеют значение:


Посмотрим, удастся ли при таком подходе сделать что-нибудь полезное. Для начала, хорошо бы убедиться, что мы можем встроить в это дело исходные стрелки a и b. Оказывается, вполне можем, и вот как:




Комбинатор first делается элементарно:


А вот композиция — уже интереснее. Мы ведь хотим, по сути дела, следующего:



Мы можем перерисовать это дело так, чтобы стало более похоже на один цикл:



И вот тут нас поджидает засада.
Засада состоит в следующем. Забудем пока про чистую стрелку b, она не имеет значения. Допустим, мы поднимаем и соединяем последовательно две стрелки с эффектами, одна из которых читает ввод, а другая его же выводит обратно на экран. Мы получим, фактически, следующее:


Я чуть разверну цикл, чтобы интересные нам стрелки смотрели слева направо:


Что мы видим? А видим мы, что стрелка putStrLn на вход принимает то, что возвращается назад мимо неё. Увы, монада IO к таким штукам относится очень нервно. Если мы аккуратно напишем всё то, о чём пока говорили неформально, и запустим этот пример, то получим классическое "Expression: <<loop>>". А это не та реакция, которая нам нужна.
Желающие в этом убедиться могут попробовать такой пример:

echoL =
    proc ((), line) ->
        do line' <- Kleisli (const getLine) -< ()
           Kleisli putStrLn -< line
           returnA -< ((), line')
echo = runKleisli (loop echoL) ()

Ввести строчку эта стрелка ещё позволит, но на выводе получим тот самый цикл.
Нужно поправить ситуацию так, чтобы ни одна IO-стрелка не зависела от того, что идёт назад мимо неё. И сделать это можно, перенеся образование цикла в функцию "подъёма" стрелки a. Тогда вместо одного большого цикла мы получим что-то вроде



— а это гораздо лучше. Настолько лучше, что работает.
Есть и другое описание такого решения: везде, где что-то соединяется в пары, можно найти композицию. Это эмпирический (пока, по крайней мере) принцип, но он работает. В данном случае, композиция наших циклов приводит к тому, что "обратные" стрелки в нижней части цикла соединяются параллельно — а значит, композиция где-то рядом.
Более точно. Вместо одной стрелки



мы берём функцию (чистую!), которая вот такую стрелку:



преобразует вот в такую:



Тогда параллельное соединение стрелок, которое мы использовали раньше, превратится как раз-таки в композицию. Изобразить это дело на диаграмме уже не получится, или, по крайней мере, будет весьма затруднительно; поэтому, я нарисую несколько диаграмм так, как будто мы используем старое, "наивное" решение с одной стрелкой a, а уж в коде будет "продвинутое" решение, с функцией, преобразующей стрелки.
Собственно говоря, нарисовать осталось немногое. Займёмся комбинатором loop. То есть, у нас есть вот такая конструкция:



и мы хотим замкнуть нижние "висящие" хвосты. Интересно то, что мы можем это сделать двумя способами. Первый способ — ввести цикл в стрелку b, второй — пустить его вдоль стрелки a. С точки зрения диаграмм получается такое:






Самое смешное в том, что я не нашёл отличий в их функциональности. Может, конечно, они и есть, но мне лично кажется, что они эквивалентны, причём что это можно формально доказать. В ближайшее время я этим попробую заняться. Первый вариант, однако, записывается короче, выглядит более похоже на другие комбинаторы, и, в целом, больше мне нравится. Так что, использовать я буду именно его, а второй вариант пойдёт комментарием.
Наконец, самый важный вопрос: можем ли мы получить из таких циклов что-нибудь обратно? А то, выглядят они, конечно, симпатично, но не более того. Ответ — да, можем, но не вполне банальным образом. Идея в том, чтобы для начала заменить стрелку b на функцию, а затем оставить вообще только стрелку a, от которой нам, так уж получилось, деваться некуда — именно в ней будут настоящие эффекты, которые в чистую функцию не переделать никак. В наивном подходе нам нужно будет замкнуть цикл, воспользовавшись тем, что стрелка a имеет оператор loop; в продвинутом подходе всё окажется на порядок проще.
Продолжение следует.

00:55: Пришла мысль
Вот, допустим, я — царь, и хочу посадить вместо себя на трон марионетку. Ну, типа, изобразить, что у нас, якобы, демократия. OK.

Как мне сделать так, чтобы моя марионетка меня же не прихлопнула? А то опыт сенатора Варрона не вдохновляет.

Классический ответ — "набрать на марионетку чемодан компромата". Но с компроматом есть сложности. Если там, например, будет написано, что такой-то товарищ украл десять штук свечных заводов — так рядовой обыватель не разберётся вообще, ибо заводы крадут способами, пешеходу непонятными. А продвинутая интеллигенция, во-первых, крайне малочисленна, а во-вторых, и так в курсе — пусть не что именно десять или именно свечных, но хотя бы что находящиеся наверху воруют, и воруют много.

Если же в компромате будет написано, что товарищ по молодости спёр со склада надувной матрас — то это как-то уж совсем не серьёзно, сомнительно, и вообще, на грехи молодости спишется.

Соответственно, компромат должен быть такой, что даже тень подозрения марает человека в глазах общественности по самые уши. Скажем, растление малолетних, или что-то в таком духе. Кроме того, чем компромат надёжнее — тем лучше; а самый надёжный компромат — это неприглядная правда. Ну и, наконец, марионетку можно выбирать, и выбрать того, кто наиболее замазан.

Выводы-с?

21:53: Как я могу остаться в стороне
и не написать хоть полслова о Мигалкове.

Собственно, у меня вопрос. Правда ли, что за посты, где плохо отзываются об этом уроде михалкове, кто-то платит? Говорят, Сурков. Если да, то куда обращаться? Где то окошечко, где выдают деньгу? Сомнительно, конечно: где это видано, чтобы за хорошие дела платили - но вдруг?

13:08: Религиозное
Есть такой известный антирелигиозный аргумент - если Бог всемогущ и всеблаг, то как же он допускает войны, эпидемии и прочее в том же духе? Не буду сейчас говорить о том, насколько этот аргумент убедителен (ИМХО, не очень), речь о другом. Встречается - по крайней мере, в художественной литературе - такой вариант: мир был сотворён Богом, но этот Бог не всеблаг, а как бы совсем наоборот, совершеннейшая зараза.

Так вот, я тут подумал: а ведь этот подход нарушает бритву Хэнлона: "не ищи злонамеренность в том, что можно объяснить глупостью". Как вам такая идея - мир был сотворён Богом, и этот Бог... дурак?

21:36: Хоббитское
Подобью итоги по имеющимся хобби.

1) Переводы.

Сделал первый сезон "Касла", весь "Файрфлай", второй сезон "Касла" добил до 17-й серии. Думал в этом году сделать ещё и 18-ю, не успел.

Единственный, ИМХО, провал в этой области - не смог адекватно перевести шутку из 10-й, кажется, серии; примерно такую:

Касл: "Думаю, это была ледяная пуля".
Эспозито: "Ледяная пуля всё равно оставила бы пулевое отверстие".
Райан: "You mean, an ice hole?"
Касл: "Как-как ты меня назвал?"

Для тех, кому непонятно: "ice hole" - буквально, "ледяное отверстие", звучит очень похоже на "asshole" ("мудак", если правильно переводить).

2) Сериалы.

Открытие года - "Хорошая жена". Великолепно. Смотрю пока первый сезон - провисаний нигде нет, играют замечательно все. Досмотрел до серии, где героиню Кристин Барански (не главная роль, нет) обозвали... не будем спойлерить... и где её хохот доносился даже когда пошли титры.

Разочарование года - "Остаться в живых" (которое LOST). Посмотрел пилот. С великим напряжением всех моральных сил посмотрел первые десять минут следующей серии. Понял, что эту муру я больше смотреть не могу. Невероятно скучно.

Другой Абрамсовский сериал - "Грань", я довольно бодро посмотрел где-то до середины первого сезона и завис.

А вот последнее творение Абрамса - Undercovers - смотрю с колоссальным удовольствием. Чудесная побрякушка, проку никакого, но доставляет колоссальное удовольствие. Его, кстати, закрывают.

Из старого - смотрю "Хауса", который вполне ожил, а замена Уайлд на Эмбер Тэмблин пошла ему только на пользу, причём это очень мягко сказано. Смотрю "Сверхъестественное" и Leverage - что там, что там есть приятные моменты.

3) Бальные танцы.

Нашёл офигительнейшего преподавателя (пиар: зовут Алексей Задвигин, работает в школе "Текила-данс"). Он отлично чувствует уровень своих подопечных и гоняет нас ровно по тому, что мы с напрягом, но можем. Пока учим медленный вальс, квикстеп, ча-ча-ча и румбу; Алексей обещал скоро начать танго, но мы пока явно не готовы.

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

Вот так, примерно.

15:36: Ч... чиво?
( Read more... )

22:22: Анекдот
Группа программистов заходит в бар. Бармен спрашивает: "что вам налить?"

Сишник говорит: "Видите эту бутылку?" - и показывает на большую зелёную бутыль с наклейкой "*" - "Мне то, что в ней есть".

Лиспер говорит: "Дайте мне (из шкафа передо мной) стакан (маленький стакан (или пластиковый стаканчик)) (импортного (немецкого)) пива. (Если его нет, то вина (красного (калифорнийского (каберне))).)"

Ассемблерщик говорит: "Возьмите стакан со второго места на сушилке и поставьте на стол на нулевое место (перед вами). Возьмите бутылку с седьмого места на полке и налейте её содержимое на нулевое место на столе. Остановитесь через три секунды. Поместите бутылку на седьмое место на полке. Возьмите стакан с нулевого места на столе и поставьте его на четвёртое место на столе (передо мной)."

Смоллтокер говорит: "Бармен достать водка бутылка. Водка бутылка налитьв стакан. Рука поднять стакан. Рот пить."

Эскуэльщик говорит: "Возьмите все бутылки содержащие пиво и назовите их 'пивные'. Возьмите все бутылки, выпущенные компаниями, выпускающими менее миллиона бутылок в год, и назовите их 'мелкие'. Возьмите пересечение 'пивные' и 'мелкие' и налейте мне из первой из них."

Фортер говорит: "Вино белое налить".

Прологгер говорит: "Я возьму колу, если мне нужен кофеин. Я возьму водку, если хочу напиться. Я возьму воду, если хочу пить. Мне нужен кофеин, если я стараюсь не заснуть. Я хочу пить, если сегодня жарко. Я стараюсь не заснуть, если меня ещё ждёт работа. Сегодня жарко, если температура выше 27 градусов. Меня ещё ждёт работа."

Дизайнер говорит: "Мне, пожалуйста, маленький стакан с тонким срезом, чтобы из него было легко пить. Он должен быть достаточно большим, чтобы его было удобно взять в руки, но не таким большим, чтобы казаться тяжёлым. На нём должен быть рисунок человека, пьющего из стакана (показывающий, как им пользоваться)". "Но что в него налить?" - спрашивает бармен. "Неважно" - отвечает дизайнер.

Менеджер говорит: "Просто дай мне выпить".

Оригинал: http://scarydevilmonastery.net/snap/pub

16:41: Про всякую социалку
Создателя Facebook обозвали "человеком года". Так и хочется спросить "какого года". Ну да неважно. Вопрос в другом.

Граждане. Дамы и господа. Товарищи. Леди и джентльмены. Мадам и мсье, наконец. Объясните тупому, что с этим фейсбуком делать???

Да, я там зарегистрирован. Нет, я по прежнему не понимаю.

Задал вопрос на форуме-где-есть-спецы-по-всем-вопросам. Получил три варианта ответов:

1) Чатик. Типа аськи. Или жаббера.

Вопрос. Чем оно лучше самого жаббера?

То есть, я понимаю, вот у нас, например, корпоративный стандарт - аська. Пробовали внедрить жаббер, он не внедрился. Фейсбучный чат не пробовали, думаю, получилось бы примерно так же, или даже хуже, потому что Miranda из коробки поддерживает и аську, и жаббер, но не поддерживает фейсбук.

2) Фотогалерея.

Тут я пас: фотографией особо не увлекаюсь. Но и если бы увлекался: кому это показывать и кто это будет смотреть? Несколько картинок можно в ЖЖ выложить, а выкладывать за раз пятьсот штук - действие довольно странное.

3) Кто-то привёл пример: какой-то клуб рассылает своим членам сообщения о предстоящих мероприятиях. Опять-таки, разве не удобнее было бы сделать сообщество в том же ЖЖ, или на другом блогохостинге, благо их что грязи? Как минимум, от членов клуба не требовалось бы наличие фейсбук-аккаунта.

Поставил на айфон ихнее приложение. Что с ним делать - не знаю. Открыл, потыкал наугад. Ничего интересного не обнаружил.

В хелпах на сайте раздела "Что такое фейсбук" я не нашёл. Гугль по запросам типа "что может сделать для меня фейсбук" выдаёт кучу ссылок типа "что я могу сделать для фейсбука".

Не понимаю.

P.S. Да, разумеется, к вконтакту и прочим клонам всё это тоже относится.

02:00: Freaky Form
Отчим приехал из Москвы на поезде, опоздавшем на пять часов. Будучи человеком значительно более социально активным, чем я, он направился в администрацию вокзала, чтобы на кого-нибудь нажаловаться и кого-нибудь привлечь к ответственности.

Ему там выдали бланк заявления:



Скан довольно крупный, самое главное я скопировал отдельно:



Вопрос. Кто-нибудь что-нибудь понимает?

13:31: Продолжательное

> module WithFile where
> import Control.Monad.Cont
> import System.IO

Помнится, кто-то меня когда-то спрашивал, для чего нужна монада Cont. Я тогда сказал, что иных применений, кроме выхода из кучи вложенных вычислений, не знаю. Теперь знаю. Для соблюдения скобочной структуры.

Есть такая функция, называется withFile. Тип у неё будет, стало быть,

*WithFile> :t withFile
withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r

Эта функция открывает файл (в указанном режиме), подставляет его хэндл в заданную функцию, выполняет получившееся действие, закрывает файл, и возвращает результат действия.

Допустим, мы хотим написать такую же функцию, но работающую со списком файлов, а не с одним из них. Пишем, прямо и тупо:

withFiles :: [FilePath] -> IOMode -> ([Handle] -> IO r) -> IO r
withFiles [] _ action = action []
withFiles (f:fs) mode action = withFile f mode (\h -> withFiles fs mode (\hs -> action (h:hs)))

Непорядок. Во-первых, параметр mode всегда один и тот же, а значит, должен быть первым по списку. Во-вторых, единственное, что реально зависит от конкретных типов FilePath, IOMode, Handle и монады IO - это функция withFile.

Имеет смысл её абстрагировать. Пишем:

withFiles fs mode action = withMany (\f -> withFile f mode) fs action
withMany withOne [] action = action []
withMany withOne (f:fs) action = withOne f (\h -> withMany withOne fs (\hs -> action (h:hs)))

Можно написать несколько короче и проще:

withFiles fs mode = withMany (flip withFile mode) fs

Посмотрим теперь, какой тип имеет функция withMany

*WithFile> :t withMany
withMany :: (t1 -> (a -> t) -> t) -> [t1] -> ([a] -> t) -> t

Хм. Никакого упоминания ни об одном из перечисленных типов, характерных для IO. Полностью обобщённая функция. Или... не совсем?

В самом деле, ведь то, что там стоит в двух местах - это, практически, монада Cont! Только конструктора не хватает. Попробуем заменить всё выражение (a -> t) -> t на Cont, и получим

(t1 -> Cont t a) -> [t1] -> Cont t [a]

Упс. А ведь одна такая функция уже есть. Это не что иное, как функция mapM, специализированная для конкретной монады Cont t. Да-да, это она и есть, мы её только записали в несколько уродском виде.

Таким образом, функция withMany записывается в виде

> withMany withOne fs = runContT $ mapM (ContT . withOne) fs

Здесь пришлось написать ContT вместо Cont, поскольку в нынешней mtl нет конструктора Cont, вместо этого используется ContT, в который подставляется монада Identity.

Однако, это даже лучше: ведь в нашем исходном варианте вместо t был тип IO r, уже сидящий в монаде. Таким образом, определение

withFiles fs mode = withMany (flip withFile mode) fs

работает отлично. То есть, вместо вложенных "скобок" withFile, мы имеем последовательность продолжений, которая отлично порождается библиотечной функцией. Можно даже забить на withMany, так как она очень проста, и писать

> withFiles fs mode = runContT (mapM (ContT . flip withFile mode) fs)

16:50: Yota
Пару месяцев назад я решил попробовать так называемое 4G от этой замечательной компании, чтоб ей хронический понос. Купил ихнее Yota Egg, зарегистрировался, подключил.

Ну, скорость была чуть меньше, чем у меня на айфоне через 3G, и в несколько раз хуже, чем родимый ADSL. Говорят, что если прилепить яйцо скотчем к швабре и выставить из окна на максимальную длину, то связь становится сильно лучше, но я не пробовал. (Прочитал написанное и сам ужаснулся).

Сдал обратно, получил деньги, всё хорошо. Правда, оставил на счёте в Yota пару сотен рублей, но и фиг с ними, пусть подавятся. К тому же, вдруг в будущем связь станет сильно лучше, и я снова к ним подключусь - возможно ведь, да? Нет.

Недавно начали приходить SMS-ки о каких-то говнофестивалях, то ли проводимых, то ли спонсируемых, то ли ещё что, неким Yota Space. Недавно меня заколебало, и я написал в техподдержку Йобты, чтобы мне это отключили. Они мне позвонили и сообщили, что отключить могут, но тогда отключат и SMS-напоминания о необходимости пополнить счёт. Я им, разумеется, сказал "go ahead".

Итого: Ёта намертво связала полезный - для абонентов - сервис, и рассылку мерзопакостного спама. У кого-то есть сомнения, что я НЕ буду подключаться к ним снова, пусть они даже упятерят скорости?

14:39: Снова хозяйке на заметку
В новой версии MPlayer-а к опциям из предыдущего поста надо добавить :weightp=0, в самом конце, без пробела.

Upd: с новым x264 - неплохо бы ещё :force_cfr

01:12: On Vox: Vox закрывается

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

Чем нас кормили вместо этого? Новыми темами. Без возможности сделать свою, а это даже в ЖЖ с незапамятных времён есть.

Видимо, надо переезжать обратно в ЖЖ, а потом - на стэндэлон, так как СУПу я как не доверял, так и не доверяю.

Originally posted on migmit.vox.com

11:25: Мобильные, $&@, финансы
Задача. Дано: циркуль, линейка, полное нежелание выходить из дома, айфон и карточка Альфа-банка с долларовым счётом. Требуется получить: карточку американского банка с американским же billing address и хотя бы двадцаткой на счету. Дополнительное условие: потери в 50% считаются нежелательными, но приемлимыми.

Найденное мной решение. Просьба не ржать.

1) При помощи iRobo деньги - автоматически переводимые в рубли - снимаются со счёта в банке и кладутся в кошелёк QIWI.

2) Мобильным приложением от QIWI на эти деньги покупаются WMR.

3) В одном из многочисленных онлайн-обменников WMR обмениваются на WMZ.

4) На эти WMZ покупается виртуальная VISA на, скажем, v-biz, и там же, за отдельную плату, регистрируется на нужный адрес.

Вот. Есть идеи, как сделать то же самое покороче и подешевле?

09:02: Про кнопку &quot;repost&quot;. Вынесенный комментарий
Originally posted by nealar at Про кнопку &quot;repost&quot;. Вынесенный комментарий

13:56: On Vox: Кажется, он обретает самосознание

Originally posted on migmit.vox.com

15:10: On Vox: Делаем фишку

В нашей игре основной персонаж, естественно, управляется практически полностью действиями игрока. Мы пытаемся навесить на него дополнительные фигни, которые должны двигаться вместе с ним, но при этом управляться законами физики. Например - длинные волосы, которые должны оставаться прикреплёнными к голове, но при движении правдоподобно развеваться.

Сделали тест. У нашего персонажа уже была некая достаточно короткая причёска; ради теста не стали её убирать. Итак, вот первая попытка:

http://dl.dropbox.com/u/5228409/G.avi (7 Мб)

Где-то на 15-й секунде я нажал кнопку "создать волосы".

Originally posted on migmit.vox.com

18:52: On Vox: Рапортую

эксперимент по приобщению родных к сериалу "Касл" увенчался полным успехом - проглотили первый сезон и хотят второго. Переведённые вашим покорным слугой субтитры здесь:
Castle - 1x01 - Flowers for Your Grave.ru.srt
Castle - 1x02 - Nanny McDead.ru.srt
Castle - 1x03 - Hedge Fund Homeboys.ru.srt
Castle - 1x04 - Hell Hath No Fury.ru.srt
Castle - 1x05 - A Chill Goes Through Her Veins.ru.srt
Castle - 1x06 - Always Buy Retail.ru.srt
Castle - 1x07 - Home Is Where the Heart Stops.ru.srt
Castle - 1x08 - Ghosts.ru.srt
Castle - 1x09 - Little Girl Lost.ru.srt
Castle - 1x10 - A Death in the Family.ru.srt

Originally posted on migmit.vox.com

14:11: On Vox: Под окном

у нас церква. Очередь дебилов стоит километровая - освящать куличи.

Дарю идею: наладить производство автоматических освЯтителей. Народ будет отрывать с руками. Клондайк какой-то.

Originally posted on migmit.vox.com

01:48: On Vox: Из странной дискуссии в Haskell-café

I'll give you credit for trying, but you might as well accept the fact that using Haskell isn't going to get you laid.
© Ketil Malde
Отлично.

Originally posted on migmit.vox.com

13:39: On Vox: О закрытых классах - 2

Как обычно, стоило записать мысль, и появилось понимание, почему она не нужна.

> {-# LANGUAGE GADTs, RankNTypes #-}
> module Derive where
> import Control.Monad
> import Control.Monad.Reader
> import Control.Monad.State

Итак, начинаем с того же фруктового примера.

> data Apple = Apple deriving Show
> data Orange = Orange deriving Show

Вместо forall используем те же GADT-ы:

> data FruitD a where
>     FruitApple :: FruitD Apple
>     FruitOrange :: FruitD Orange
> class Fruit a where fruit :: FruitD a

Маленький недостаток: приходится заводить пару лишних имён. Ну, что поделаешь - надо так надо.

> instance Fruit Apple where fruit = FruitApple
> instance Fruit Orange where fruit = FruitOrange

Используем, опять же, для вывода Show:

> data ShowEv a where ShowEv :: Show a => ShowEv a
> showD :: ShowEv a -> a -> String
> showD ShowEv = show

При таком подходе нужно давать аннотации типов, иначе GADT-ы отказываются паттерн-матчится. Для этого, в свою очередь, приходится заводить вспомогательную функцию:

> showFruit :: Fruit a => ShowEv a
> showFruit = showFruit' fruit where
>     showFruit' :: FruitD a -> ShowEv a
>     showFruit' FruitApple = ShowEv
>     showFruit' FruitOrange = ShowEv

Зато паттерн-матчинг действительно пишется как паттерн-матчинг.

Точно также делается для рекурсивных типов:

> data IntNil = IntNil deriving Show
> data IntCons t = IntCons Integer t deriving Show
> intVectorExample :: IntCons (IntCons (IntCons IntNil))
> intVectorExample = IntCons 3 $ IntCons 1 $ IntCons 4 $ IntNil

Причём в этом случае вполне разумно, мне кажется, рекурсивно перекрутить класс и тип.

> data IntVectorD t where
>     IntVectorNil :: IntVectorD IntNil
>     IntVectorCons :: IntVector t => IntVectorD (IntCons t) -- обратите внимание на указанное ограничение в виде класса
> class IntVector t where intVector :: IntVectorD t
> instance IntVector IntNil where intVector = IntVectorNil
> instance IntVector t => IntVector (IntCons t) where intVector = IntVectorCons
> showIntVector :: IntVector v => ShowEv v
> showIntVector = showIntVector' intVector where
>     showIntVector' :: IntVectorD t -> ShowEv t
>     showIntVector' IntVectorNil = ShowEv
>     showIntVector' IntVectorCons = showEvCons showIntVector -- а вот сюда переезжает рекурсия
>     showEvCons :: ShowEv t -> ShowEv (IntCons t)
>     showEvCons ShowEv = ShowEv

Абсолютно аналогичным образом делается и для типов высших порядков:

> data StateOrReaderD m where
>     StateOrReaderState :: StateOrReaderD State
>     StateOrReaderReader :: StateOrReaderD Reader
> class StateOrReader m where stateOrReader :: StateOrReaderD m
> instance StateOrReader State where stateOrReader = StateOrReaderState
> instance StateOrReader Reader where stateOrReader = StateOrReaderReader

Для них точно таким же способом выводятся инстансы:

> data MonadEv m where MonadEv :: Monad m => MonadEv m
> returnD :: MonadEv m -> x -> m x
> returnD MonadEv = return
> bindD :: MonadEv m -> m x -> (x -> m y) -> m y
> bindD MonadEv mx h = mx >>= h

Причём вспомогательный тип становится не нужен:

> -- newtype MonadSORHelper a m = MonadSORHelper (MonadEv (m a))
> monadStateOrReader :: StateOrReader m => MonadEv (m a)
> monadStateOrReader = monadStateOrReader' stateOrReader where
>     monadStateOrReader' :: StateOrReaderD t -> MonadEv (t a)
>     monadStateOrReader' StateOrReaderState = MonadEv
>     monadStateOrReader' StateOrReaderReader = MonadEv

Для функций, не входящих в классы, вспомогательный тип тоже не нужен:

> -- newtype GetSORHelper a x m = GetSORHelper (m a x)
> genericGet :: StateOrReader m => m a a
> genericGet = genericGet' stateOrReader where
>     genericGet' :: StateOrReaderD t -> t a a
>     genericGet' StateOrReaderState = get
>     genericGet' StateOrReaderReader = ask

Ну и, для полноты картины, рекурсивные типы высших порядков работают ничем не хуже:

> data Nil a = Nil a deriving Show
> data Cons t a = Cons a (t a) deriving Show
> data VectorD t where
>     VectorNil :: VectorD Nil
>     VectorCons :: Vector t => VectorD (Cons t)
> class Vector t where vector :: VectorD t
> instance Vector Nil where vector = VectorNil
> instance Vector t => Vector (Cons t) where vector = VectorCons
> newtype ShowVectorHelper t = ShowVectorHelper {showVectorHelper :: Show a => ShowEv (t a)}
> showVector :: (Vector v, Show a) => ShowEv (v a)
> showVector = showVector' vector where
>     showVector' :: Show a => VectorD t -> ShowEv (t a)
>     showVector' VectorNil = ShowEv
>     showVector' VectorCons = showEvCons showVector
>     showEvCons :: Show a => ShowEv (v a) -> ShowEv (Cons v a)
>     showEvCons ShowEv = ShowEv

Вот. Буду теперь пользоваться этим. Для тех, кто пользуется другими компиляторами, не поддерживающими GADT-ы, всё ещё остаётся подход из предыдущего поста.

Originally posted on migmit.vox.com

18:20: On Vox: О закрытых классах

И опять не прошёл кросспост в ЖЖ; клик сюды.

Originally posted on migmit.vox.com

13:02: On Vox: Пару дней назад

через небольшую дырку утёк архив "Журнала функционального программирования", все статьи, выложенные на сайте. Некоторые даже успели скачать.

Originally posted on migmit.vox.com

18:31: On Vox: Посмотрел доклад

Causal Commutative Arrows and Their Optimization, в исполнении Hai Liu. В соавторах - Eric Cheng и Paul Hudak. Осознал, что ихняя ArrowInit - это, фактически, то же самое, что LispDo из моего предыдущего поста. А я думал, это никому не надо...

Originally posted on migmit.vox.com

02:05: On Vox: Всякая фигня

1) Игра, которую мы ваяем на работе, полностью пересобирается минут за сорок. С использованием распределённой сборки удаётся сократить это время до пяти-шести минут.

В порядке эксперимента все файлы (C++) собрали в один большой. Очень большой. Его компиляция заняла двадцать секунд.

2) На ЛОРе попросили написать аналог Лисповского do - отдельно задаём переменные и то, как они изменяются от одной итерации к другой, отдельно - условие остановки, отдельно - тело цикла. Написал:

> {-# LANGUAGE Arrows, ExistentialQuantification #-}
> module LispDo where
> import Prelude hiding (id, (.))
> import Control.Category
> import Control.Arrow
> import Control.Monad
> data LispDo arrow x y = forall state. LispDo state (arrow (x, state) (y, Maybe state))
> runLispDo :: ArrowChoice arrow => LispDo arrow x y -> arrow x y
> runLispDo (LispDo init body) = proc x -> runLispDo' -< (x, init) where
>     runLispDo' =
>         proc (x, oldState) ->
>             do (y, mbNewState) <- body -< (x, oldState)
>                case mbNewState of
>                  Nothing -> returnA -< y
>                  Just newState -> runLispDo' -< (x, newState)
> evalLispDo :: LispDo (->) () x -> x
> evalLispDo lispDo = runLispDo lispDo ()
> execLispDo :: Monad m => LispDo (Kleisli m) () x -> m x
> execLispDo lispDo = runKleisli (runLispDo lispDo) ()
> loopVar :: Arrow arrow => a -> LispDo arrow (a -> a) a
> loopVar init = LispDo init (proc (f, x) -> returnA -< (x, Just $ f x))
> lVar :: Arrow arrow => a -> LispDo arrow a a
> lVar init = loopVar init . arr const
> stopIf :: Arrow arrow => LispDo arrow Bool ()
> stopIf = LispDo () (proc (b, ()) -> returnA -< ((), if b then Nothing else Just ()))
> lift :: Arrow arrow => arrow x y -> LispDo arrow x y
> lift a = LispDo () liftLispDo where
>     liftLispDo =
>         proc (x, ()) ->
>             do y <- a -< x
>                returnA -< (y, Just ())
> instance Arrow arrow => Category (LispDo arrow) where
>     id = arr id
>     LispDo init2 body2 . LispDo init1 body1 = LispDo (init1, init2) lispDoCompose
>         where
>           lispDoCompose =
>               proc (x, (oldState1, oldState2)) ->
>                   do (y, mbNewState1) <- body1 -< (x, oldState1)
>                      (z, mbNewState2) <- body2 -< (y, oldState2)
>                      returnA -< (z, liftM2 (,) mbNewState1 mbNewState2)
> instance Arrow arrow => Arrow (LispDo arrow) where
>     arr h = LispDo () (proc (x, ()) -> returnA -< (h x, Just ()))
>     first (LispDo init body) = LispDo init lispDoFirst
>         where
>           lispDoFirst =
>               proc ((x, z), oldState) ->
>                   do (y, mbNewState) <- body -< (x, oldState)
>                      returnA -< ((y, z), mbNewState)
> instance ArrowChoice arrow => ArrowChoice (LispDo arrow) where
>     left (LispDo init body) = LispDo init lispDoLeft
>         where
>           lispDoLeft =
>               proc (xOrZ, oldState) ->
>                   case xOrZ of
>                     Left x ->
>                         do (y, mbNewState) <- body -< (x, oldState)
>                            returnA -< (Left y, mbNewState)
>                     Right z -> returnA -< (Right z, Just oldState)
> instance ArrowLoop arrow => ArrowLoop (LispDo arrow) where
>     loop (LispDo init body) = LispDo init lispDoLoop
>         where
>           lispDoLoop =
>               proc (x, oldState) ->
>                   do rec {((y, z), mbNewState) <- body -< ((x, z), oldState);}
>                      returnA -< (y, mbNewState)

Testing:

> evenLoop :: Integer -> LispDo (->) () Integer
> evenLoop n =
>     proc () ->
>         do k <- loopVar 0 -< (\k -> k + 2)
>            stopIf -< k > n
>            returnA -< k
> testLoop :: LispDo (->) () Integer
> testLoop =
>     proc () ->
>         do rec {k <- lVar 0 -< k+1;}
>            rec {m <- lVar 1 -< m*2;}
>            stopIf -< k > 10
>            returnA -< m
> printLoop :: LispDo (Kleisli IO) () ()
> printLoop =
>     proc () ->
>         do rec {k <- lVar 0 -< k+m;
>                 m <- lVar 1 -< m+2*k;}
>            stopIf -< k > 10
>            lift (Kleisli print) -< (m, k)

Проверка:

*LispDo> evalLispDo $ evenLoop 100
102
*LispDo> evalLispDo testLoop
2048
*LispDo> execLispDo printLoop
(1,0)
(1,1)
(3,2)
(7,5)
(17,12)

Вряд ли когда понадобится.

3) Пока записывал (1) и (2), забыл третье.

Originally posted on migmit.vox.com

21:54: On Vox: Новогоднее настроение

...царит у нас на работе.

Originally posted on migmit.vox.com

16:28: On Vox: Поигрался тут

Кто-то (увы, не помню кто - напомните?) не так давно предлагал вопрос для интервью соискателям: где в C++ находится параметрический полиморфизм? Правильный ответ был "в районе шаблонов". Соответственно, я бы предложил следующий вопрос: а почему шаблоны таки не являются параметрическим полиморфизмом? Правильный ответ: потому что это всего лишь макросы на стероидах. Реализация метапрограммирования. А метапрограммирование ничего не может сделать, если под ним находится слишком слабенькая система.

Вот в чём сие выражается. Я запостил на ЛОР задачку (сопроводив её кодом на Хаскеле): подсчитать скалярное произведение двух векторов, статически гарантировав, что они имеют одинаковую длину. Мне не интересно сейчас снова демонстрировать, как это делается на Хаскеле (очень просто), но даже на C# вот такой код вполне работает:

using System;
interface ScalarProduct<A> {
  int scalarProduct(A second);
}
class Nil : ScalarProduct<Nil> {
  public Nil(){}
  public int scalarProduct(Nil second) {
    return 0;
  }
}
class Cons<A> : ScalarProduct<Cons<A>> where A : ScalarProduct<A> {
  public int value;
  public A tail;
  public Cons(int _value, A _tail) {
    value = _value;
    tail = _tail;
  }
  public int scalarProduct(Cons<A> second){
    return value * second.value + tail.scalarProduct(second.tail);
  }
}
class _Test{
  public static int main(int n){
    return _main(n, 0, new Nil(), new Nil());
  }
  public static int _main<A>(int n, int i, A first, A second) where A : ScalarProduct<A> {
    if (n == 0) {
      return first.scalarProduct(second);
    } else {
      return _main(n-1, i+1, new Cons<A>(2*i+1,first), new Cons<A>(i*i, second)); // Works
      //return _main(n-1, i+1, first, new Cons<A>(i*i, second)); // Doesn't work
    }
  }
}
public class Test{
  public static void Main(){
    Console.Write("Enter a number: ");
    int val = Convert.ToInt32(Console.ReadLine());
    Console.WriteLine(_Test.main(val));
  }
}

Однако, переписав этот код почти один в один на C++ (с шаблонами вместо дженериков), получаем... нерабочий код:

#include <iostream>
template <class A> class ScalarProduct {
public:
  virtual int scalarProduct(const A &second) const = 0;
};
class Nil : public ScalarProduct<Nil> {
public:
  Nil(){}
  virtual int scalarProduct(const Nil &second) const {
    return 0;
  }
};
template <class A> class Cons : public ScalarProduct<Cons<A> > {
public:
  int value;
  const A &tail;
  Cons(int _value, const A &_tail) : value(_value), tail(_tail) {}
  virtual int scalarProduct(const Cons<A> &second) const {
    return value * second.value + tail.scalarProduct(second.tail);
  }
};
class _Test {
public:
  static int main(int n){
    return _main<Nil>(n, 0, Nil(), Nil());
  }
  template <class A> static int _main(int n, int i, const A &first, const A &second){
        if (n == 0) {
            return first.scalarProduct(second);
        } else {
          return _main(n-1, i+1, Cons<A>(2*i+1,first), Cons<A>(i*i, second)); // Doesn't work
          //return _main(n-1, i+1, Cons<Nil>(2*i+1, Nil()), Cons<Nil>(i*i, Nil())); // Works, but isn't what we want
        }
    }
};
int main(int argc, char* argv[]){
  std::cout << "Enter a number: ";
  int val;
  std::cin >> val;
  std::cout << _Test::main(val) << std::endl;
  return 0;
}

Бесконечное развёртывание шаблонов.

Джавский вариант тоже, разумеется, работает.

Originally posted on migmit.vox.com

02:29: On Vox: No power in the Verse...

Получил инвайт на Google Wave.
Краткое резюме: что это было, Бэрримор?
Более подробно:
i) Как до логина, так и после непонятно нифига вообще. Выглядит как почта с двумя сообщениями - в одном хотят показать видео на 80 минут (ага, побежал), в другом предлагают послать инвайты. Ещё есть кнопка "New wave". В отличие от Ивана Бездомного у меня нет привычки трогать вещи без необходимости.
ii) Слева есть надпись Searches. Добиться от неё чего-нибудь вменяемого мне не удалось.
iii) Кто-то подсказал ввести в строке поиска with:public. Экран зарябил, показав штук пятьдесят картинок размером в полсантиметра. В них правда можно что-то понять?
iv) Попробовал один из заголовков. В правой части вылез текст, после чего браузер повис. Ненадолго, правда. Посмотрел, что там есть. Честно говоря, я не думал, что XXI веке увижу форум, который жалкой сотней мелких сообщений подвесит браузер. Вау.
v) По мотивом моих попыток найти вменяемый хелп: кто-нибудь ДЕЙСТВИТЕЛЬНО думает, что вставлять игру Судоку в форумное сообщение - это круто и ваще?
vi) Слева - список контактов. У меня сложилось ощущение, что его какой-то рандом заполняет. Я пару раз видел там список из, примерно, двадцати пунктов, причём люди там были сплошь незнакомые.
vii) Из комментов к какому-то блогпосту: solution in search for a problem. По ощущениям - похоже.
viii) Если кто-то захочет мне сказать, что всё круто, просто я ничего не понял: не трудитесь, я, собственно, то и говорю: я не понял.
В общем, см. краткое резюме в начале поста.

Originally posted on migmit.vox.com

19:17: On Vox: Текущая работа

Картинка из игры, которую мы сейчас делаем. Без комментариев.

Originally posted on migmit.vox.com

01:16: On Vox: Игрушечный веб 2.0

Так как грёбаный ЖЖ не пропускает длинные посты, а бить на десять частей я не собираюсь, выложено только на Vox: клик сюды

Originally posted on migmit.vox.com

01:14: On Vox: Мысли в кучу

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

То, в чём я не сомневаюсь.

1. Никаких инопланетян, ангелов, чертей, вампиров (увы), господа бога или Святого Ника. Если другой разум - отличный от человеческого - появится в последней серии, то это будет совершенно дикий рояль в кустах. Если не в последней - тот факт, что именно эти гады виноваты в происшедшем, станет, к сожалению, очевидным.


2. Никакой мистики вообще. Если бы в этом сериале была возможна мистика - она бы уже проявилась, три серии, как-никак.


3. Не природный катаклизм. Слишком легко списать всё на стихию. Обесценивает всё проведённое расследование.

Теории

1. Теория темпорального эха. Пока что все персонажи считают, что, кто бы ни стоял за происшедшим, он уже всё сделал. Нажал кнопку, или что там ещё. Но, поскольку мы и так имеем дело с временной аномалией, почему не допустить, что всё произойдёт 29 марта (30-го в Европе), а имевшее место затемнение - просто эхо, откатившееся НАЗАД во времени.


2. Теория шахматиста. Только у меня возникает ощущение, что наши ФБР-овцы не столько расследование ведут, сколько реагируют на ниточки, которые кто-то осознанно дёргает? И если да, то не может ли быть так, что цель затемнения - или одна из целей - это добиться того, чтобы главные герои сделали что-то или оказались где-то?

Вопросы

1. Может ли вообще наступить то будущее, которое было в видениях? Ни в жисть не поверю, что не найдётся человек, достаточно упрямый, чтобы просто назло судьбе сделать наоборот. В конце концов, для этого не много нужно. Один из ФБР-овцев говорил, если не вру, что в его видении он смотрел новости по телевизору. Что ему будет стоить выключить телевизор в соответствующее время, тем более, что оно хорошо известно. С другой стороны, некоторые, по-видимому, должны к этому времени умереть. Возможно, события подгадают таким образом, чтобы именно эти упрямцы и умерли?


2. Дима Но. С одной стороны, похоже, он умрёт. С другой стороны, слишком уж активно нас подталкивают к тому, что именно это и должно случиться. И именно это, в свою очередь, напоминает о теории шахматиста - сначала Димке подсунули шерифшу, которая тут же и умерла, потом последовал звонок фиг знает откуда. Ему как бы не говорят прямым текстом (звонок по телефону не есть прямой текст, ибо его таинственность внушает сомнения), а подводят к такому убеждению. Возможно, шахматист хочет, чтобы Димка верил, что умрёт - как, скажем, в Drive профессор верил в свою обречённость, и в результате действовал так, как никогда бы не подумал действовать, будь его здоровье в порядке.


3. Нулевой. Поведение этого товарища очень странно. Если он не знал о затемнении - то почему вёл себя так спокойно? Не паниковал, даже не торопился найти какое-нибудь укрытие (то, что сделал бы я). Спокойно прошёл по трибуне и удалился. Может быть, он душевнобольной? Интересно, аутисты посещают спортивные мероприятия, или им до фени? Если он знал - почему он вообще оказался на этом стадионе? Почему не отсиделся дома? Если он хотел понаблюдать за толпой - кто мешал ему выбрать местечко на крыше небоскрёба и смотреть на какую-нибудь оживлённую улицу? Может, он хотел запечатлеться на камеру? Согласуется с теорией шахматиста, но что-то в этом направлении никакого продвижения пока не видно. Может быть, он не ЗНАЛ о затемнении, но быстро всё понял? Скажем, если это талантливый физик, который зарание просчитал, что что-то подобное может быть результатом, например, включения Большого Гудронного Уклайдера? Кстати, это согласуется с теорией темпорального эха. А по телефону он тогда разговаривал со своим приятелем, который тоже был в курсе этой теории - Алё, Вовка? У тебя там такой же бардак, как и здесь? А что я тебе говорил? Вот-вот, и не зря мы те таблетки принимали, а то тоже валялись бы по земле.


4. Ди Гиббонс. Разговор по телефону с Нулевым согласуется с гипотезой, что они хотели быть обнаруженными (трудно было бы представить, что ФБР не узнает рано или поздно, что во время затемнения случился разговор по телефону) - и с теорией шахматиста. С другой стороны, как сказано в предыдущем пункте, может согласовываться и с теорией темпорального эха. Что о нём знает Чарли и почему она называет Гиббонса "Ди"? Не "Дэвид Гиббонс", не "мистер Гиббонс", а именно "Ди"? Может быть, имя Гиббонса было где-нибудь написано? Умеет ли Чарли в её возрасте читать? Вероятно, да. Не является ли "Ди Гиббонс" кивком в сторону Дейва Гиббонса, соавтора "Вотчменов"? Последнее уже к загадкам сериала не относится.


5. Герр Гейер. Уж больно аккуратно он их развёл. Кто знает, может быть, его освобождение было одной из целей шахматиста (буде таковой существует)?


6. Сам феномен бодрствования во время затемнения. Поведение Нулевого может быть объяснено разными причинами, а вот его телефонный разговор с другим бодрствующим практически доказывает, что они сохранили сознание не случайно. Они что-то делали для этого. С другой стороны, мальчик в сомалийском флэшбеке точно был никак не связан с организаторами безобразия. У него шрам на лице - может быть, это как-то связано с его бодрствованием? Согласуется с гипотезой о психическом заболевании. Возможно, Нулевой и Ди Гиббонс страдают одним и тем же заболеванием? Может быть, они подружились на сеансе групповой терапии и когда началось затемнении, один просто рефлекторно позвонил своему единственному другу? Согласуется с тем, что поведение Гиббонса во время попытки ареста было, скажем так, неадекватным. Однако неужели подобное - явно редкое - заболевание оставит после себя лишь небольшой шрам на лбу, причём в стране, где доктор Хаус не живёт?


7. Что это за фаллический символ стоял в Сомали и что за белая субстанция из него выплеснулась? Да, я осознаю, что вопрос пошлый.
8. Те спецназовцы в видении Марка. Они шли за ним? Или за Стэном? Если бы Стэн находился у себя, то он был бы поблизости - Марк его, помнится, даже спрашивал, не видел ли он чего-нибудь. Он в это время сидел в сортире, но киллеры могли этого не знать.

Originally posted on migmit.vox.com

01:03: On Vox: Хозяйке на заметку

Текущие настройки mencoder-а для конвертации видео на айфон:

mencoder источник.avi -o результат.mp4 -vf dsize=480:320:0,scale=-8:-8,harddup -oac faac -faacopts mpeg=4:object=2:raw:br=128 -of lavf -lavfopts format=mp4 -ovc x264 -x264encopts nocabac:level_idc=30:bframes=0:global_header:threads=auto:subq=5:frameref=6:partitions=all:trellis=1:chroma_me:me=umh:bitrate=500:no8x8dct

Вот так вот.

Originally posted on migmit.vox.com

22:36: On Vox: Code Jam

Итак, оно кончилось. 759 место, дальше не прохожу. Решил первую задачу и первую часть третьей - оно таки обломалось на large set. Вывод: с некоторыми базовыми алгоритмами у меня, всё-таки, плохо.

Originally posted on migmit.vox.com

20:49: On Vox: Почувстовал себя персонажем анекдота

когда набрал в терминале "which watch".

Originally posted on migmit.vox.com

09:26: On Vox: Первый аплоад на Hackage

compose-trans-0.0

Сделан по мотивам вот этого поста. Очень сильно отрефакторено и упрощено.

Originally posted on migmit.vox.com

13:07: On Vox: Какой австралопитек

делал функцию "Родительский контроль" в винде? Неужели он не мог посмотреть хотя бы на макось? Как вообще в его микроскопический мозг пришла мысль, что родитель должен задавать не общее время, которое чадо проводит за компом, а конкретные часы? Не "два часа в день", а "с 17:30 до 19:30"? Или эта хуйня разрабатывалась изначально для использования в пенитенциарных учреждениях?

Почему, интересно, в макоси, да и в любом другом юниксе, никого не ебёт, какие программы юзер установит для себя лично, главное, чтобы не пытался лезть в чужие данные - а в этой куче дерьма под названием Vista по умолчанию установка софта запрещена всем не-админам? Это надо понимать как признание, что ихний выкидыш представляет собой глюк на глюке, который упадёт от первого залетевшего дятла? Какого хрена? Раньше я думал, что под админом работают только идиоты. Похоже, что в винде другого варианта вообще нет.

Ощущение такое, что виста - это не ОС, а демка. А винда Home Basic, которая шла вместе с компом - демка от демки. Повбывав бы. Уроды. Все.

Originally posted on migmit.vox.com

22:27: On Vox: Просто забавно

Вчера всем, конечно, было не до того. Но сегодня должны были уже отойти, так что:

Originally posted on migmit.vox.com

22:05: On Vox: Ну и денёк

Началось, как обычно, с мелочи. Дизайнеры сделали новую модель игрока, заменив устрашающий солдафонский костюм на футболку и джинсы, не менее устрашающие. В какой-то момент игрок посмотрел в небо, слегка отклонившись при этом назад. С другой позиции сразу стало видно, как автомат, висевший у игрока за спиной, прошёл у него между ногами и нагло торчит дулом аккурат из ширинки. Особо впечатлительные крестились и украдкой прикасались к томику Фрейда.
А потом пришла дверь. Обыкновенная дверь, которая просто не открывалась. До тех пор, пока её не переключали из режима физики в режим анимации, в котором она медленно открывалась, быстро захлопывалась и делала goto :begin. И надо же было именно на ней тестировать новый режим - когда работает и физика, и анимация сразу. Дверь начала исполнять танец пьяного ёжика вокруг косяка, вылетая далеко за запланированные пределы её перемещений. Испуганный девелопер выключил анимацию. Дверь пришла в себя, снялась с петель и, издевательски вращаясь вокруг вертикальной оси, улетела за горизонт.
Под конец сисадмин попросил зашедшего к нему по какой-то надобности директора налить ему чаю, потому как он сам, видите ли, до сих пор не сумел разобраться в управлении чайником.
Что-то будет завтра...

Originally posted on migmit.vox.com

23:20: On Vox: TWIMC

Если кому интересно, то начистить мне чайник можно здесь: http://migmit.mybrute.com

Originally posted on migmit.vox.com

23:42: On Vox: Классы как типы

А мне всего-то хотелось сделать композицию трансформеров...

> {-# LANGUAGE GeneralizedNewtypeDeriving, RankNTypes, TypeOperators #-}
> module MonadM where
> import Control.Monad

Допустим, мы хотим применить к некоторой монаде несколько трансформеров. Причём, мы заранее не знаем, к какой именно монаде - но знаем, какие трансформеры. Ну, например, пусть это будут

> newtype StateT s m x = StateT {runStateT :: s -> m (s, x)}
> instance Monad m => Monad (StateT s m) where
>     return x = StateT $ \s -> return (s, x)
>     st >>= f = StateT $ \s -> runStateT st s >>= \(s', x) -> runStateT (f x) s'

и

> newtype ReaderT r m x = ReaderT {runReaderT :: r -> m x}
> instance Monad m => Monad (ReaderT r m) where
>     return x = ReaderT $ \r -> return x
>     rt >>= f = ReaderT $ \r -> runReaderT rt r >>= \x -> runReaderT (f x) r

Конечно, нет никакой проблемы написать трансформер-композицию.

newtype SRT s r m x = SRT (ReaderT r (StateT s m) x)

Далее, можно точно также объявить

instance Monad m => Monad (SRT s r m)

и жить припеваючи.

Но очень хотелось бы сделать это единообразно, написать единый оператор композиции трансформеров. А то вдруг, скажем, мы решим поменять порядок этих трансформеров - что же тогда, инстанс переделывать?

Попробуем это сделать. Для начала, всё-таки, объявим класс для трансформеров, чтобы не всухомятку обсуждать:

class Trans t where
    lift :: m x -> t m x

И сделаем простенькую композицию:

newtype (Trans t1, Trans t2) => (t2 :. t1) m x = Compose {runCompose :: t2 (t1 m) x} deriving Monad

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

Далее, нужно, чтобы это был снова трансформер:

instance (Trans t1, Trans t2) => Trans (t2 :. t1) where
    lift = Compose . lift . lift

Пока что, всё работает прекрасно. Давайте же сделаем два наших трансформера инстансами соответствующего класса, зарелизим библиотеку на Hackage и пойдём пить кофе с бубликами.

instance Trans (StateT s) where
    lift mx = StateT smx
        where smx s =
                  do x <- mx
                     return (s, x)

Упс. Получили ругань:

MonadM.lhs:54:23:
    Could not deduce (Monad m) from the context ()
      arising from a do statement
                   at MonadM.lhs:54:23-29
    Possible fix:
      add (Monad m) to the context of the type signature for `lift'
    In a stmt of a 'do' expression: x <- mx
    In the expression:
        do x <- mx
           return (s, x)
    In the definition of `smx':
        smx s = do x <- mx
                   return (s, x)
Failed, modules loaded: none.

Фикус в том, что для того, чтобы написать нашу функцию lift, нам нужно использовать, что аргумент засунут именно в монаду, а не во что-то ещё. Действительно нужно, это не фантазия какая-то.

Попробуем пофиксить, изменив сигнатуру lift.

class Trans t where
    lift :: Monad m => m x -> t m x

Опять облом.

MonadM.lhs:49:23:
    Could not deduce (Monad (t1 m)) from the context (Monad m)
      arising from a use of `lift'
                   at MonadM.lhs:49:23-26
    Possible fix:
      add (Monad (t1 m)) to the context of the type signature for `lift'
      or add an instance declaration for (Monad (t1 m))
    In the first argument of `(.)', namely `lift'
    In the second argument of `(.)', namely `lift . lift'
    In the expression: Compose . lift . lift
Failed, modules loaded: none.

Теперь проблема в том, что из instance Monad m и instance Trans t не следует instance Monad (t m). Практически это всегда так - по крайней мере, это так для двух трансформеров, которые мы определили в самом начале. Но у нас нет способа убедить компилятор, что это и будет всегда так.

Подход, принятый в шаблонах C++ заключается в том, чтобы забить на контекст вообще и ругаться, если он не выполняется в каждом конкретном случае. Думаю, в языке, принимающем статическую типизацию близко к сердцу, подобный вариант не имеет права на существование.

В Языке Моей Мечты(tm) я бы написал так:

class Trans t where
    lift :: Monad m => m x -> t m x
    instance Monad m => Monad (t m)

После чего я перенёс бы instance Monad m => Monad (StateT s m) внутрь instance Trans (StateT s) и всё заработало бы. Увы, Язык Моей Мечты(tm) пока лишён важной утилиты, а именно, компилятора. Нет, интерпретатора тоже нет. Так что, этот способ тоже не сработает.

Попробуем иначе. Что нам нужно, так это добавить в класс Trans какую-то функцию, которая сообщит компилятору, что происходит именно преобразование монад, а не чего-то ещё. Иначе говоря, нам нужно работать с классом Monad как с типом данных.

Попробуем это сделать.

Что вообще означает, что некоторый тип T является монадой? Это означает, что для данного типа определены несколько операций. Как учит нас теория категорий, где есть алгебраические операции (или похожие на них), стоит искать... монаду. Да-да, монаду. Правда, так как наши типы имеют не тот kind, эта монада также будет монадой на другой категории. Следовательно, имеет смысл для начала определить эту категорию:

> type (m :-> n) = forall x. m x -> n x

Вот они - морфизмы нашей новой категории.

Далее, опять же, теория категорий учит, что новую монаду нужно определять так: объекту p ставится в соответствие нечто вроде "множества всех выражений, составленных при помощи заданных операций из элементов p". То есть, в нашем случае подошло бы что-то в таком духе:

data MonadM p x where
    Term :: p x -> MonadM p x
    Return :: x -> MonadM p x
    Bind :: MonadM p x -> (x -> MonadM p y) -> MonadM p y

Я, однако, предпочитаю более простой и универсальный подход. Сейчас я определю тот же тип, но по-другому. Вуаля:

> newtype MonadM p x = MonadM {bindM :: Monad m => (p :-> m) -> m x}

Это и правда то же самое. Теперь, MonadM имеет kind

*MonadM> :k MonadM
MonadM :: (* -> *) -> * -> *

и, следовательно, похож на монаду на категории типов kind-a (* -> *). Не хватает только функций return и (>>=) для полного счастья. Сейчас мы их определим.

Начнём с return. Обычно, эта функция имеет тип x -> m x (так она определена в классе Monad). У нас, следовательно, тип будет

> term :: p :-> MonadM p

Такую функцию написать несложно, и делается это, по существу, единственным образом:

> term px = MonadM $ \hom -> hom px

Далее, оператор (>>=). Он у нас, по сути, уже есть. Это функция bindM. Её тип поначалу не кажется похожим на то, что нам нужно, но только потому, что у нас не хватает ещё одного важного элемента:

> instance Monad (MonadM p) where
>     return x = MonadM $ \hom -> return x
>     mpx >>= f = MonadM $ \hom -> bindM mpx hom >>= \x -> bindM (f x) hom

В этом определении мы просто говорим, что правая часть, по существу, совпадает с левой, только вокруг тех штук, которые имеют тип MonadM p x добавляется некий line noise в виде bindM и hom.

Теперь мы видим, что функция bindM имеет тип, который, во всяком случае, не хуже, чем то, что нам нужно:

*MonadM> :set -XTypeOperators -XRankNTypes
*MonadM> :t bindM :: MonadM p x -> (p :-> MonadM p) -> MonadM p x
bindM :: MonadM p x -> (p :-> MonadM p) -> MonadM p x
  :: MonadM p x -> (p :-> MonadM p) -> MonadM p x

Хорошо. Далее, то, чему не учат в Haskell-школах: конкретный объект с нужными нам операциями является ни чем иным как алгеброй над подобной монадой. В нашем случае это значит, что каждая монада является алгеброй над MonadM. Более конкретно, для каждой монады есть отображение

alg :: Monad m => MonadM m :-> m

Именно, оно пишется так:

alg (MonadM h) = h id

В данном случае, id имеет тип m :-> m.

Как же это поможет нам решить нашу проблему? А вот как: по сути дела, указать для некоторого типа отображение alg и определить для этого же типа instance Monad - одно и то же. !. Я определю специальный тип:

> newtype Inst m = Inst {getInst :: MonadM m :-> m}

и навешу конструктор на alg следующим образом:

> alg :: Monad m => Inst m
> alg = Inst $ \mmx -> bindM mmx id

Далее, идеология происходящего следующая. Если нам нужно что-то сделать с типом m, для чего требуется instance Monad, а у нас вместо него только значение inst :: Inst m, то мы проделываем всё необходимое, используя вместо m тип MonadM m (который всегда является монадой - определение только что было), а потом переносим это на тип m, используя при этом отображения term :: m :-> MonadM m и getInst inst :: MonadM m :-> m.

Для того, чтобы этот перенос осуществить, нам потребуется такой класс:

class Iso t where iso :: (m :-> n) -> (n :-> m) -> (t m :-> t n)

На самом деле, мне неизвестны трансформеры монад, которые не были бы ковариантны по этим монадам, так что можно сократить сигнатуру:

> class Iso t where iso :: (m :-> n) -> (t m :-> t n)

instance Iso обычно пишется несложно и бойлерплейт получится весьма небольшой.

В частности, например, легко написать такое:

> infixl 1 `bindM`
> instance Iso MonadM where iso hom mmx = mmx `bindM` term . hom

Заметьте, я здесь, фактически, воспроизвёл определение функции liftM:

liftM f mx = mx >>= return . f

Класс трансформеров теперь определяется так:

> class Iso t => Trans t where
>     lift :: Monad m => m x -> t m x
>     liftInst :: Inst m -> Inst (t m)

Обратите внимание на изменившийся контекст.

В частности, теперь можно сделать трансформером композицию трансформеров.

> newtype (Iso t1, Iso t2) => (t2 :. t1) m x = Compose {runCompose :: t2 (t1 m) x} deriving Monad
> infixr 9 :.

Здесь я изменил контекст с Trans на Iso, чтобы следующий инстанс выглядел более вменяемо:

> instance (Iso t1, Iso t2) => Iso (t2 :. t1) where iso hom ttmx = Compose $ iso (iso hom) $ runCompose ttmx

Ну и, как я и обещал, композиция трансформеров - трансформер:

> instance (Trans t1, Trans t2) => Trans (t2 :. t1) where

Нам нужно пройти от m x к (t2 :. t1) m x

Обычно мы пошли бы по маршруту m x --> t1 m x --> t2 (t1 m) x --> (t2 :. t1) m x.

Увы, если первый и последний шаги особых проблем не представляют, то второй шаг, увы, невозможен, так как t1 m не является монадой (по крайней мере, мы не можем убедить компилятор, что является). Однако, у нас есть значение alg :: Inst m, и, следовательно, также и значение liftInst alg :: Inst (t1 m). В соответствии с общей идеологией, мы сделаем второй шаг несколько более длинным, а именно, пройдём по маршруту t1 m x --> MonadM (t1 m) x --> t2 (MonadM (t1 m)) x --> t2 (t1 m) x.

Делаем:

    lift = Compose . step2 . lift
        where step2 = iso (getInst $ liftInst alg) . lift . term

или, коль скоро принцип ясен,

>     lift = Compose . iso (getInst $ liftInst alg) . lift . term. lift
>     liftInst = isoInst . liftInst . liftInst
>         where isoInst :: (Iso t1, Iso t2) => Inst (t2 (t1 m)) -> Inst ((t2 :. t1) m)
>               isoInst inst = Inst $ \mmx -> Compose $ getInst inst $ iso runCompose mmx

Пока всё не слишком (надеюсь) сложно. Но сумеем ли мы сделать наши StateT и ReaderT инстансами класса Trans? Ну, первая часть проблем не вызывает:

> instance Iso (StateT s) where iso hom smx = StateT $ hom . runStateT smx
> instance Trans (StateT s) where
>     lift mx = StateT smx
>         where smx s =
>                   do x <- mx
>                      return (s, x)

Здесь почти ничего не изменилось. Далее, нам нужно от Inst m перейти к Inst (StateT s m).

Если бы m было монадой, то всё было бы не просто, а очень просто: достаточно было бы использовать значение alg, поскольку instance Monad m => Monad (StateT s m) у нас уже есть. Увы, m не обязательно является монадой, однако мы начинаем со значения типа Inst m! В соответствии с общей идеологией, мы пройдём по маршруту MonadM (StateT s m) --> MonadM (StateT s (MonadM m)) --> StateT s (MonadM m) --> StateT s m следующим образом:

    liftInst inst = Inst $ iso (getInst inst) . getInst alg . iso (iso term)

У меня лично сразу проситься вынести alg в дополнительный параметр и написать так:

>     liftInst = makeLiftInst alg
> makeLiftInst :: Iso t => Inst (t (MonadM m)) -> Inst m -> Inst (t m)
> makeLiftInst alg' inst = Inst $ iso (getInst inst) . getInst alg' . iso (iso term)

Тип для функции makeLiftInst, признаюсь, написал не я, а компилятор. Ну, пусть будет.

Аналогично пишется инстанс для ReaderT:

> instance Iso (ReaderT r) where iso hom rmx = ReaderT $ hom . runReaderT rmx
> instance Trans (ReaderT r) where
>     lift mx = ReaderT $ const mx
>     liftInst = makeLiftInst alg

Обратите внимание, что объявление функции liftInst совершенно одинаковое, что для StateT, что для ReaderT. Мы можем написать ещё несколько трансформеров, но везде будет то же самое. Нельзя ли его написать, например, как дефолтную реализацию в самом классе? Попробовав, получаем

MonadM.lhs:392:30:
    Could not deduce (Monad (t (MonadM m))) from the context ()
      arising from a use of `alg'
                   at MonadM.lhs:392:30-32
    Possible fix:
      add (Monad (t (MonadM m))) to the context of
        the type signature for `liftInst'
      or add an instance declaration for (Monad (t (MonadM m)))
    In the first argument of `makeLiftInst', namely `alg'
    In the expression: makeLiftInst alg
    In the definition of `liftInst': liftInst = makeLiftInst alg
Failed, modules loaded: none.

Увы, так не получится. Причина здесь в том, что мы для каждого конкретного T определяем instance Monad m => Monad (T m) отдельно, и строчка liftInst = makeLiftInst alg как бы является обещанием, что такой инстанс определён где-то в другом месте; компилятор же это обещание тщательно проверит.

На закуску - применение трансформера к монаде. Конечно, можно применять и так, но в некоторых случаях более общий подход может пригодиться:

> newtype Monad m => (t :$ m) x = Apply {runApply :: t m x}
> infixr 0 :$
> instance (Trans t, Monad m) => Monad (t :$ m) where
>     return x = Apply $ getInst (liftInst alg) $ return x
>     tmx >>= f = Apply $ getInst (liftInst alg) $ term (runApply tmx) >>= \x -> term (runApply $ f x)

Фикус в том, что мы дописываем к значениям tmx :: (t :$ x) x мусор вида term (runApply tmx), а обратно приходим при помощи Apply . getInst (liftInst alg). В остальном же, мы просто в правой части повторяем левую.

Теперь можно писать, например, (StateT Int :. ReaderT String :$ Maybe) Char и это будет примерно (с точностью до newtype-ов) то же самое, что и (StateT Int :$ ReaderT String :$ Maybe) Char или State Int (ReaderT String (Maybe Char)).

Если кто-то вдруг захочет написать собственный трансформер MyCoolTransformer - нет проблем, пусть сделает три вещи:

1)

instance Monad m => Monad (MyCoolTransformer m)

Если этого не сделать, то непонятно, почему вообще речь идёт о трансформерах монад.

2)

lift :: m x -> MyCoolTransformer m x

Это - то, для чего трансформеры монад действительно нужны.

3) Заклинание liftInst = makeLiftInst alg, которое пишется без участия мозга. Как видим, весь бойлерплейт сведён к одной строчке - что можно записывать как победу.

Маленькое замечание: здесь мы почти не пользовались тем, что речь идёт именно о монадах. Точно то же самое можно написать про трансформеры, например, стрелок. Понадобиться только а) изменить понятие морфизма, так как стрелки имеют другой kind, б) заменить два инстанса на полностью аналогичные, один для нашей "монады" (которая, если мы заменим монады на стрелки,.. останется монадой), и один для оператора применения трансформера к монадестрелке.

Originally posted on migmit.vox.com

20:08: On Vox: Когда-то, когда я был гораздо моложе...

я пытался освоить Лисп. И там была одна вещь, которую моё подсознательное всякий раз отвергало.

Я в принципе не мог понять, как это - результатом конструкций типа progn является результат последнего выражения. А куда же деваются результаты остальных???

Нет, разумом я понимаю: они производят некий сайд-эффект. Проблема в том, что то, что должно возвращать значение, и то, что по смыслу никакого значения возвращать не должно, а нужно только для сайд-эффекта, глазом не различается никак. Поэтому принять эту концепцию сердцем я не мог. Мне всё время казалось, что если результат этой штуковины не нужен, то её можно будет просто выкинуть, она нафиг не нужна.

Даже в Паскале сразу очевидно - здесь у нас ":=" и интересует нас возвращаемое значение; а здесь у нас никакого ":=" нет, и интересует нас сайд-эффект.

И поэтому основной частью do-синтаксиса в Хаскеле я считаю синтаксическую разницу между действием и связыванием переменной:

do action
   ...

или

do var <- expression
   ...

Originally posted on migmit.vox.com

14:51: On Vox: Игрушечный веб - 3

Я таки сделал этот чёртов ArrowLoop!

Не буду бить на несколько модулей - на винчестере у меня сейчас всё уже сильно не так, сделано довольно много изменений, так что я просто напишу, как делать ArrowLoop - используя при этом три модуля из первого постинга на эту тему.

Для начала - шапка:

> {-# LANGUAGE Arrows #-}
> module Loop where
> import Control.Arrow
> import qualified Control.Category as C
> import Control.Monad
> import Control.Monad.Fix
> import Data.Maybe
> import Data.Monoid
> import Pointed
> import Serialize
> import NetState

Здесь нет ничего особо интересного. Единственное что - я импортирую Control.Monad.Fix, потому что в одном месте мне будет удобно явно написать функцию fix.

Тип Signal из предыдущего постинга претерпел некоторые изменения - в частности, он перестал быть монадой и стал функтором:

> newtype Signal link html a = Signal ((a -> link) -> html)
> instance Functor (Signal link html) where fmap f (Signal s) = Signal $ \linkMaker -> s $ linkMaker . f

Кроме того, он является АДДИТИВНЫМ функтором - и я слегка офигел, обнаружив, что в стандартной библиотеке такого класса нет:

> class Functor f => Additive f where
>     azero :: f a
>     aplus :: f a -> f a -> f a
> instance Monoid html => Additive (Signal link html) where
>     azero = Signal $ const mempty
>     Signal s1 `aplus` Signal s2 = Signal $ \linkMaker -> s1 linkMaker `mappend` s2 linkMaker

Старый тип Signal восстанавливается из нового, а его instance Monad - из instance Additive нового:

> data SignalMonad f a = SignalMonad a (f a)
> instance Additive f => Monad (SignalMonad f) where
>     return x = SignalMonad x azero
>     SignalMonad x fx >>= h = let SignalMonad y fy = h x in SignalMonad y $ fmap (\x -> let SignalMonad y _ = h x in y) fx `aplus` fy

Теперь старый тип Signal становится SignalMonad (Signal). Получился симпатичный рефакторинг.

Однако, нам не нужен старый тип Signal. Нам нужен его вариант, имеющий не только выход, но и вход, причём (!) часть его входа может зависеть от выхода. Именно наличие такой зависимости делает возможным создание instance ArrowLoop.

Делаем:

> data SignalArrow f input output = SignalArrow {pure :: input -> output, effect :: (output -> input) -> f output}

От Kleisli(SignalMonad Signal) это отличается только тем, что вместо input в одном месте стоит (output -> input). Вот она и зависимость.

Далее - довольно стандартные инстансы. Основная идея композиции таких стрелок - если мы знаем, как возвращать сигнал из конца в начало, а нам нужно вернуть его из СЕРЕДИНЫ в начало, то мы сначала протаскиваем его в конец, а потом возвращаем в начало известным способом. Аналогично, если нужно вернуть сигнал из конца в середину - мы возвращаем его в начало, а затем протаскиваем в середину.

> instance Additive f => C.Category (SignalArrow f) where
>     id = arr id
>     sl2 . sl1 = SignalArrow {pure = pure sl2 . pure sl1, effect = e}
>         where e reaction = fmap (pure sl2) (effect sl1 $ reaction . pure sl2) `aplus` effect sl2 (pure sl1 . reaction)

Функция first требует некоторого допинывания ногами, но, как только нам удаётся удовлетворить тайпчекер - всё работает.

> instance Additive f => Arrow (SignalArrow f) where
>     arr f = SignalArrow {pure = f, effect = const azero}
>     first sl = SignalArrow {pure = first (pure sl), effect = e}
>         where e reaction = 
>                   let findZ output = let (input, z) = reaction (output, z) in (output, z)
>                   in fmap findZ $ effect sl $ fst . reaction . findZ

Теперь обещанный ArrowLoop. Мы специально постарались сделать всё так, чтобы можно было его написать - ничего удивительного, что он таки написался, причём легко.

> instance Additive f => ArrowLoop (SignalArrow f) where
>     loop sl = SignalArrow {pure = \input -> let (output, z) = pure sl (input, z) in output, effect = e}
>         where e reaction = fmap fst $ effect sl $ first reaction

Наконец, самое забавное. ArrowChoice.

Фишка в том, что ArrowChoice даёт нам возможность, в зависимости от приходящих сигналов, рендерить разные части виджета. При этом мы не хотим, чтобы сигнал, пройдя через виджет и вернувшись назад по какому-то циклу, поменял выбор той части, которая должна рендериться. Смена отображаемого куска должна происходить только между загрузками страницы, но не во время. Гарантировать это статически мы не можем никак. Поэтому я сознательно допускаю возможность, что в этом месте вычисление упадёт с ошибкой. Оно не должно падать - и не будет, если страница написана нормально.

> instance Additive f => ArrowChoice (SignalArrow f) where
>     left sl = SignalArrow {pure = left $ pure sl, effect = e}
>         where e reaction =
>                   case fix $ reaction . left (pure sl) of
>                     Left _ -> fmap Left $ effect sl $ \output -> let Left input = reaction $ Left output in input
>                     Right _ -> azero

Собираем всё это вместе, не забыв, как обычно, добавить состояние:

> type Link = String
> type Html = String
> type Widget = NetState (SignalArrow (Signal Link Html))

На вход всей страницы всегда подаётся (), а локальное состояние зачитывается из пришедшего от пользователя URL. Выход страницы игнорируется - поэтому, обратной связи, фактически, не будет - точнее, вместо функции она будет константой:

> renderPage :: Widget () output -> Maybe Link -> Html
> renderPage (NetState sl) ml =
>     let Signal render = effect sl $ const ((), maybe point readSer ml)
>     in render $ \(_, local) -> writeSer local

Теперь нужны label, link и state - почти такие же, как в прошлом постинге.

Для начала - label. Выход label - всегда (), поэтому обратная связь не может быть ничем, кроме константы; нас интересует, следовательно, её единственное значение:

> label :: Widget String ()
> label = NetState $ SignalArrow {pure = const ((),()), effect = \reaction -> Signal $ const $ fst (reaction ((),())) ++ "\n"}

Вход link - всегда (), поэтому обратная связь может быть только const (). Поэтому, мы её вообще проигнорируем.

> link :: String -> Widget () Bool
> link caption = NetState $ SignalArrow {pure = const (False, ()), effect = const $ Signal $ \linkMaker -> caption ++ " <" ++ linkMaker (True, ()) ++ ">\n"}

Ну и, наконец, state. State не отображается никак, а потому не интересуется обратной связью.

> state :: Serialize local => local -> Widget (local -> local) local
> state initial = NetState $ SignalArrow {pure = p, effect = const azero}
>     where p (f, ml) = let l = fromMaybe initial ml in (l, Just $ f l)

Готово. Попробуем, чтобы убедиться, что старые примеры продолжают работать:

> test1 =
>     proc () ->
>         do clicked <- link "+" -< ()
>            number <- state (0 :: Integer) -< if clicked then (+ 1) else id
>            label -< show number
>            link "refresh" -< ()

Загружаем в GHCi:

*Loop> putStr $ renderPage test1 $ Nothing
+ <Y1,>
0
refresh <Y0,>
*Loop> putStr $ renderPage test1 $ Just "Y1,"
+ <Y2,>
1
refresh <Y1,>

Теперь убедимся, что новые фокусы тоже работают:

> test5 =
>     proc () ->
>         do rec {label -< show number;
>                 number <- state (0 :: Integer) -< if clicked then (+ 1) else id;
>                 clicked <- link "+1" -< ()}
>            link "refresh" -< ()

В этом примере всё почти также, как и в test1 - только ссылка, изменяющая счётчик, расположена ПОСЛЕ самого счётчика. Это было невозможно со старой реализацией, зато с новой:

*Loop> putStr $ renderPage test5 $ Nothing
0
+1 <Y1,>
refresh <Y0,>
*Loop> putStr $ renderPage test5 $ Just "Y1,"
1
+1 <Y2,>
refresh <Y1,>

Работает, однако. Чувствую, пора из игрушечного фреймворка делать полноразмерный.

Последнее замечание: виджет-хамелеон, который упоминался в прошлый раз, по-прежнему не делается. И я не уверен, что его удастся сделать более-менее разумным образом.

Originally posted on migmit.vox.com

22:26: On Vox: Офигительно

Довольно банальная завязка - американка, вышедшая замуж за англичанина, приезжает в его дом и знакомится с его семьёй, явно её не одобряющей - превратилась в классно сыгранный, классно поставленный фильм с классным саундтреком. Рекомендую - Easy Virtue, или "Лёгкое поведение". Кстати, в переводе, вроде бы, идёт в наших кинотеатрах прямо сейчас.

Originally posted on migmit.vox.com

02:46: On Vox: Игрушечный веб - 2
Продолжение; начало здесь
Теперь - основное: собственно, виджеты.

> {-# LANGUAGE Arrows #-}
> module HTML where
> import Control.Arrow

Этот модуль реально подключается только ради стрелок Клейсли (как мы помним, каждая монада даёт стрелку - вот, это они и есть).

> import Data.Maybe
> import Data.Monoid

Ну, куда же без моноидов...

> import NetState
> import Pointed
> import Serialize

Три предыдущих модуля. Пригодится.
Для начала мы соорудим монаду, как первое приближение к виджетам. Наш "недовиджет" будет посылать некоторый сигнал; кроме того, он будет содержать произвольное количество ссылок. Клик по каждой ссылке меняет состояния, потенциально, всех остальных виджетов на странице. Но как именно он их меняет? Только при помощи изменения выходного сигнала данного виджета - это единственный способ для нашего виджета повлиять на других. Поэтому, каждая ссылка а) определяет новый выходной сигнал, и б) содержит новые состояния всех виджетов на странице, причём б) определяется по а). Вот эту самую функцию, определяющую б) (а точнее, сразу URL, который надо запихнуть в ссылку) по а), мы передадим "недовиджету" как параметр:

> data Signal link html a = Signal a ((a -> link) -> html)

Теперь надо превратить это дело в монаду. Виджет "return" не будет отображаться вообще, он будет лишь выдавать сигнал на выход; для отображения связки двух виджетов мы сначала отображаем один из них, затем второй:

> instance Monoid html => Monad (Signal link html) where
>     return x = Signal x $ const mempty
>     Signal x render1 >>= f =
>         let Signal y render2 = f x
>             render linkMaker = render1 (\x -> let Signal y _ = f x in linkMaker y) `mappend` render2 linkMaker
>         in Signal y render

Наши URL-ы будут просто строками; выходной HTML - тоже всего лишь строкой:

> type Html = String
> type Link = String

Теперь мы хотим добавить к нашим виджетам состояние. У нас уже есть способ это сделать, но он работает со стрелками, а не с монадами. Вот тут и нужны стрелки Клейсли:

> type Widget = NetState (Kleisli (Signal Link Html))

Сразу соорудим функцию для показа наших виджетов (а вся страница, разумеется, есть один большой виджет). Нам нужно а) десериализовать состояние из пришедшего URL-а; б) передать на вход виджета... ничего не передавать, поэтому входной тип должен быть (), в) при порождении каждой ссылки из глобального состояния страницы просто сериализовать это самое глобальное состояние. Делаем:

> renderPage :: Widget () output -> Maybe Link -> Html
> renderPage (NetState (Kleisli widget)) ml =
>     let Signal _ render = widget ((), maybe point readSer ml)
>     in render $ \(_, local) -> writeSer local

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

> label :: Widget String ()
> label = NetState $ Kleisli $ \(text, _) -> Signal ((),()) $ const $ text ++ "\n"
> link :: String -> Widget () Bool
> link caption = NetState $ Kleisli $ const $ Signal (False, ()) $ \linkMaker -> caption ++ " <" ++ linkMaker (True, ()) ++ ">\n"
> state :: (Serialize local) => local -> Widget (local -> local) local
> state initial = NetState $ Kleisli $ \(f, mx) -> let x = fromMaybe initial mx in Signal (x, Just $ f x) $ const ""

Готово. Теперь можно обозвать это умным словом "фреймворк". Нет, правда, готово.
Проверим. Первый тест - страница, содержащая две ссылки и поле, отображающее число. Нажатие на первую ссылку увеличивает число на 1; нажатие на вторую - рефрешит страницу:

> test1 =
>     proc () ->
>         do clicked <- link "+" -< ()
>            number <- state (0 :: Integer) -< if clicked then (+ 1) else id
>            label -< show number
>            link "refresh" -< ()

Проверяем в GHCi:

*HTML> putStr $ renderPage test1 $ Nothing
+ <Y1,>
0
refresh <Y0,>
*HTML> putStr $ renderPage test1 $ Just "Y1,"
+ <Y2,>
1
refresh <Y1,>
*HTML> putStr $ renderPage test1 $ Just "Y2,"
+ <Y3,>
2
refresh <Y2,>

В первый раз мы подаём на вход Nothing; затем мы каждый раз подаём на вход URL из той ссылки, по которой мы, вроде как, кликнули.
Второй тест - снова две ссылки и число, но на сей раз вторая ссылка уменьшает число на 1:

> test2 =
>     proc () ->
>         do increase <- link "+" -< ()
>            decrease <- link "-" -< ()
>            number <- state (0 :: Integer) -< \n -> n + (if increase then 1 else 0) - (if decrease then 1 else 0)
>            label -< show number

Проверяем:

*HTML> putStr $ renderPage test2 $ Nothing
+ <Y1,>
- <Y-1,>
0
*HTML> putStr $ renderPage test2 $ Just "Y-1,"
+ <Y0,>
- <Y-2,>
-1
*HTML> putStr $ renderPage test2 $ Just "Y-2,"
+ <Y-1,>
- <Y-3,>
-2

Работает.
Третий пример: размещаем на странице ДВА виджета из первого примера. По идее, они должны работать независимо:

> test3 =
>     proc () ->
>         do test2 -< ()
>            test2 -< ()

И тестируем:

*HTML> putStr $ renderPage test3 $ Nothing
+ <Y1,Y0,>
- <Y-1,Y0,>
0
+ <Y0,Y1,>
- <Y0,Y-1,>
0
*HTML> putStr $ renderPage test3 $ Just "Y1,Y0,"
+ <Y2,Y0,>
- <Y0,Y0,>
1
+ <Y1,Y1,>
- <Y1,Y-1,>
0
*HTML> putStr $ renderPage test3 $ Just "Y2,Y0,"
+ <Y3,Y0,>
- <Y1,Y0,>
2
+ <Y2,Y1,>
- <Y2,Y-1,>
0
*HTML> putStr $ renderPage test3 $ Just "Y2,Y1,"
+ <Y3,Y1,>
- <Y1,Y1,>
2
+ <Y2,Y2,>
- <Y2,Y0,>
1
*HTML> putStr $ renderPage test3 $ Just "Y1,Y1,"
+ <Y2,Y1,>
- <Y0,Y1,>
1
+ <Y1,Y2,>
- <Y1,Y0,>
1

И опять работает.
Четвёртый пример: своего рода "визард" с двумя страницами, с кнопкой для переключения. На каждой странице мы разместим виджет из второго примера:

> test4 =
>     proc () ->
>         do switch <- link "switch" -< ()
>            displayFirst <- state True -< if switch then not else id
>            if displayFirst
>               then do label -< "first page"
>                       test2 -< ()
>               else do label -< "second page"
>                       test2 -< ()

GHCi-сессия:

*HTML> putStr $ renderPage test4 $ Nothing
switch <YnY0,N>
first page
+ <YyY1,N>
- <YyY-1,N>
0
*HTML> putStr $ renderPage test4 $ Just "YyY1,N"
switch <YnY1,N>
first page
+ <YyY2,N>
- <YyY0,N>
1
*HTML> putStr $ renderPage test4 $ Just "YnY1,N"
switch <YyY1,Y0,>
second page
+ <YnY1,Y1,>
- <YnY1,Y-1,>
0
*HTML> putStr $ renderPage test4 $ Just "YnY1,Y-1,"
switch <YyY1,Y-1,>
second page
+ <YnY1,Y0,>
- <YnY1,Y-2,>
-1
*HTML> putStr $ renderPage test4 $ Just "YyY1,Y-1,"
switch <YnY1,Y-1,>
first page
+ <YyY2,Y-1,>
- <YyY0,Y-1,>
1

Чего здесь не хватает?
Во-первых, каждый виджет может влиять лишь на те виджеты, которые идут после него. Для влияния "назад" нам понадобился бы instance ArrowLoop Widget - который мы автоматически получили бы, если бы сообразили instance MonadFix Signal. Тогда можно было бы написать, скажем,

> test5 =
>     proc () ->
>         do rec {label -< show number;
>                 number <- state (0 :: Integer) -< if clicked then (+ 1) else id;
>                 clicked <- link "+1" -< ()}
>            returnA -< ()

Увы, с текущей реализацией Signal это, похоже, невозможно.
Другая фишка, которую мне лично очень хотелось бы иметь - это "виджет-хамелеон", который может получить на вход другой виджет и вести себя как он, до тех пор, пока не получит новый виджет, и станет вести себя уже как он. Подобная вещь была в фуджетах; как это счастье реализовать, я лично пока не очень представляю.
На сегодня всё, спасибо за внимание.

Originally posted on migmit.vox.com