第 16 章 - JSON 与 SQL（JSON and SQL）

本章内容包括：

使用 Aeson 把 Haskell 值编码为 JSON
解析 JSON，并把失败保留在类型中
借助 Generic 自动派生类型类实例
使用 SQLite 保存应用数据
为数据库访问定义清晰的动作边界

上一章中，我们构建了一个小型同步工具。它能读取命令行参数、扫描文件、维护统计信息并记录日志。现在可以继续把它推进一步：让程序把数据保存下来。

很多应用都需要在两种格式之间移动数据。JSON 适合和外部世界交换结构化信息，例如配置文件、HTTP API 或日志事件。SQL 数据库则适合持久化查询数据，例如任务表、用户表或历史记录。Haskell 可以很好地处理这两种场景：Aeson 是事实标准 JSON 库，而 sqlite-simple 提供了轻量的 SQLite 访问接口。

本章会先介绍 JSON 编码与解析，然后转向 Generic 派生，最后用 SQLite 存储一个简单的同步任务列表。目标不是构建完整数据库应用，而是理解如何让纯数据类型、JSON 格式和 SQL 表之间保持清楚的边界。

16.1 将值编码为 JSON（Encoding values as JSON）

JSON 是一种文本数据格式。它的基本值包括对象、数组、字符串、数字、布尔值和 null。在 Haskell 中，我们通常不会直接拼接 JSON 字符串，而是让库根据数据类型进行编码。

Aeson 库提供两个核心类型类：

class ToJSON a where
  toJSON :: a -> Value

class FromJSON a where
  parseJSON :: Value -> Parser a

ToJSON 用于把 Haskell 值转换为 JSON 值，FromJSON 用于从 JSON 值解析 Haskell 值。大多数时候，我们不直接调用 toJSON 和 parseJSON，而是使用更高层的 encode、decode 或 eitherDecode。

16.1.1 Aeson 与 JSON 解析（Aeson and JSON parsing）

先定义一个简单的数据类型。假设同步工具需要把一次同步任务保存为 JSON：

代码清单 16.1 同步任务类型

module Sync.Job where

data SyncJob = SyncJob
  { jobId :: Int,
    jobSource :: FilePath,
    jobTarget :: FilePath,
    jobDryRun :: Bool
  }
  deriving (Eq, Show)

为了手写 ToJSON 实例，需要构造 Aeson 的对象值。对象由键值对组成。使用 object 和 (.=) 可以保持代码可读。

代码清单 16.2 手写 ToJSON 实例

