使用 Haskell 构建 GTK 4 应用：第一部分

本系列将介绍如何使用 Haskell、GTK 4 和 Adwaita 库构建一个待办事项应用。Adwaita 提供了大量实用的组件和样式。让我们开始吧！

本系列面向具备 Haskell 开发经验的中级开发者。

GTK 4 与 Adwaita

Adwaita 是一套 GTK 组件库，也是 GNOME 项目的设计语言基础。简而言之，GNOME 项目在无障碍性和样式方面做出的所有决策（即人类界面指南，HIG）都封装在 libadwaita 中。

Libadwaita 提供了许多特性：例如，它允许创建支持响应式设计的桌面应用，当桌面主题在明暗模式间切换时，应用颜色会自动重绘。

Haskell 与 GTK

在本系列中，我们将使用 haskell-gi 工具包，它可以从 GTK 库自动生成 Haskell 绑定，并提供一套 Haskell 接口，使开发者仍能对应到 C API。

---

为了保持文章可读性并突出核心概念，文中代码示例将省略部分实现。
完整项目请访问 https://github.com/Floreal-Technologies/adwaita-todo。

---

创建第一个窗口

首先，这是一个 GTK 4 / Adwaita 应用的自包含结构示例。

让我们创建一个 Adwaita Application 对象，由它来处理资源管理（包括 Adwaita 样式表，这部分效果很棒）：

module Main (main) where

import GI.Awd qualified as Adw
import GI.Gio qualified as Gio
import GI.GTK qualified as Gtk

