Для Haskell существует замечательная библиотека mvc, реализующая архитектуру Model-View-Controller для проектирования многопоточных программ. Библиотека построена на базе поточных процессоров pipes, async и других известных абстракций.

![/img/500px-MVC-Process.svg.png)

В данной заметке мы познакомимся с mvc и спроектируем простенькую графическую программу на SDL.

Компоненты mvc⌗

Библиотека mvc преднамеренно форсирует нас расщеплять дизайн программы на три фундаментальных компонента:

Тип Controller, снабжающий ядро программы некоторыми входными данными (стимулами) из внешнего мира. Моделируется “нечистыми” вычислениями, т.е. имеющими сторонний эффект.
Тип View, создающий на базе выходных данных ядра программы некоторую репрезентацию (программы) во внешнем мире. Нечистые вычисления.
Тип Model - ядро, содержащее чистую логику программы. Назначение ядра заключается в трансформации входных данных в выходные. Моделируется чистыми вычислениями без сторонних эффектов, что даёт возможность детерминированно “прокручивать”, тестировать и доказывать уравнения о логике работы программы (!). Предусмотрено внутреннее состояние (state) модели, мутирующее без сторонних эффектов (монада State).

Поскольку mvc можно использовать для проектирования многопоточных программ, Controller (View) представляет собой набор входов (выходов): стандартный интерфейс моноидов и функторов используется для объединения нескольких Контроллеров (Видов) в один.

Эти три компонента полностью описывают программу. Библиотека форсирует единую точку входа в программу:

runMVC
    :: s -- Начальный стэйт модели
    -> Model s a b	-- Модель, программная логика
    -> Managed (View b, Controller a) -- Выход и вход с эффектами
    -> IO s -- По завершении возвращается финальный стэйт модели

Для собственно запуска составленной программы необходимо дать функции runMVC все три компонента (предполагается, что Контроллеры и Виды могут потребовать некоторой общей предварительной инициализации, поэтому на самом деле требуется указать пару, завёрнутую в Managed из Control.Monad.Managed) плюс начальное состояние (state) модели.

Контроллер⌗

Контроллер представляет собой абстрактный источник потока данных. Такой источник можно создать вручную или получить из уже существующего Продюсера (Pipes.Core.Producer) или канала Pipes.Concurrent.Input. Необходимый интерфейс Контроллеров:

newtype Controller a = MVC.AsInput (Input a) 	-- Defined in ‘MVC’
instance [safe] Functor Controller -- Defined in ‘MVC’
instance [safe] Monoid (Controller a) -- Defined in ‘MVC’
instance [safe] Semigroup (Controller a) -- Defined in ‘MVC’

В модуле MVC.Prelude предусмотрено несколько готовых Контроллеров: нескончаемый источник строк из stdin или из файла, источник тиков (данных типа ()) с указанной частотой.

Например, вот сигнатура этого самого Контроллера, который может снабжать логику программу тиками (прерываниями, …) с частотой n герц:

tick :: Double -> Managed (Controller ())

Чтобы Контроллер можно было “подключить” к программе, он так или иначе должен быть завёрнут в Managed (об этом ниже).

Вид⌗

Вид представляет собой раковину (сток, sink), т.е. потребителя потока данных. Вид можно создать вручную или получить из уже существующей IO-раковины (так называют a -> IO ()), Консьюмера Pipes.Core.Consumer или потребителя-свёртки Control.Foldl.FoldM. Необходимый интерфейс Видов:

newtype View a
  = MVC.AsFold (foldl-1.4.3:Control.Foldl.FoldM IO a ())
  	-- Defined in ‘MVC’
instance [safe] Monoid (View a) -- Defined in ‘MVC’
instance [safe] Semigroup (View a) -- Defined in ‘MVC’
instance [safe] Contravariant View -- Defined in ‘MVC’

Имеется несколько готовых Видов вроде стока строк в stdout или в файл. Вот так выглядит один из них:

stdoutLines :: View String

Обратите внимание, что тип String указывает на то, какого рода данные этот Вид ожидает (поглощает). Тип String же в Controller String указывал на то, какого рода данные будут исходить из данного Контроллера. Всё это используется в Модели: логика потребляет данные Контроллера и генерирует данные для Вида.

