第 11 章 - 编程音乐作品（Programming musical compositions）

本章内容包括：

• 构造包含不同类型数据的多态数据结构
• 解释复杂数据结构以计算更多信息
• 在 Haskell 中实现领域特定语言

上一章中，我们构建了一个软件合成器的基础。我们引入了一些类型，用于抽象表示音频信号和音高信息。借助 HCodecs 库，我们能够把音频数据写入文件系统。

技术细节处理完后，现在可以讨论如何在程序中作曲。显然，我们不想把音符写在纸上；我们想直接在程序里写。实质上，编译后的 Haskell 二进制文件会变成作品本身，并且内置一个可以播放这部作品的合成器！可以把它看作我们自己的数字音乐盒。

本章会通过设计一种表示作品的类型来构建这个音乐盒。在这个过程中，我们会学习如何构造异构数据结构，也就是在同一个结构中混合不同类型的值。定义音乐结构及其解释方式后，我们会在 Haskell 中设计自己的音乐作品领域特定语言！

11.1 多类型多态数据结构（Polymorphic data structures with multiple types）

那么，如何在程序中表示作品？在音乐中，我们可以区分音符和休止。乐器要么播放音符，要么在一定时间内保持安静。这些音符和休止可以按顺序排列，也可以组合成组。

如图 11.1 所示，旋律是一串音符，而和弦是一组同时播放的音符。不过，音符序列本身也可以继续放进序列或分组里。分组也可以按顺序排列。例如，多个和弦可以依次播放，如图 11.2 所示。那么该如何建模呢？

图 11.1 旋律是一串音符

图 11.2 一串和弦，每个和弦由同时播放的音符组成

我们的数据结构需要允许递归或嵌套。否则，就无法允许序列中包含序列这样的情况。同时，也要思考我们想实现什么。稍后，我们不希望用构造器直接书写这个数据类型，而是希望用操作符构造音符、休止、序列和分组。我们还希望能够混合所有这些元素，例如把它们全部放入一个应该同时播放的组里。因此，无论我们建模什么，都应该包含在单个数据类型中。满足所有这些要求的数据类型可能如下：

data NoteStructure a
  = Note Notelength a
  | Pause Notelength
  | Sequence [NoteStructure a]
  | Group [NoteStructure a]

不过，这会带来一个问题。上一章中，我们使用 Pitchable 类型类定义了可以计算音高的类型。这些类型包括 Hz、Semitone 和 Chromatic。对合成器来说，它处理的是频率还是半音阶音符不应该重要，因此混合这些类型是合理的。但是 NoteStructure 类型只由单一类型参数化。这意味着我们可以定义 NoteStructure Hz 和 NoteStructure Chromatic，却不能定义一个可以同时混合 Hz 和 Chromatic 值的 NoteStructure。

列表也有同样限制。我们认为这些数据结构是同构的，因为它们只包含同一种类型的值。如果想在一个数据结构中打包不同类型的值，那么它就是异构的。但在 Haskell 中，这可能吗？

11.1.1 存在量化（Existential quantification）

让我们再次回顾 Haskell 类型的工作方式，并看看这个例子：

ghci> data D a = D a
ghci> :t [D (1 :: Int), D (2 :: Int)]
[D (1 :: Int), D (2 :: Int)] :: [D Int]
ghci> :t [D (1 :: Int), D (2 :: Float)]

<interactive>:1:19: error:
    • Couldn't match expected type ‘Int’ with actual type ‘Float’
    • In the first argument of ‘D’, namely ‘(2 :: Float)’
      In the expression: D (2 :: Float)
      In the expression: [D (1 :: Int), D (2 :: Float)]

这里定义了一个简单数据类型，它只有一个构造器和一个类型变量。我们可以定义类型为 [D Int] 的同构列表，其中所有值都必须是 D Int。一旦定义一个同时包含 D Int 和 D Float 值的列表，类型就会冲突，因为 Int 与 Float 不同，因此 D Int 和 D Float 也不是同一类型。能不能以某种方式隐藏这个类型参数？如果可以隐藏它，就能简单创建一个 [D] 列表，也不会产生类型错误。事实证明，使用 ExistentialQuantification 语言扩展可以做到这一点。

启用这个语言扩展后，可以定义一种数据类型：在定义的右侧使用类型变量，而不在左侧指定它们：