{-# LANGUAGE OverloadedStrings #-}

module Sync.Job where

import Data.Aeson

data SyncJob = SyncJob
  { jobId :: Int,
    jobSource :: FilePath,
    jobTarget :: FilePath,
    jobDryRun :: Bool
  }
  deriving (Eq, Show)

instance ToJSON SyncJob where
  toJSON job =
    object
      [ "id" .= jobId job,
        "source" .= jobSource job,
        "target" .= jobTarget job,
        "dryRun" .= jobDryRun job
      ]

OverloadedStrings 让字符串字面量可以用于 Aeson 对象键。如果没有这个扩展，键的类型会更啰嗦。

现在可以编码：

代码清单 16.3 编码为 JSON 字节串

module Main (main) where

import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as LBS
import Sync.Job

main :: IO ()
main = do
  let job =
        SyncJob
          { jobId = 1,
            jobSource = "src",
            jobTarget = "dst",
            jobDryRun = True
          }
  LBS.putStrLn (encode job)

encode 返回惰性 ByteString。JSON 输出大致如下：

{"dryRun":true,"id":1,"source":"src","target":"dst"}

字段顺序不应该被业务逻辑依赖。JSON 对象语义上是键值映射，而不是有序列表。

接着为同一个类型编写 FromJSON 实例。Aeson 提供 withObject 和 (.:) 来从对象中读取字段。

代码清单 16.4 手写 FromJSON 实例

{-# LANGUAGE OverloadedStrings #-}

module Sync.Job where

import Data.Aeson

data SyncJob = SyncJob
  { jobId :: Int,
    jobSource :: FilePath,
    jobTarget :: FilePath,
    jobDryRun :: Bool
  }
  deriving (Eq, Show)

instance ToJSON SyncJob where
  toJSON job =
    object
      [ "id" .= jobId job,
        "source" .= jobSource job,
        "target" .= jobTarget job,
        "dryRun" .= jobDryRun job
      ]

instance FromJSON SyncJob where
  parseJSON =
    withObject "SyncJob" $ \value ->
      SyncJob
        <$> value .: "id"
        <*> value .: "source"
        <*> value .: "target"
        <*> value .: "dryRun"

withObject 会检查输入 JSON 是否为对象。如果不是，它会产生解析错误。(.:) 会读取必需字段；如果字段不存在或类型不匹配，也会失败。

代码清单 16.5 解析 JSON

module Main (main) where

import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as LBS
import Sync.Job

jsonInput :: LBS.ByteString
jsonInput =
  "{\"id\":1,\"source\":\"src\",\"target\":\"dst\",\"dryRun\":false}"

main :: IO ()
main =
  case eitherDecode jsonInput of
    Left err -> putStrLn ("Invalid JSON: " <> err)
    Right job -> print (job :: SyncJob)

eitherDecode 比 decode 更适合应用代码，因为它能返回错误信息：

eitherDecode :: FromJSON a => ByteString -> Either String a

decode 返回 Maybe a，会丢失错误细节：

decode :: FromJSON a => ByteString -> Maybe a

解析外部输入时，保留错误信息通常更有帮助。

16.1.2 JSON 序列化（Serializing to JSON）

把值写入文件和从文件读取值也很直接。由于 Aeson 使用惰性 ByteString，可以搭配 Data.ByteString.Lazy 的文件函数。

代码清单 16.6 写入 JSON 文件

module Sync.JobFile where

import Data.Aeson
import qualified Data.ByteString.Lazy as LBS
import Sync.Job

writeJob :: FilePath -> SyncJob -> IO ()
writeJob path job =
  LBS.writeFile path (encode job)

读取时要处理两类失败：

文件系统读取可能抛出异常
JSON 解析可能返回 Left

可以先处理解析失败，暂时让文件异常自然传播：

代码清单 16.7 读取 JSON 文件

module Sync.JobFile where

import Data.Aeson
import qualified Data.ByteString.Lazy as LBS
import Sync.Job

readJob :: FilePath -> IO (Either String SyncJob)
readJob path = do
  bytes <- LBS.readFile path
  pure (eitherDecode bytes)

如果想同时处理文件异常，可以结合上一章的 try：

代码清单 16.8 同时处理文件错误和解析错误

module Sync.JobFile where

import Control.Exception
import Data.Aeson
import qualified Data.ByteString.Lazy as LBS
import Sync.Job
import System.IO.Error

data JobFileError
  = JobFileReadError IOException
  | JobFileJsonError String
  deriving (Show)

readJobSafe :: FilePath -> IO (Either JobFileError SyncJob)
readJobSafe path = do
  fileResult <- try (LBS.readFile path)
  case fileResult of
    Left err ->
      pure (Left (JobFileReadError err))
    Right bytes ->
      case eitherDecode bytes of
        Left err -> pure (Left (JobFileJsonError err))
        Right job -> pure (Right job)

这里我们没有把错误压扁成一个字符串，而是定义了专门的错误类型。这让调用者可以根据错误种类做不同处理。例如，读取失败可能需要重试，JSON 格式错误则应该提示用户修正配置。

如果要写入更易读的 JSON，可以使用 encodePretty。它来自 aeson-pretty 包，而不是 Aeson 核心包：

import Data.Aeson.Encode.Pretty

对于配置文件和人工查看的日志，漂亮格式很有帮助。对于网络传输或数据库保存，紧凑格式通常更合适。

16.2 使用 Generic 推导类型类（Deriving type classes with Generic）

手写 ToJSON 和 FromJSON 能给我们完全控制权，但也会产生重复代码。很多数据类型的 JSON 表示只是字段到字段的自然映射。对于这些类型，可以使用 Generic 自动派生。

Generic 是 GHC 提供的一种机制。它让编译器为数据类型生成通用结构表示，库可以基于这种结构自动实现类型类实例。

代码清单 16.9 使用 Generic 派生 JSON 实例

{-# LANGUAGE DeriveGeneric #-}

module Sync.Job where

import Data.Aeson
import GHC.Generics

data SyncJob = SyncJob
  { jobId :: Int,
    jobSource :: FilePath,
    jobTarget :: FilePath,
    jobDryRun :: Bool
  }
  deriving (Eq, Generic, Show)

instance ToJSON SyncJob
instance FromJSON SyncJob

这段代码会根据字段名生成 JSON：

{
  "jobId": 1,
  "jobSource": "src",
  "jobTarget": "dst",
  "jobDryRun": false
}

但很多时候，我们不希望 JSON 字段带有 Haskell 内部前缀。Aeson 允许通过 Options 调整派生行为。

代码清单 16.10 自定义字段名

{-# LANGUAGE DeriveGeneric #-}

module Sync.Job where

import Data.Aeson
import GHC.Generics

data SyncJob = SyncJob
  { jobId :: Int,
    jobSource :: FilePath,
    jobTarget :: FilePath,
    jobDryRun :: Bool
  }
  deriving (Eq, Generic, Show)

jsonOptions :: Options
jsonOptions =
  defaultOptions
    { fieldLabelModifier = drop 3
    }

instance ToJSON SyncJob where
  toJSON =
    genericToJSON jsonOptions

instance FromJSON SyncJob where
  parseJSON =
    genericParseJSON jsonOptions

drop 3 会把 jobId 变成 Id，把 jobSource 变成 Source。这还不够理想，因为字段首字母仍然是大写。可以写一个小函数继续转换：

代码清单 16.11 转换字段名前缀

lowerFirst :: String -> String
lowerFirst value =
  case value of
    [] -> []
    x : xs -> toLower x : xs

jsonOptions :: Options
jsonOptions =
  defaultOptions
    { fieldLabelModifier = lowerFirst . drop 3
    }

需要导入：

import Data.Char (toLower)

现在字段名会变成：

{
  "id": 1,
  "source": "src",
  "target": "dst",
  "dryRun": false
}

对和类型也可以派生 JSON。例如：

代码清单 16.12 为和类型派生 JSON

{-# LANGUAGE DeriveGeneric #-}

module Sync.Event where

import Data.Aeson
import GHC.Generics

data SyncEvent
  = FileCopied FilePath FilePath
  | FileSkipped FilePath
  | FileFailed FilePath String
  deriving (Eq, Generic, Show)

instance ToJSON SyncEvent
instance FromJSON SyncEvent

Aeson 会使用默认的和类型编码。默认编码适合 Haskell 内部数据交换，但不一定适合公开 API。公开格式需要更稳定、更明确的结构。可以用 sumEncoding 定制：

代码清单 16.13 自定义和类型编码

eventOptions :: Options
eventOptions =
  defaultOptions
    { sumEncoding =
        TaggedObject
          { tagFieldName = "type",
            contentsFieldName = "payload"
          }
    }

instance ToJSON SyncEvent where
  toJSON =
    genericToJSON eventOptions

instance FromJSON SyncEvent where
  parseJSON =
    genericParseJSON eventOptions

这样 JSON 会包含一个明确的类型字段。外部系统读取时，不需要知道 Haskell 构造器的内部表示。

Generic 派生是一把很顺手的工具，但要记住一个边界：自动派生会把 Haskell 类型结构暴露到编码格式中。如果格式只供内部使用，这通常没问题。如果格式是公开 API 或长期保存的文件，就应该认真设计字段名、兼容策略和版本迁移。

16.3 使用 SQLite 数据库（Using a SQLite database）

JSON 很适合交换和保存单个结构。但如果需要查询、筛选、更新和关联数据，数据库会更合适。SQLite 是一个嵌入式 SQL 数据库。它不需要单独服务进程，数据保存在一个普通文件中，非常适合命令行工具和小型应用。

Haskell 中可以使用 sqlite-simple 包访问 SQLite。它的风格和 postgresql-simple 类似：用参数化 SQL 执行动作，并通过类型类把行转换为 Haskell 值。

16.3.1 sqlite-simple 基础

先创建一个数据库连接，并初始化表。

代码清单 16.14 创建 SQLite 表

{-# LANGUAGE OverloadedStrings #-}

module Sync.Database where

import Database.SQLite.Simple

initialize :: Connection -> IO ()
initialize conn =
  execute_
    conn
    "CREATE TABLE IF NOT EXISTS sync_jobs\
    \ (id INTEGER PRIMARY KEY,\
    \  source TEXT NOT NULL,\
    \  target TEXT NOT NULL,\
    \  dry_run INTEGER NOT NULL)"

execute_ 用于执行不带参数的 SQL。字符串中的反斜杠只是 Haskell 的多行字符串写法。

可以打开数据库文件并运行初始化：

代码清单 16.15 打开数据库连接

module Main (main) where

import Database.SQLite.Simple
import Sync.Database

main :: IO ()
main =
  withConnection "sync.db" initialize

withConnection 会打开连接，把它传给动作，并在动作完成后关闭连接。它和前几章见过的 withFile 是同一种资源管理思想。

插入数据时要使用参数化查询，而不是拼接字符串。

代码清单 16.16 插入同步任务

{-# LANGUAGE OverloadedStrings #-}

module Sync.Database where

import Database.SQLite.Simple

insertJob :: Connection -> FilePath -> FilePath -> Bool -> IO ()
insertJob conn source target dryRun =
  execute
    conn
    "INSERT INTO sync_jobs (source, target, dry_run) VALUES (?, ?, ?)"
    (source, target, dryRun)

问号是占位符，最后一个参数提供实际值。库会负责正确编码参数。这比手动拼接 SQL 安全得多，也能避免引号和转义问题。

查询也类似：

代码清单 16.17 查询任务数量

{-# LANGUAGE OverloadedStrings #-}

module Sync.Database where

import Database.SQLite.Simple

jobCount :: Connection -> IO Int
jobCount conn = do
  [Only count] <- query_ conn "SELECT COUNT(*) FROM sync_jobs"
  pure count

Only 用于表示只有一列的行。这里的查询结果是一个列表，因为 SQL 查询可以返回多行。COUNT(*) 总是返回一行，所以示例中直接匹配 [Only count]。真实代码可以更谨慎地处理异常情况。

16.3.2 ToRow 与 FromRow

直接使用元组可以工作，但随着表字段变多，代码会变脆。更好的做法是定义数据类型，并为它实现 ToRow 和 FromRow。

代码清单 16.18 数据库任务类型

module Sync.Database.Job where

data DbSyncJob = DbSyncJob
  { dbJobId :: Int,
    dbJobSource :: FilePath,
    dbJobTarget :: FilePath,
    dbJobDryRun :: Bool
  }
  deriving (Eq, Show)

FromRow 描述如何从查询结果的一行中解析这个类型。

代码清单 16.19 实现 FromRow

module Sync.Database.Job where

import Database.SQLite.Simple.FromRow

data DbSyncJob = DbSyncJob
  { dbJobId :: Int,
    dbJobSource :: FilePath,
    dbJobTarget :: FilePath,
    dbJobDryRun :: Bool
  }
  deriving (Eq, Show)

instance FromRow DbSyncJob where
  fromRow =
    DbSyncJob
      <$> field
      <*> field
      <*> field
      <*> field

字段顺序必须与 SQL 查询的列顺序一致。这是一条重要约定。为了减少意外，查询时最好显式写出列名，不要使用 SELECT *。

代码清单 16.20 查询所有任务

{-# LANGUAGE OverloadedStrings #-}

module Sync.Database where

import Database.SQLite.Simple
import Sync.Database.Job

selectJobs :: Connection -> IO [DbSyncJob]
selectJobs conn =
  query_
    conn
    "SELECT id, source, target, dry_run FROM sync_jobs ORDER BY id"

ToRow 描述如何把一个 Haskell 值绑定到 SQL 参数。

代码清单 16.21 实现 ToRow

module Sync.Database.Job where

import Database.SQLite.Simple.FromRow
import Database.SQLite.Simple.ToRow

data NewSyncJob = NewSyncJob
  { newJobSource :: FilePath,
    newJobTarget :: FilePath,
    newJobDryRun :: Bool
  }
  deriving (Eq, Show)

data DbSyncJob = DbSyncJob
  { dbJobId :: Int,
    dbJobSource :: FilePath,
    dbJobTarget :: FilePath,
    dbJobDryRun :: Bool
  }
  deriving (Eq, Show)

instance ToRow NewSyncJob where
  toRow job =
    toRow
      ( newJobSource job,
        newJobTarget job,
        newJobDryRun job
      )

instance FromRow DbSyncJob where
  fromRow =
    DbSyncJob
      <$> field
      <*> field
      <*> field
      <*> field

这里分成 NewSyncJob 和 DbSyncJob 是有意的。新建任务时还没有数据库 ID；从数据库读出来之后才有 ID。用两个类型表达这个差异，比把 id 写成 Maybe Int 更清晰。

现在插入函数可以接收 NewSyncJob：

代码清单 16.22 插入结构化任务

{-# LANGUAGE OverloadedStrings #-}

module Sync.Database where

import Database.SQLite.Simple
import Sync.Database.Job

insertJob :: Connection -> NewSyncJob -> IO ()
insertJob conn job =
  execute
    conn
    "INSERT INTO sync_jobs (source, target, dry_run) VALUES (?, ?, ?)"
    job

如果想拿到刚插入的 ID，可以使用 lastInsertRowId：

代码清单 16.23 插入后返回 ID

insertJobReturningId :: Connection -> NewSyncJob -> IO Int
insertJobReturningId conn job = do
  execute
    conn
    "INSERT INTO sync_jobs (source, target, dry_run) VALUES (?, ?, ?)"
    job
  fromIntegral <$> lastInsertRowId conn

SQLite 的 ID 类型是 64 位整数，而这里转换为 Int。如果应用可能处理非常大的表，应该在领域类型中直接使用 Int64。

16.3.3 定义数据库访问动作（Defining actions for database access）

随着数据库函数变多，一个常见问题是：连接应该在哪里传递？最直接的方式是每个函数都接收 Connection：

selectJobs :: Connection -> IO [DbSyncJob]
insertJob :: Connection -> NewSyncJob -> IO ()
deleteJob :: Connection -> Int -> IO ()

这种方式简单清楚，适合小程序。另一种方式是把连接放入应用环境，然后用 ReaderT 读取。上一章已经见过这种模式。

代码清单 16.24 在环境中保存数据库连接

module App.Types where

import Control.Monad.Reader
import Database.SQLite.Simple

data AppEnv = AppEnv
  { appConnection :: Connection
  }

newtype App a = App
  { unApp :: ReaderT AppEnv IO a
  }
  deriving
    ( Functor,
      Applicative,
      Monad,
      MonadIO,
      MonadReader AppEnv
    )

然后定义数据库动作：

代码清单 16.25 在 App 中访问数据库

{-# LANGUAGE OverloadedStrings #-}

module App.Database where

import App.Types
import Control.Monad.IO.Class
import Control.Monad.Reader
import Database.SQLite.Simple
import Sync.Database.Job

loadJobs :: App [DbSyncJob]
loadJobs = do
  conn <- asks appConnection
  liftIO $
    query_
      conn
      "SELECT id, source, target, dry_run FROM sync_jobs ORDER BY id"

saveJob :: NewSyncJob -> App ()
saveJob job = do
  conn <- asks appConnection
  liftIO $
    execute
      conn
      "INSERT INTO sync_jobs (source, target, dry_run) VALUES (?, ?, ?)"
      job

程序入口负责打开连接和运行 App：

代码清单 16.26 运行带数据库连接的应用

module Main (main) where

import App.Database
import App.Types
import Control.Monad.Reader
import Database.SQLite.Simple
import Sync.Database

runApp :: AppEnv -> App a -> IO a
runApp env action =
  runReaderT (unApp action) env

main :: IO ()
main =
  withConnection "sync.db" $ \conn -> do
    initialize conn
    let env = AppEnv conn
    runApp env $ do
      jobs <- loadJobs
      liftIO (print jobs)

这种组织方式有几个好处：

数据库连接只在入口处打开和关闭
业务函数不需要显式接收连接参数
测试时可以替换环境，或把数据库文件指向临时位置
数据库访问集中在少数模块中，不会散落在整个程序里

不过，也要注意不要把 SQL 细节泄露到所有层级。一个健康边界通常是：数据库模块返回领域类型或数据库专用类型，应用层调用这些函数，而不是自己拼 SQL。

下面是一个更完整的数据库模块轮廓。

代码清单 16.27 数据库访问模块轮廓

{-# LANGUAGE OverloadedStrings #-}

module Sync.Database
  ( initialize,
    insertJob,
    selectJobs,
    deleteJob,
  )
where

import Database.SQLite.Simple
import Sync.Database.Job

initialize :: Connection -> IO ()
initialize conn =
  execute_
    conn
    "CREATE TABLE IF NOT EXISTS sync_jobs\
    \ (id INTEGER PRIMARY KEY,\
    \  source TEXT NOT NULL,\
    \  target TEXT NOT NULL,\
    \  dry_run INTEGER NOT NULL)"

insertJob :: Connection -> NewSyncJob -> IO ()
insertJob conn job =
  execute
    conn
    "INSERT INTO sync_jobs (source, target, dry_run) VALUES (?, ?, ?)"
    job

selectJobs :: Connection -> IO [DbSyncJob]
selectJobs conn =
  query_
    conn
    "SELECT id, source, target, dry_run FROM sync_jobs ORDER BY id"

deleteJob :: Connection -> Int -> IO ()
deleteJob conn jobId =
  execute
    conn
    "DELETE FROM sync_jobs WHERE id = ?"
    (Only jobId)

这个模块隐藏了 SQL 字符串的位置。其他代码只需要调用 insertJob、selectJobs 和 deleteJob。当表结构变化时，修改范围也更可控。

最后，把 JSON 和数据库连接起来也很自然。可以为数据库类型派生 JSON 实例，让应用导出任务列表：

代码清单 16.28 导出数据库任务为 JSON

{-# LANGUAGE DeriveGeneric #-}

module Sync.Database.Job where

import Data.Aeson
import Database.SQLite.Simple.FromRow
import Database.SQLite.Simple.ToRow
import GHC.Generics

data DbSyncJob = DbSyncJob
  { dbJobId :: Int,
    dbJobSource :: FilePath,
    dbJobTarget :: FilePath,
    dbJobDryRun :: Bool
  }
  deriving (Eq, Generic, Show)

instance ToJSON DbSyncJob

instance FromRow DbSyncJob where
  fromRow =
    DbSyncJob
      <$> field
      <*> field
      <*> field
      <*> field

这样就能把数据库查询结果编码为 JSON：

exportJobs :: Connection -> IO LBS.ByteString
exportJobs conn =
  encode <$> selectJobs conn

需要导入：

import Data.Aeson
import qualified Data.ByteString.Lazy as LBS

到这里，我们已经完成了从 Haskell 数据类型到 JSON，再到 SQL 表的完整路径。每一层都有自己的类型类和边界：Aeson 负责 JSON，sqlite-simple 负责行转换，应用模块负责决定何时读取、写入和展示数据。

总结

Aeson 使用 ToJSON 和 FromJSON 类型类在 Haskell 值与 JSON 之间转换。
encode 会把值编码为惰性 ByteString；eitherDecode 会解析 JSON 并保留错误信息。
手写 JSON 实例提供最大控制权，适合公开 API 或长期稳定格式。
Generic 派生可以减少重复代码，适合字段到字段的自然映射。
自动派生会受到 Haskell 类型结构影响，公开格式需要显式设计字段名和和类型编码。
SQLite 是轻量的嵌入式 SQL 数据库，适合命令行工具和小型应用。
sqlite-simple 使用参数化查询执行 SQL，避免手动拼接字符串。
FromRow 把数据库行转换为 Haskell 值，ToRow 把 Haskell 值转换为 SQL 参数。
新建数据和已持久化数据可以使用不同类型表达，例如 NewSyncJob 与 DbSyncJob。
数据库访问最好集中在专门模块中，让 SQL 边界清晰、修改范围可控。

16.1 将值编码为 JSON（Encoding values as JSON）​

16.1.1 Aeson 与 JSON 解析（Aeson and JSON parsing）​

16.1.2 JSON 序列化（Serializing to JSON）​

16.2 使用 Generic 推导类型类（Deriving type classes with Generic）​

16.3 使用 SQLite 数据库（Using a SQLite database）​

16.3.1 sqlite-simple 基础​

16.3.2 ToRow 与 FromRow​

16.3.3 定义数据库访问动作（Defining actions for database access）​

总结​