Несколько Контроллеров и Видов (теория)⌗

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

Функция runMVC выше требует лишь один Вид (лишь один Контроллер), то есть тип выходных (входных) данных Модели, да и всей программы должен учитывать и включать все необходимые типы выходов (входов). Для этого все выходы (входы) просто объединяются в один единственный тип-сумму выходных (входных) данных.

Несколько Контроллеров и Видов (практика)⌗

Разрозненные типы⌗

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

data Inputs
  = InputTick ()
  | InputQuit ()
  | InputPos (Int, Int)
  | InputSize Int

data Outputs
  = OutputDisplay
  | OutputRender Square
  | OutputTerminate

-- Удобно сгенерить призмы (пакет lens) для объединающего выходы типа
makePrisms ''Outputs

Конструкторы типов-сумм позволяют дифференцировать входы от Контроллеров и активировать соответствующие Виды.

Согласно типам Inputs и Outputs выше, в нашей системе может быть одновременно подключено четыре Контроллера и три Вида:

-- Состояние Модели - абстрактный квадрат с размером и положением
data Square =
  Square Int
         (Int, Int)
--
-- Контроллеры (можно сразу обернуть их в Managed)
--
-- Генерация () 60 раз в секунду для сброса видеобуффера на экран
ctrlFrameTick :: Managed (Controller ())
-- Генерация координат положения курсора мыши (когда есть движение)
ctrlSDLPosition :: Managed (Controller (Int, Int))
-- Генерация () когда пользователь нажал клавишу Q (выход)
ctrlSDLQuit :: Managed (Controller ())
-- Просто генерация случайного числа
ctrlSize :: Managed (Controller Int)

--
-- Виды (а можно обернуть в Managed в инициализационной функции)
--
-- Вид, просто копирующий видеобуффер на экран
viewSDLDisplay :: SDL.Renderer -> View ()
-- Вид, завершающий работу программы
viewTerminate :: View ()
-- Вид, рисующий квадрат в видеобуффере (но не на экране)
viewSDLRender :: SDL.Renderer -> View Square

Кстати, в примере выше Контроллеры совсем ничего не знают о нашем квадрате Square: Контроллеры просто генерируют свои данные; задача Модели же - инкорпорировать эти данные в стэйт и сформировать выходы для активации Видов.

Формально, нужно указать хоть какой-то конкретный тип входа для Вида, даже если он вроде как и не претендует на данные из Модели. В таком случае мы просто используем юнит () (так как можем всегда создать его в любом месте Модели “из воздуха”).

Совмещённые типы⌗

Объединяем четыре Контроллера в один (три Вида в один) мы в той самой инициализационной функции, которая возвращает Managed-пару (View b, Controller a), готовую для запуска. В этой функции мы, кроме всего прочего, подготавливаем графическую систему SDL к использованию:

external :: Managed (View Outputs, Controller Inputs)
external = do
  -- Инициализация SDL, создание рендерера
  SDL.initialize [SDL.InitVideo]
  win <- SDL.createWindow mempty SDL.defaultWindow
  ren <- SDL.createRenderer win (-1) SDL.defaultRenderer
  SDL.rendererDrawColor ren SDL.$= SDL.V4 0 0 0 255
  SDL.clear ren

  -- Виды, используем рендерер для создание некоторых из них
  let vs =
        handles _OutputDisplay (viewSDLDisplay ren) <>
        handles _OutputRender (viewSDLRender ren) <>
        handles _OutputTerminate viewTerminate

  -- Контроллеры
  let cs =
        fmap (fmap InputSize) ctrlSize <> fmap (fmap InputPos) ctrlSDLPosition <>
        fmap (fmap InputTick) ctrlFrameTick <>
        fmap (fmap InputQuit) ctrlSDLQuit

  -- Аппликативный функтор Managed (возвращаем пару)
  liftA2 (,) (return vs) cs

Как видно, мы просто склеиваем моноиды для создания одного Контроллера (Вида) из нескольких.

