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

> 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)

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

Вот.