On Vox: Длинное, про Хаскель - часть 2

[migmit]

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

> data StateA = StateA (Maybe String) [StateA] deriving Show

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

> data A a b = A ((StateA -> a) -> (StateA, Maybe [Bool]) -> (StateA, Maybe [Bool])) ((StateA -> a) -> (StateA -> b))

Значения типа Maybe [Bool] понадобятся нам для отслеживания, в какой части стрелки был задан вопрос. В частности, значение Nothing на входе сигнализирует о том, что работа только что началась, а на выходе - о том, что работа окончена и можно забирать выходное значение.

Как и для монад, мы соорудим "клиента" для пользователя.

> runA :: A a b -> (a -> IO b)
> runA (A t f) x = runA' (StateA Nothing [], Nothing) where
>     h (StateA Nothing []) = x -- функция, по начальному состоянию (StateA Nothing []) устанавливающая значение x.
>     runA' c =
>         case t h c of
>           (s, Nothing) -> return $ f h s
>           (StateA (Just str) ss,Just bs) ->
>               do putStrLn str
>                  putStrLn $ "debug: " ++ show (ss,bs) -- эта строка тоже стоит здесь исключительно в целях отладки.
>                  putStr ">>> "
>                  str' <- getLine
>                  runA' (StateA (Just str') ss,Just bs)

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

Во-1, стрелка arr f не задаёт пользователю никаких вопросов и не выслушивает никаких ответов.

Во-2, стрелка A1 >>> A2 выполняет вначале A1 - приписывая к каждому вопросу False (функцией liftM (False:)) для индикации того, что выполняется первая стрелка - после чего выполняет A2, приписывая к каждому вопросу True. Когда же от пользователя приходит ответ, то первая часть в Maybe [Bool] используется для определения того, был ли задан вопрос внутри A1 или внутри A2, после чего убирается функцией liftM tail.

В-3, стрелка first A при первом вызове запоминает текущее состояние, и его же передаёт в стрелку A; при каждом последующем вызове, первый элемент в стеке состояний снимается, остаток обрабатывается стрелкой A, и снова навешивается первый элемент. Таким образом, первоначальное состояние проходит неизменным через всю цепочку вопросов-ответов, и в конце используется для определения той части, которая должна пройти неизменной через стрелку.

> instance Arrow A where
>     arr f = A (\_ (s, Nothing) -> (s, Nothing)) (\h s -> f $ h s)
>     ~(A t1 f1) >>> ~(A t2 f2) = A t $ f2 . f1
>         where
>           secondPart h p = let (s, mbs) = t2 (f1 h) p in (s, liftM (True:) mbs)
>           t h (s, Just (True:bs)) = secondPart h (s, Just bs)
>           t h (s, mbs) =
>               case t1 h (s, liftM tail mbs) of
>                 (s', Nothing) -> secondPart h (s', Nothing)
>                 (s', Just bs) -> (s', Just $ False:bs)
>     first ~(A t f) = A t' f'
>         where
>           t' h (s@(StateA str ss), mbs) =
>               let (s1, s2) =
>                       case mbs of
>                         Nothing -> (s,s)
>                         Just _ -> (StateA str $ tail ss, head ss)
>                   (StateA str' ss', mbs') = t (fst . h) (s1, mbs)
>               in (StateA str' (s2:ss'), mbs')
>           f' h (StateA str (s:ss)) = (f (fst . h) $ StateA str ss, (snd . h) s)

В принципе, в first открыта дорога для оптимизаций - например, first (first ...) будет сохранять исходное состояние ДВАЖДЫ, что излишне - но эти оптимизации для дальнейшего несущественны.

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

> askA = A t $ const $ \(StateA (Just str) _) -> str
>     where
>       t h (s, Nothing) = (StateA (Just $ h s) [], Just [])
>       t h (s, Just []) = (s, Nothing)

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

> testA = arr (\() -> "1?") >>> askA >>>
>         arr (\a1 -> "You said: " ++ a1 ++ "; 2?") >>> askA >>>
>         arr (\a2 -> "You said: " ++ a2 ++ "; 3?") >>> askA >>>
>         arr (\a3 -> "You said: " ++ a3 ++ "; 4?") >>> askA >>>
>         arr (\a4 -> "You said: " ++ a4 ++ "; 5?") >>> askA >>>
>         arr (\a5 -> "You said: " ++ a5) >>> askA >>>
>         arr (\_ -> ())

Проверяем:

*Test> runA testA ()
1?
debug: ([],[True,False])
>>> a
You said: a; 2?
debug: ([],[True,True,True,False])
>>> b
You said: b; 3?
debug: ([],[True,True,True,True,True,False])
>>> c
You said: c; 4?
debug: ([],[True,True,True,True,True,True,True,False])
>>> d
You said: d; 5?
debug: ([],[True,True,True,True,True,True,True,True,True,False])
>>> e
You said: e
debug: ([],[True,True,True,True,True,True,True,True,True,True,True,False])
>>> 

Всё отлично работает. Конечно, довольно много передаётся как Maybe [Bool], но это тип сам по себе маленький, и несколько бит нас не волнуют. Главное, предыдущие ответы пользователя НЕ протаскиваются через всю последовательность вопросов-ответов.

А теперь напишем примерно то же самое в стрелочном do-синтаксисе:

> testA' =
>     proc () ->
>         do a1 <- askA -< "1?"
>            a2 <- askA -< "You said: " ++ a1 ++ "; 2?"
>            a3 <- askA -< "You said: " ++ a2 ++ "; 2?"
>            a4 <- askA -< "You said: " ++ a3 ++ "; 2?"
>            a5 <- askA -< "You said: " ++ a4 ++ "; 2?"
>            askA -< "You said: " ++ a5
>            returnA -< ()

Проверяем:

*Test> runA testA' ()
1?
debug: ([StateA Nothing []],[True,False,True,False,True])
>>> a
You said: a; 2?
debug: ([StateA (Just "a") [StateA Nothing []]],[True,True,False,True,False,True])
>>> b
You said: b; 2?
debug: ([StateA (Just "b") [StateA (Just "a") [StateA Nothing []]]],[True,True,True,False,True,False,True])
>>> c
You said: c; 2?
debug: ([StateA (Just "c") [StateA (Just "b") [StateA (Just "a") [StateA Nothing []]]]],[True,True,True,True,False,True,False,True])
>>> d
You said: d; 2?
debug: ([StateA (Just "d") [StateA (Just "c") [StateA (Just "b") [StateA (Just "a") [StateA Nothing []]]]]],[True,True,True,True,True,False,True,False,True])
>>> e
You said: e
debug: ([StateA (Just "e") [StateA (Just "d") [StateA (Just "c") [StateA (Just "b") [StateA (Just "a") [StateA Nothing []]]]]]],[True,True,True,True,True,True,False,True,False,True])
>>> 

Упс. Работать-то оно работает, но... мы снова получаем ту же проблему, что и с монадами. Старые, ненужные ответы пользователя снова начали протаскиваться через всю цепочку. Почему? Потому что препроцессор стрелочного синтаксиса глуп. Нет особых проблем преобразовать testA' в testA автоматически. Увы, но даже при помощи Template Haskell это не сделать - Template Haskell не знает о стрелочном do-синтаксисе ничего. Нужен внешний препроцессор.

Резюме. Это - одна из тех вещей, за которые я не люблю стрелки. Уж слишком в их реализации виден подход "абы как, лишь бы работало".

Originally posted on migmit.vox.com