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

[migmit]

Продолжение; начало здесь
Теперь - основное: собственно, виджеты.

> {-# 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

Comments

[gabriel-irk.livejournal.com]

Действительно. Тогда я спокоен. :)

Спасибо!