ghci> :set -XExistentialQuantification
ghci> data E = forall a. MkE a
ghci> :t MkE
MkE :: a -> E
ghci> :t MkE (1 :: Int)
MkE (1 :: Int) :: E
ghci> :t MkE (1 :: Float)
MkE (1 :: Float) :: E
ghci> :t [MkE (1 :: Int), MkE (2 :: Float)]
[MkE (1 :: Int), MkE (2 :: Float)] :: [E]

我们用 forall 关键字引入这些解耦的类型变量。可以看到，E 类型没有类型变量，但它的构造器类型是 a -> E。因此，它可以接收任意类型的值，并产生 E 类型的值。这意味着无论把什么放入 MkE 构造器，得到的始终是同一种类型。于是，就可以把这些值放入列表，构造一个异构列表。

但是，该如何处理这样的类型？如何访问放入构造器里的值？为此，我们需要构造一个类型为 E -> a 的函数，其中 a 与 MkE 构造器中使用的 a 对应。遗憾的是，这不可能做到，因为 E 类型并没有暴露这个 a。毕竟，这正是我们想实现的目标。现在面对的问题是，我们对 a 一无所知。它可能是任何东西。

可以通过为存在量化的类型变量提供类型约束来解决这个问题：

ghci> data ShowData = forall a. (Show a) => ShowThis a
ghci> :{
ghci| showThis :: ShowData -> String
ghci| showThis (ShowThis x) = show x
ghci| :}
ghci> showValues = [ShowThis (1 :: Int), ShowThis ("Hi" :: String)]
ghci> :t showValues
showValues :: [ShowData]
ghci> map showThis showValues
["1","\"Hi\""]

在这个例子中，可以对 ShowThis 构造器内部的值使用 show，因为 ShowData 类型的定义已经明确说明，构造器内部的值拥有 Show 类型类实例。因此，我们知道 ShowData 值列表里的值可能是异构的，但一定可以被 showThis 使用。

11.1.2 使用存在量化类型（Using existentially quantified types）

我们可以利用这一点，让 NoteStructure 接收不同类型的值。为此，先创建一个用于一般性描述音高的新类型。需要以下扩展：

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
module Composition.Pitch where

现在，可以定义一个 Pitch 类型，它包含拥有 Pitchable 实例的值。然后定义 Pitchable Pitch 实例，该实例会对 Pitch 值内部的值使用 toFrequency。代码如下所示。

代码清单 11.1 表示音高的异构包装类型

data Pitch = forall a. (Pitchable a, Show a) => Pitch a  -- #1

deriving instance Show Pitch                             -- #2

instance Pitchable Pitch where
  toFrequency (Pitch p) = toFrequency p                  -- #3

• #1 定义一个音高类型，可以包装任意拥有 Pitchable 和 Show 实例的类型值
• #2 为 Pitch 类型派生 Show 实例
• #3 定义 Pitchable Pitch 实例

我们也把 Show 用作约束，这样就可以为 Pitch 派生 Show 实例。对于存在量化数据类型，必须使用由 StandaloneDeriving 语言扩展启用的独立派生，这要求我们把 deriving 子句写在与数据类型定义分开的行中。现在，可以使用这个类型包装任意 Pitchable 类型，并用它们构建能够包含不同类型值的数据结构：

ghci> pitches = [Pitch (a 4), Pitch (440 :: Hz), Pitch (0 :: Semitone)]
ghci> :t pitches
pitches :: [Pitch]
ghci> pitches
[Pitch (Chromatic A 4),Pitch 440.0,Pitch 0]
ghci> map toFrequency pitches
[440.0,440.0,440.0]

即使创建的是音高的异构列表，仍然可以使用 toFrequency 函数把它们转换为频率。

现在，可以移除 NoteStructure 类型中的类型变量，并用 Pitch 类型替代它。如下所示。

代码清单 11.2 用于组织音符的数据类型

data NoteStructure
  = Note Notelength Pitch        -- #1
  | Pause Notelength             -- #2
  | Sequence [NoteStructure]     -- #3
  | Group [NoteStructure]        -- #4
  deriving (Show)                -- #5

• #1 定义音符构造器
• #2 定义休止构造器
• #3 定义音符结构序列构造器
• #4 定义音符结构分组构造器
• #5 派生 Show 类型类实例

有了这个类型，我们需要找到一种方式，把用它创作出的东西转换为可以产生声音的内容。我们已经有一种声音类型，也就是 Event。现在要把 NoteStructure 转换成多个事件。为此，我们定义一个表示演奏的类型，它用于描述多个事件：