Отдельные “сигнальные линии” в типе Inputs дифференцируются по конструкторам вручную внутри Модели (см. ниже), а вот сопоставление “сигнальных линий” в типе Outputs соответствующим Видам система должна уметь делать автоматически (мы лишь генерируем соответствующую состовляющую Outputs в Модели). Для этого мы должны использовать встроенную функцию handles, которая принимает на вход призму (т.е. “грань” составного типа) и соответствующий Вид (обработчик): handles _OutputTerminate viewTerminate означает, что если тип Outputs в Модели будет собран конструктором OutputTerminate, то для данного Outputs будет выбран Вид viewTerminate.

Непосредственно типы (завёрнутых) сигналов всегда должны совпадать, например:

data Outputs
  = OutputDisplay
  | OutputRender Square -- параметр Square
  | OutputTerminate
makePrisms ''Outputs
-- ...

-- Поглощает Square
viewSDLRender :: SDL.Renderer -> View Square

-- ...

-- Выбрана призма _OutputRender, соответствующая конструктору Outputs с параметром Square
handles _OutputRender (viewSDLRender ren)

Модель⌗

Модель Model s a b представляет собой чистую трансформацию потока a в поток b с поддерживаемым состоянием s.

newtype ModelM m s a b = AsPipe (Pipe a b (StateT s m) ())
type Model = ModelM Identity

И никаких сторонних эффектов. Логика программы полностью детерминированна.

Пример Модели для нашей программы:

model :: Model Square Inputs Outputs
model =
  asPipe $
  forever $ do
    is <- await
    case is of
      InputTick _ -> yield OutputDisplay
      InputPos xy -> do
        modify (\(Square s _) -> Square s xy)
        square <- get
        yield $ OutputRender square
      InputSize size -> do
        modify (\(Square _ xy) -> Square size xy)
        square <- get
        yield $ OutputRender square
      InputQuit _ -> yield OutputTerminate

Её логика такова:

Блитить видеобуффер при получении тика
Обновлять стэйт (позицию абстрактного квадрата) при получении новых координат мыши; перерисовывать квадрат в видеобуффере
Обновлять стэйт (размер абстрактного квадрата) при получении числа (на самом деле это случайно число); перерисовывать квадрат в видеобуффере
Конструктором OutputTerminate активировать Вид выхода из программы при получении нажатия на клавишу Q.

Как видим, всё довольно просто, поскольку все “спецэффекты” сосредоточены в Контроллерах и Видах.

Пример устройства Контроллера и Вида⌗

В качестве примеров приведём собственно исходный код нескольких Видов и Контроллеров нашей программы:

-- Завершаем работу программы
viewTerminate :: View ()
viewTerminate = asSink $ const exitSuccess

-- Очищаем видеобуффер и рендерим в него квадрат
viewSDLRender :: SDL.Renderer -> View Square
viewSDLRender ren =
  asSink $ \(Square size (x, y)) -> do
    let rect = Just (SDL.Rectangle (SDL.P (SDL.V2 x y)) (SDL.V2 size size))
    SDL.rendererDrawColor ren SDL.$= SDL.V4 0 0 0 255
    SDL.clear ren
    SDL.rendererDrawColor ren SDL.$= SDL.V4 255 255 255 255
    SDL.drawRect ren ((fmap . fmap) toEnum rect)

-- ...

-- Генерим () если нажата клавиша Q
ctrlSDLQuit :: Managed (Controller ())
ctrlSDLQuit =
  M.producer Single $
  forever $ do
    lift $ threadDelay 10000
    me <- SDL.pollEvent
    when (isJust me) $
      let pl = SDL.eventPayload (fromJust me)
       in case pl of
            SDL.KeyboardEvent ed ->
              when
                (SDL.keyboardEventKeyMotion ed == SDL.Pressed &&
                 SDL.keysymKeycode (SDL.keyboardEventKeysym ed) == SDL.KeycodeQ) $
              yield ()
            _ -> return ()


-- Генерим случайно число и ждём 1000 микросекунд
ctrlSize :: Managed (Controller Int)
ctrlSize =
  M.producer Single $
  forever $ do
    r <- lift $ randomRIO (60, 120)
    lift $ threadDelay 1000
    yield r

Результат⌗

Мы запускаем нашу программу следующим образом:

main :: IO ()
main = do
  void $ runMVC (Square 60 (0, 0)) model external

![/img/mpv-sdl.gif)

mvc: архитектурный паттерн Model-View-Controller в Haskell