main :: IO ()
main = do
  -- The `new X [#attribute := value]` syntax creates a Gtk object
  -- with its properties. The hash syntax is called OverloadedLabels.
  app <- new Adw.Application [#applicationId := "tech.floreal.TodoApp"]
  -- We connect the "activate" signal to the "activate" handler.
  on app #activate (activate app)
  -- We run the main application loop.
  Gio.applicationRun app Nothing
  pure ()

activate :: Adw.Application -> IO ()
activate app = do
  header <- new Adw.HeaderBar []
  toolbar <- new Adw.ToolbarView []
  Adw.toolbarViewAddTopBar toolbar header
  window <- 
    new Adw.ApplicationWindow
      [ #application := app
      , #title := "Todos"
      , #defaultWidth := 480
      , #defaultHeight := 640
      , #content := toolbar
      ]
  Gtk.windowPresent window

瞧！一个空的窗口出现了，标题显示为 "Todos"，尺寸是 480 × 640。

Model-View-Update：Elm 架构

Elm 架构（即 TEA）是一种设计交互式程序的模式，核心包含三个概念：

Model 应用的状态 View 将 Model 转化为用户界面（HTML、GTK 等）的方式 Update 根据 Messages 更新 Model 的方式

围绕这些概念，我们还能看到

Message 用户与应用所有可能交互操作的枚举 Effects Update 函数不仅返回更新后的 Model， 还返回一个侧边动作列表，称为 Effects。

Elm 极大普及了这种思路，它也非常适合驯服 GTK 工具包中命令式的特性。

Todo 应用

现在该表示应用状态及其操作了。遵循 Elm 架构的精神，一切都用数据结构建模，这样我们能完全看清触发了哪些动作以及它们意味着什么。

模型

newtype TodoId = TodoId Word
  deriving stock (Show)
  deriving newtype (Eq, Ord)

data Todo = Todo
  { id :: TodoId
  , title :: Text
  , done :: Bool
  }
  deriving stock (Eq, Show)

data Model = Model
  { todos :: Map TodoId Todo
  , nextId :: TodoId 
  }
  deriving stock (Eq, Show)

-- 在我们的例子里，这里的 Effect 表示
-- 把待办事项列表保存到磁盘。
data Effect = Save [Todo]
  deriving stock (Eq, Show)

init :: Model
init = Model
  { todos = Map.empty
  , nextId = TodoId 0
  }

消息（Messages）

用户与应用的交互被建模为 Message：一组已知的动作，每个动作都有明确的逻辑来修改 Model。

先从几个用户可能触发的、用于更新 Model 的消息开始：

data Message
  = Add Text
  | SetDoneStatus TodoId Bool
deriving stock (Eq, Ord)

目前内容不多，之后我们会逐步补充。

更新 Model

update :: Message -> Model -> (Model, [Effect])
update message model = case message of
  Add raw -> 
    let text = Text.strip raw
        todoId@(TodoId n) = model.nextId
        todo = Todo{ id = todoId, title = text, done = False }
    in if Text.null text
    then (model, [])
    else
      withTodos
        (Map.insert todo.id todo)
        model{ nextId = TodoId (n + 1)}
  SetDoneStatus todoId value ->
    withTodos (Map.adjust (\todo -> todo {done = value}) todoId) model
 where
  -- 在这里我们判断待办事项是否发生了变化，
  -- 以便决定是否保存。
  withTodos f changed =
    let result = changed {todos = f changed.todos}
    in if result.todos == model.todos
         then (result, [])
         else (result, [Save (Map.elems result.todos)])

现在打开 GHCi 来试试看：

$ cabal repl
-- 添加一个采购韭葱的任务
ghci> let (m1, e1) = update (Add "Buy leeks") init

-- 由于任务未完成，这会触发一个 “Save” 副作用
ghci> e1
[Save [Todo {id = TodoId 0, title = "Buy leeks", done = False}]]

-- 将该任务标记为已完成
ghci> let (m2, e2) = update (SetDoneStatus (TodoId 0) True) m1

-- 由于状态发生了变化，需要再次保存
ghci> e2
[Save [Todo {id = TodoId 0, title = "Buy leeks", done = True}]]

-- 再次将任务设为 True 不会触发 Save 副作用，
-- 因此副作用列表为空。
ghci> update (SetDoneStatus (TodoId 0) True) m2
(Model{ nextId = TodoId 1
      , todos = fromList [
          (TodoId 0, Todo{ id = TodoId 0
                         , title = "Buy leeks"
                         , done = True})]
      }, []) -- ← 空列表！

这就是我们的领域逻辑，编码为消息和更新函数的和类型，用于修改状态。

现在让我们来设计用户界面。

视图层

在动手做用户界面之前，先写下来你的预期总是好习惯。

根据经验，设计不会直接从数据中浮现出来，所以我越来越少依赖数据形状来指导设计。

控件

我们将用到几种控件（点击名称即可查看它们的截图）：

Box 用于将子控件排成一行或一列。 ListBox 可动态筛选和排序的行列表。后续可用于按状态筛选、按年龄排序。 EntryRow 带有标题、占位符文本和可编辑图标的行内输入框。它是 ListBox 的子类，因此将放置在 ListBox 中。 ActionRow EntryRow 的受限版本，不支持原地编辑，但仍可添加操作图标，同样存放在 ListBox 中。 Clamp 用于约束子控件尺寸的组件。可强制保留边距，使边缘背景可见。 ScrolledWindow 使子控件支持滚动，名称即功能。 ToolbarView 包含一个页面以及顶部和底部工具栏的视图组件。

时间到了，开始搭积木

有了这些基础组件，我们来梳理一下各控件之间的连接方式：

module Todo.View (view) where

-- 导入
-- […]

-- `dispatch` 函数将在后面的 Runtime 模块中定义，
-- 它的作用是把消息转化为状态/模型的变更。
view
  :: (Message -> IO ())
  -> Model
  -> IO Gtk.Widget
view dispatch model = do
  -- 这里定义输入行，设置标题，并绑定信号处理器，
  -- 以便在输入被激活时获取用户输入的内容。
  inputRow <- new Adw.EntryRow [#title := "New task"]
  on entry #entryActivated $ do
    text <- Gtk.editableGetText inputRow
    dispatch (Add text) -- 就是在这里发送我们的 "Add" 消息

  -- EntryRow 是 ListBox 的子类，
  -- 所以要把 inputRow 添加到 entryBox 里
  entryBox <- newBoxedList 
  Gtk.listBoxAppend entryBox inputRow

  -- 用于存放所有任务的 ListBox
  todoList <- newBoxedList
  forM_ (model.todos) $ \todo -> do
    row <- new Adw.ActionRow [#title := todo.title, #useMarkup := False]
    Gtk.listBoxAppend todoList row

  -- 主要内容的 widget，通过一系列选项
  -- 定义它在父容器中的边距，
  -- 以及排列方向。
  content <-
    new
      Gtk.Box
      [ #orientation := Gtk.OrientationVertical
      , #spacing := 12
      , #marginTop := 12
      , #marginBottom := 12
      , #marginStart := 12
      , #marginEnd := 12
      ]
  -- 别忘了把所有东西都添加进去……
  Gtk.boxAppend content entryBox
  Gtk.boxAppend content todoList

  -- content widget 的父容器。
  clamp <- new Adw.Clamp [#child := content]
  scrolled <-
    new
      Gtk.ScrolledWindow
      [ #child := clamp
      ]

  -- 一个可爱的小页脚，用来显示额外信息，
  -- 比如任务数量。
  count <- new Gtk.Label [#label := Text.show (Map.size model.todos)]
  footer <-
    new
      Gtk.Box
      [ #orientation := Gtk.OrientationHorizontal
      , #marginTop := 6
      , #marginBottom := 6
      , #marginStart := 12
      , #marginEnd := 12
      ]
  Gtk.boxAppend footer count

  -- 现在把头部、内容和页脚组装起来！
  header <- new Adw.HeaderBar []
  toolbar <- new Adw.ToolbarView [#content := scrolled]
  Adw.toolbarViewAddTopBar toolbar header
  Adw.toolbarViewAddBottomBar toolbar footer
  Gtk.toWidget toolbar

-- 一个小辅助函数，用来按正确设置创建 ListBox。
newBoxedList :: IO Gtk.ListBox
newBoxedList =
  new
    Gtk.ListBox
    [ #selectionMode := Gtk.SelectionModeNone
    , #cssClasses := ["boxed-list"]
    ]

目前还看不到太多视觉反馈，所以你得相信它和之前纸笔草稿长得差不多。

Runtime 运行时模块

和文章开头演示的内容类似，这里是嵌入 Model-View-Update（模型-视图-更新）三件套的地方。

我们要再定义两个函数：dispatch 和 step，它们是“恩爱夫妻”。

dispatch 接收一条消息，处理 GTK 事件循环的优先级，然后调用 step 来执行模型更新，进而触发视图更新。

step 读取当前模型，调用 Model.hs 中的 update 函数得到新模型，将新模型写回存储，并把新模型和 dispatch 函数传递给 View。View 返回新的内容作为一个 Gtk 控件，我们将这个新内容设置到窗口中。

代码如下：

run :: Adw.Application -> IO ()
run app = do
  window <-
    new
      Adw.ApplicationWindow
      [ #application := app
      , #title := "Todos"
      , #defaultWidth := 480
      , #defaultHeight := 640
      ]
  ref <- newIORef Model.init
  let {- rec -}
      dispatch :: Model.Message -> IO ()
      dispatch message =
        void $ GLib.idleAdd GLib.PRIORITY_DEFAULT $ do
          step message
          pure GLib.SOURCE_REMOVE

      step :: Model.Message -> IO ()
      step message = do
        oldModel <- readIORef ref
        let (newModel, _effects) = Model.update message oldModel
        writeIORef ref newModel
        content <- View.view dispatch newModel
        Adw.applicationWindowSetContent window (Just content)

  content <- View.view dispatch Model.init
  Adw.applicationWindowSetContent window (Just content)
  Gtk.windowPresent window

现在，我们的 Main 模块看起来是这样：

module Main where

main :: IO ()
main = do
  app <- new Adw.Application
     [#applicationId := "tech.floreal.AdwaitaTodo"]
  on app #activate (Runtime.run app)
  Gio.applicationRun app Nothing
  pure ()

看，它跑起来了：

---

文章到此结束。在Part 2中，我们将为我们的 Todo List 应用添加更多功能！