module Composition.Performance where

type Performance = [Event]

这个类型必须包含所有事件，并且带有正确的开始时间，这样才能把它们传给 Oscillator 类型，听到美妙的音乐。

11.2 结构解释（Interpreting structures）

为了做到这一点，需要递归解析 NoteStructure，跟踪时长，并把元素组合成列表。既然要递归，就知道想实现的函数需要一个 Seconds 参数，表示解释时的当前时间。同时，还需要一个 TempoInfo 参数，用于知道某个音符或休止需要保持多久，因为 Event 类型只知道以 Seconds 作为时间度量。结果是，我们不仅需要 Performance，也需要 Seconds，因为递归时需要一些关于已流逝时间的信息。这样，解析序列和分组就是在各自列表元素上的折叠。对于序列，元素的开始时间由已经流逝的时间决定，返回的 Seconds 值由最后生成的 Event 的结束时间给出。在分组中，所有元素都在同一时刻开始，返回的 Seconds 值由生成的最长 Event 的结束时间给出。基于这些信息，可以组合出如下函数。

代码清单 11.3 把音符和休止结构转换为可播放事件的函数

module Composition.Performance where

...

import Composition.Note
import Composition.Notelength
import Composition.Pitch
import Data.List (foldl')

...

structureToPerformance ::
  TempoInfo ->
  Seconds ->
  NoteStructure ->
  (Seconds, Performance)
structureToPerformance tempoInfo start structure =
  case structure of
    (Note length pitch) ->
      let freq = toFrequency pitch                         -- #1
          duration = timePerNotelength tempoInfo length    -- #2
       in (start + duration, [Tone {freq, start, duration}]) -- #3
    (Pause length) ->
      let duration = timePerNotelength tempoInfo length    -- #4
       in (start + duration, [Silence {start, duration}])  -- #5
    (Group structs) -> foldl' f (start, []) structs        -- #6
      where
        f (durAcc, perf) struct =
          let (dur, tones) =
                structureToPerformance tempoInfo start struct -- #7
           in (max dur durAcc, perf ++ tones)              -- #8
    (Sequence structs) -> foldl' f (start, []) structs     -- #9
      where
        f (durAcc, perf) struct =
          let (newdur, tones) =
                structureToPerformance tempoInfo durAcc struct -- #10
           in (newdur, perf ++ tones)                      -- #11

• #1 根据音符给出的音高信息确定频率
• #2 根据音符长度和给定速度信息计算音符或休止的时长
• #3 返回音符结束时间，以及只包含单个音调事件的 Performance
• #4 根据音符长度和给定速度信息计算音符或休止的时长
• #5 返回休止结束时间，以及只包含静音事件的 Performance
• #6 从给定开始时刻出发，折叠分组中的递归结构
• #7 使用给定开始时间作为该特定 Performance 的开始，递归计算 Performance 及其结束时间
• #8 返回给定时刻与递归调用产生的结束时刻中的较大值，并把 Event 值追加到累加器中，顺序不做特殊保证
• #9 从给定开始时刻出发，折叠序列中的递归结构
• #10 使用折叠中的当前时刻作为该特定 Performance 的开始，递归计算当前结构的 Performance 及其结束时间
• #11 返回新的当前时刻，并把 Event 值追加到累加器中，顺序不做特殊保证

这个函数不会根据开始时间把 Event 值放到正确顺序中，并且需要一个特殊的 start 参数；首次转换 NoteStructure 时，这个参数应该是 0。另外，它返回一个包含某个时长的元组，而我们只是想播放这些事件时并不关心这个时长。因此，可以编写一个包装函数，去掉返回值中的元组，并正确排序这些值。如下所示。

代码清单 11.4 把音符结构转换为演奏的包装函数

...
import Data.List (sortBy, foldl')
...

toPerformance :: TempoInfo -> NoteStructure -> Performance
toPerformance tempoInfo =
  sortBy (\x y -> compare (start x) (start y))  -- #1
    . snd                                       -- #2
    . structureToPerformance tempoInfo 0        -- #3

• #1 按开始时间对 Performance 中得到的 Event 值排序
• #2 访问返回元组中的第二个值
• #3 以 0 作为开始时间调用 structureToPerformance

通过这个函数，我们在作品，也就是 NoteStructure 值，以及可由 Oscillator 播放的 Performance 之间架起了一座桥。

练习：合并静音

虽然 toPerformance 函数已经工作良好，但仍有一个可改进之处。休止总会产生静音。我们的 NoteStructure 类型允许创建一串静音。当然，这些静音可以合并成一段更长的静音。请编写一个 Performance -> Performance 函数来做到这一点，然后把它加入 toPerformance 函数。思考一下如何测试这个函数。你能为它想出 QuickCheck 属性吗？

我们还没有实现一个能够播放整个 Performance 的 Oscillator。这是实现作品前的最后一块拼图。

11.2.1 混合信号（Mixing signals）

为了让播放 Performance 的能力保持通用，我们希望通过一个简单的类型类抽象它。这样做是为了以后能添加更多可能的发声器。毕竟，振荡器并不是唯一能产生声音的东西。类型类如下所示。

代码清单 11.5 把演奏转换为信号的类型类

module Sound.Sound where

import Util.Types
import Composition.Performance

class Performer p where
  play :: p -> Performance -> Signal

play 函数稍后会被应用到演奏上，以构造信号。它会如何工作？这里要处理的一个问题是，事件天然可能重叠。我们正在创建的是一个复音合成器，也就是说，它可以同时播放多个音符。这要求我们先思考如何把多个信号混合成一个信号。为此，我们想编写一个函数，它可以把信号相加，而且不会削波。样本电平超过 1 或低于 -1 时，就会发生削波。这时，limit 函数会截断信号并导致失真。应该避免这种情况。因此，在相加信号时，必须确保它们永远不会超过样本值的最大值和最小值。可以通过把相加后的信号除以被相加信号的数量来实现这一点。信号相加本身类似 zipWith (+)；但是，我们不能在较短信号处停止。较长信号剩下的所有样本也必须包含进来。那么，如果不存在 zipWithN，如何相加任意数量的信号？答案又来自折叠。通过在折叠中一个接一个地相加每个信号，可以把它们全部加起来，然后把样本除以被相加信号的数量。如下所示。

代码清单 11.6 把多个信号混合成单个信号的函数

module Sound.Sound where

...
import Data.List (foldl')
...

mix :: [Signal] -> Signal
mix signals = (/ n) <$> foldl' addSignals [] signals  -- #1
  where
    n :: Double
    n = fromIntegral $ length signals                 -- #2

    addSignals :: Signal -> Signal -> Signal
    addSignals xs [] = xs                             -- #3
    addSignals [] ys = ys                             -- #3
    addSignals (x : xs) (y : ys) = (x + y) : addSignals xs ys -- #4

• #1 折叠信号，把它们相加，然后把样本除以信号数量
• #2 确定信号数量并转换为 Double
• #3 返回较长信号的末尾部分
• #4 把两个信号的第一个样本相加，并递归相加剩余部分

信号混合处理完后，需要找到一种方式识别互相重叠的 Event 值，这样才能把它们分组，用 Oscillator 播放，再把信号混合回来。这里创建的是一种生成复音声音的方法，也就是多个声音同时播放。在大多数合成器中，能复音播放的最大声音数量受硬件限制。图 11.3 展示了这个概念如何工作。

图 11.3 生成复音音频信号背后的基本概念

由于我们的合成器不是实时运行的，所以拥有一个惊人优势：生成声音可以花多长时间没有限制。如果愿意花很长时间计算声音，我们的合成器就是无限复音的！

回到这些同时播放的事件。为了判断两个 Event 值是否重叠，可以使用 start 字段选择器和 end 函数，检查任一事件的开始是否落在另一个事件的持续时间内。如果是，两个事件就重叠。检查函数如代码清单 11.7 所示。

代码清单 11.7 检查事件是否重叠的函数

module Composition.Performance where

...

overlaps :: Event -> Event -> Bool
overlaps e1 e2 =
  start e1 `between` (start e2, end e2)       -- #1
    || start e2 `between` (start e1, end e1)  -- #2
  where
    between x (a, b) = x >= a && x <= b       -- #3

• #1 检查第一个 Event 的开始时间是否处于第二个 Event 的持续时间内
• #2 检查第二个 Event 的开始时间是否处于第一个 Event 的持续时间内
• #3 定义一个函数，当给定值处于指定范围内时返回 True

仅凭 between 辅助函数，我们就把函数名设计成了可以用中缀风格书写的形式，从而保持代码可读性。

练习：声音函数的属性

和许多函数一样，mix 与 overlaps 函数也有一些属性。由于前面解释过削波问题，mix 是一个尤其关键的函数。请编写一些 QuickCheck 属性来检查这个函数的正确性。

这些函数完成后，就可以着手为 Oscillator 编写 Performer 实例了。

11.2.2 多声部组（Groups of polyphony）

把 Performance 转换为 Signal 时，有几个陷阱我们不想掉进去。首先，Event 值列表是有序的。所以当我们折叠这个列表时，折叠方向很重要。其次，需要根据事件是否与其他事件重叠来分组。这会创建互不相交的事件组，这些组之间可能存在非显式的停顿，也就是说，可能有一个事件很早就结束，而另一个事件很久之后才开始。还需要确保混合信号时不会发生削波，不过 mix 函数已经处理了这一点。

先讨论事件分组。从左到右折叠事件时，可以从遇到的第一个事件开始，把它放入自己的组。对于 Performance 中的下一个事件，首先必须判断它是否与当前组中的任何事件重叠。如果没有重叠，就可以把它加入该组。如果有重叠，就需要以该事件为成员创建一个新组。对所有剩余事件重复这个过程。这个算法的一个重要属性是，它不会改变组内事件的顺序。为了让语法可读，我们希望使用列表推导和 or 函数：

ghci> :t or
or :: Foldable t => t Bool -> Bool
ghci> :t and
and :: Foldable t => t Bool -> Bool

or 和 and 函数很容易解释：它们折叠一个布尔值的 Foldable，并分别构造这些值的析取或合取。它们可以非常整洁地与列表推导配合使用，临时生成一个布尔值列表，再用 or 或 and 处理：

ghci> xs = [Tone 0 0 1, Tone 0 2 1]
ghci> x1 = Tone 0 2 1
ghci> x2 = Tone 0 1.5 0.1
ghci> or [ x1 `overlaps` e | e <- xs ]
True
ghci> or [ x2 `overlaps` e | e <- xs ]
False

由于这些表达式会求值得到单个 Bool，所以可以把它们用作函数中的守卫。这能帮助我们对列表上的复杂属性快速完成分支判断。

现在，还要思考如何播放这些事件组。由于它们之间可能存在隐式停顿，需要跟踪时间。在递归函数中，可以像 structureToPerformance 函数那样用一个参数来做到这一点。然后，需要从左到右扫描列表，并用 Oscillator 播放事件。如果事件组因某种原因排序错误，我们可能需要回到过去，播放一个本应已经被静音填充的位置上的音调。这种情况下，除了用 error 失败之外没有别的办法。如果其余实现都正确，这个分支本来就不应该发生。

事件分组和由事件生成信号都完成后，最后要做的就是按照构造器混合所有信号。幸运的是，这只是简单使用 mix。完整代码如下所示。

代码清单 11.8 使用振荡器执行演奏的类型类实例

module Sound.Sound where

...
import Sound.Synth
...

instance Performer Oscillator where
  play (Osc oscf) perf = mix $ fmap (playEvents 0) eventGroups -- #1
    where
      eventGroups :: [[Event]]
      eventGroups = foldr insertGroup [] perf                  -- #2
        where
          insertGroup x [] = [[x]]                             -- #3
          insertGroup x (es : ess)
            | or [x `overlaps` e | e <- es] =
                es : insertGroup x ess                         -- #4
            | otherwise = (x : es) : ess                       -- #5

      playEvents :: Seconds -> [Event] -> Signal
      playEvents _ [] = []                                     -- #6
      playEvents curTime (event : xs)
        | curTime < ts =
          concat
            [ silence (ts - curTime),                          -- #7
              oscf event,
              playEvents te xs                                 -- #8
            ]
        | curTime == ts =
            oscf event ++ playEvents te xs                     -- #9
        | otherwise = error "Event occurs in the past!"         -- #10
        where
          ts = start event
          te = end event

• #1 把每个事件组转换为 Signal，再混合这些信号
• #2 从左到右折叠 Performance 中的 Event 值
• #3 如果累加器为空，则添加一个只包含单个元素的组
• #4 如果当前 Event 与累加器中当前组的任意其他 Event 重叠，则递归把当前 Event 加入另一个组
• #5 如果当前 Event 与当前组中其他事件都不重叠，则把它加入当前组
• #6 如果没有剩余 Event 需要播放，则返回空信号
• #7 如果当前时间戳尚未到达下一个 Event 的开始时间，则先添加正确时长的静音，再播放下一个 Event
• #8 递归把组中剩余事件转换为信号
• #9 如果当前时间戳等于该 Event 的开始时间，则把下一个 Event 转换为信号，并递归追加剩余部分
• #10 如果当前时间戳已经超过下一个 Event 的开始时间，则抛出错误

注意，我们在 playEvents 函数中创建了一个短路。如果组中没有剩余事件，就返回空 Signal，因为 mix 会负责达到正确长度。

有了这个函数，终于可以播放 NoteStructure 值以及第一段作品了：

ghci> melody1 = Sequence [Note whole (Pitch $ c 4), Pause half,
                          Note whole (Pitch $ f 4)]
ghci> melody2 = Sequence [Note whole (Pitch $ f 4),
                          Note half (Pitch $ g 4), Note whole (Pitch $ a 4)]
ghci> melody3 = Sequence [Note whole (Pitch $ f 3),
                          Note half (Pitch $ c 3), Note whole (Pitch $ c 4)]
ghci> group = Group [melody1, melody2, melody3]
ghci> perf = toPerformance (TempoInfo 120 4) group
ghci> perf
[Tone {freq = 261.6255653005986, start = 0.0, duration = 2.0},Tone {freq
  = 349.2282314330039, start = 0.0, duration = 2.0},Tone {freq =
  174.61411571650194, start = 0.0, duration = 2.0},Silence {start
  = 2.0, duration = 1.0},Tone {freq = 391.99543598174927, start
  = 2.0, duration = 1.0},Tone {freq = 130.8127826502993, start
  = 2.0, duration = 1.0},Tone {freq = 349.2282314330039, start
  = 3.0, duration = 2.0},Tone {freq = 440.0, start = 3.0, duration
  = 2.0},Tone {freq = 261.6255653005986, start = 3.0, duration = 2.0}]
ghci> signal = play piano perf
ghci> writeWav "performance.wav" signal
Writing 220500 samples to performance.wav

这里可以看到一个小动机：三条旋律随后被组合进一个组。音符会同时播放，生成的信号也不会削波。

太好了！不过也能看到，即使写下这么短的作品也真的很痛苦。我们不想手写 Haskell 数据类型。想要的是同一件事的一种更易书写、更易理解的表示；理想情况下，它应该把底层数据类型抽象掉。

11.3 实现领域特定语言（Implementing a domain-specific language）

现在终于可以讨论如何在程序中作曲了。显然，我们不想在一个复杂得没完没了的巨大语法树中手动书写构造器。我们想构造的是一种领域特定语言（DSL）。

Haskell 允许我们定义自己的操作符，并为它们指定如何与其余数据关联的规则。另外，它也允许定义操作符优先级，从而为想表示的东西得到干净语法。这让 Haskell 成为一个很适合开发领域特定语言的平台，尤其适合面向专门用例的语言。

注意 如果在语义上完全吹毛求疵，那么当领域特定语言像本章这样直接嵌入某种编程语言时，更准确地说应称为嵌入式领域特定语言（EDSL）。不过，我们想让说法短一点，所以省略这个额外区分。

我们会利用这一点定义语法，让我们能够基于 NoteStructure 类型轻松作曲，而作曲者，也就是 DSL 的使用者，永远不需要看到或了解这个类型。首先最想做到的是写下音符。当前方式太啰嗦了：Note whole (Pitch $ e 4)。因为这个构造器有点过于冗长，可以创建一个操作符来替代它：

module Composition.Note where

...

(.|) :: (Pitchable a, Show a) => a -> Notelength -> NoteStructure
(.|) p l = Note l (Pitch p)

infixr 4 .|

我们选择 .| 作为操作符，因为它多少有点像一个音乐音符。这个定义默认创建一个中缀操作符。第一个参数放在操作符前面，第二个参数放在操作符后面。替换构造器很重要，因为 DSL 使用者不应该直接接触底层 NoteStructure 类型。我们明确只允许拥有 Pitchable 和 Show 实例的类型，因为 Pitch 构造器需要这个约束。这里再次可以看到 NoteStructure 是异构的，因为我们把一个多态参数（a）传给函数，但该类型变量并没有出现在函数结果中。

11.3.1 简化语法（Simplifying syntax）

这个新操作符让书写音符更简洁。不过，长度值（whole、half 等）仍然很冗长。为了获得更短的长度标识符，可以为 Notelength 常量创建更短的名字：

module Composition.Notelength where

...

wn :: Notelength
wn = whole

hn :: Notelength
hn = half

...

sn :: Notelength
sn = sixteenth

这个简单步骤让写音符变得很容易：

ghci> c 4 .| wn
Note (1 % 1) (Pitch (Chromatic C 4))
ghci> f 8 .| triplet sn
Note (1 % 24) (Pitch (Chromatic F 8))
ghci> (400 :: Hz) .| (100000 % 100001)
Note (100000 % 100001) (Pitch 400.0)

对休止也可以做同样处理：只要为 Pause 构造器创建一个单字母同义函数即可。

p :: Notelength -> NoteStructure
p = Pause

又一个构造器处理完了。

11.3.2 自定义操作符用于类列表数据结构（Custom operators for list-like data structures）

接下来研究 Sequence 和 Group。总体来说，我们希望 DSL 使用者能够直接组合音符和休止，而不必显式创建列表或构造器。

这意味着需要完全抽象掉序列化和分组的概念。可以为它们创建操作符，用这些操作符组合音符和休止。对于序列，如果遇到两个序列，就简单把它们组合成一个新序列。如果操作符只有一个参数是序列，就把另一个参数加入其中。如果两个参数都不是序列，就创建一个全新的序列。这个操作符如下所示。

代码清单 11.9 构造作品序列的中缀操作符

(<~>) :: NoteStructure -> NoteStructure -> NoteStructure
(<~>) (Sequence xs) (Sequence ys) = Sequence $ xs ++ ys  -- #1
(<~>) (Sequence xs) x = Sequence $ xs ++ [x]             -- #2
(<~>) x (Sequence xs) = Sequence $ x : xs                -- #2
(<~>) a b = Sequence [a, b]                              -- #3

infixr 3 <~>

• #1 把两个序列相加
• #2 把另一个参数加入序列
• #3 用两个参数创建新序列

这样就能悄悄避开 Sequence 构造器，以及它所需的列表：

ghci> c 4 .| wn <~> e 4 .| wn <~> g 4 .| wn
Sequence [Note (1 % 1) (Pitch (Chromatic C 4)),Note (1 % 1)
(Pitch (Chromatic E 4)),Note (1 % 1) (Pitch (Chromatic G 4))]

有趣的是，分组函数看起来非常非常相似，甚至可以说完全相同。代码如下所示。

代码清单 11.10 构造作品分组的中缀操作符

(<:>) :: NoteStructure -> NoteStructure -> NoteStructure
(<:>) (Group xs) (Group ys) = Group $ xs ++ ys  -- #1
(<:>) (Group xs) x = Group $ xs ++ [x]          -- #2
(<:>) x (Group xs) = Group $ x : xs             -- #2
(<:>) a b = Group [a, b]                        -- #3

infixr 2 <:>

• #1 把两个分组相加
• #2 把另一个参数加入分组
• #3 用两个参数创建新分组

这种相似当然不是偶然。由于 Sequence 和 Group 的结构完全相同，它们的操作符也相同是合理的。唯一差异在构造器名称上，因为这决定了稍后如何解释数据。

注意 本章提出的 DSL 部分受到 Haskore 项目的启发，后者也有类似操作符。

现在操作符已经准备好了，开始之前还剩最后一个问题：表达式 c 4 .| wn <~> e 4 .| wn <:> g 4 .| wn 的结果是什么？这里遇到的是操作符优先级问题。<~> 和 <:> 哪个应该有更高优先级？这不是一个容易回答的问题，因为它取决于 DSL 的使用方式。不过，我们会让 <~> 的优先级高于 <:>。该如何做到？

11.3.3 Fixity 声明（Fixity declarations）

Haskell 提供了声明优先级规则的语法。第 7 章讨论 $ 操作符时已经见过它。声明以 infixr、infixl 或 infix 关键字开头，分别表示操作符是右结合、左结合，还是完全不结合。后面跟一个 0 到 9 之间的优先级。最后写上所讨论的操作符，声明就完成了。这称为fixity 声明。

在我们的例子中，所有操作符都会设为右结合。(.|) 操作符必须比所有其他操作符优先级更高，因为它不是用来组合作品，而是构成原子构件。然后，(<~>) 的优先级高于 (<:>)。通过下面的 fixity 声明，可以强制这些规则：

infixr 4 .|

infixr 3 <~>

infixr 2 <:>

我们已经处理了 DSL 几乎所有想要的属性。最后一个属性是让重复更容易。如果想重复一段旋律或和弦，现在仍然必须复制声明。当然，我们可以发明新操作符来实现重复！这些操作符可以把给定 NoteStructure 复制指定次数，并把结果包装进 Sequence 或 Group。如下所示。

代码清单 11.11 重复作品的操作符

(<~|) :: NoteStructure -> Natural -> NoteStructure
(<~|) (Sequence xs) n = Sequence $ concat [xs | _ <- [1 .. n]]
(<~|) struct n = Sequence $ [struct | _ <- [1 .. n]]

(|~>) :: Natural -> NoteStructure -> NoteStructure
(|~>) = flip (<~|)

(<:|) :: NoteStructure -> Natural -> NoteStructure
(<:|) (Group xs) n = Group $ concat [xs | _ <- [1 .. n]]
(<:|) struct n = Group $ [struct | _ <- [1 .. n]]

(|:>) :: Natural -> NoteStructure -> NoteStructure
(|:>) = flip (<:|)

为了让语法更灵活，重复次数可以放在左侧，也可以放在右侧。由于重复应该“包住”其他作品，这些操作符的优先级应该低于所有其他操作符：

infixr 1 <~|

infixr 1 |~>

infixr 1 <:|

infixr 1 |:>

试试我们的新语言：

ghci> c 4 .| wn <~> e 4 .| wn <:> g 4 .| wn <~| 2
Sequence [Group [Sequence [Note (1 % 1) (Pitch (Chromatic C 4)),Note (1 % 1)
(Pitch (Chromatic E 4))],Note (1 % 1)(Pitch (Chromatic G 4))],Group [Sequence
[Note (1 % 1)(Pitch (Chromatic C 4)),Note (1 % 1) (Pitch (Chromatic E 4))],
Note (1 % 1) (Pitch (Chromatic G 4))]]

可以看到，语法变得更容易读写，而且构造作品不再需要了解我们的数据结构。

练习：切换优先级

我们选择让 (<~>) 的优先级高于 (<:>)。不过，也可以通过为两个操作符创建同义操作符，并交换它们的优先级来避免这个问题。这样，作曲者不需要使用括号，而是可以切换到另一个操作符！请实现这些同义操作符。

至此，我们拥有了自己的数字音乐盒！

回顾一下这里做了什么。首先，我们为一个领域特定问题实现了类型和函数：音乐声音生成。我们在程序中把真实世界的属性建模为数据类型，并有效地建模了基础合成器技术。在这个过程中，我们创建了一个小框架，用于构建可轻松扩展的合成乐器。

练习：添加采样器

我们的小合成器有点偏心。它唯一的声音生成器是 Oscillator 类型，可以创建和弦和旋律，但在打击乐方面还有很多不足。牛铃在哪里？在电子音乐中，这通常通过采样器解决。采样器是一种可以采样其他音频（例如鼓声）并在音乐编排中回放它们的机器。请为合成器框架实现这样的 Sampler 类型。这需要你发挥一些巧思。你需要考虑如何让这个组件访问声音文件，如何触发这些文件的播放，以及它如何与我们的 DSL 组合在一起。

第二，我们建模了另一个领域特定问题：音乐作曲。我们使用数据类型和各种函数，把音乐作品的含义抽象成可以更容易从代码中控制的东西。

第三，我们为前面提到的作曲主题创建了一种领域特定语言。这个领域特定语言围绕数据类型构建抽象，即使不了解内部实现也能使用。它还可以扩展，以允许更多样的作曲技术，例如偶然音乐（aleatoric，一个表示随机的漂亮词）。由于这门语言嵌入在 Haskell 中，我们可以把框架中实现的任何功能加入其中。

剩下要做的，就是考验我们的合成器并创作一些音乐。可以查看代码仓库中的小示例！

总结

• ExistentialQuantification 扩展可用于创建异构数据结构，把类型参数隐藏在类型内部。
• 为了让异构类型有用，必须给出类型约束，从而明确可以对该类型中的具体值做什么。
• 数据结构可以作为结果的描述；要得到结果，必须解释这个结构。
• 自定义操作符可以像普通函数一样实现。
• 可以在 Haskell 中实现领域特定语言：让自定义操作符定义数据结构，然后解释该结构。
• 可以使用 infix、infixl 和 infixr fixity 声明来定义操作符的结合性和优先级。