用Haskell把My Clippings.txt转成CSV

2023-03-18

我上周尝试了下Readwise，发现它不支持链接中国亚马逊账号，还不支持导入中文My Clippings.txt。客服让我试试转成CSV再倒入——好呀，我倒要看看解析中文My Clippings.txt到底有多难。

结论是说难也不难，说简单也不简单。因为亚马逊中国会在书名和作者之间加入各种形式的广告词、作者名的格式也不统一，甚至连页码和位置的组合都有很多种。想要处理所有极端情况是难的——可能需要两个pass，或者各种回溯叠在一起；但要解析绝大多数情况的话，还是挺简单的——如下：

目录

• Parse
  • 拆分问题
  • pType
  • pLocation
  • pContent
  • pUTCTime
  • pAuthor'
  • pTitle
  • pAuthor
  • pFile
• 清理数据
• 合并笔记和对应标注
• 输出成CSV
• 完整代码
• Readwise不好用

Parse

近期我又对Haskell产生兴趣了，所以跳着读了下Alejandro Serrano Mena的《Practical Haskell》之后就用书里介绍的Attoparsec库写parser了。不过因为书里只是简单介绍、Attoparsec的错误信息近乎于零、我不知道该如何测试，不久我就转而使用拥有详尽教程、注重错误信息、官方提供测试方法的Megaparsec库了。

本段就来讲解如何用Haskell的Megaparsec库解析My Clippings.txt。因为我也是现学的，所以会讲得比较通俗——不过要小心我可能会讲错，对某个细节有兴趣的话建议上网再查查。

拆分问题

My Clippings.txt中的一条Clipping大概是如下形式：

日瓦戈医生 (［苏］帕斯捷尔纳克)
- 您在位置 #1144-1144的标注 | 添加于 2019年1月2日星期三 下午12:15:12

请您注意，一个人生存在别人之中，才是一个人的本性。
==========

可以看出，我们可以从中提取出标题、作者、位置、类型、日期还有内容——这些都是parse一整条Clipping时需要解决的子问题。我们可以用它们组成Clipping类型：

data Clipping = Clipping
  { title :: Text,
    author :: Text,
    loc :: Int,
    type_ :: ClippingType,
    date :: UTCTime,
    content :: Text
  }
  deriving (Show, Eq)

注意等号两边的Clipping虽然同名，但代表不同的东西：左边的是类型名，右边的是调用后可以返回左边类型的构造函数。

我们还可以写出如下的函数来组装Clipping：

type Parser = Parsec Void Text

pClipping :: Parser Clipping
pClipping = Clipping <$> pTitle <*> pAuthor <*> pLocation <*> pType <*> pUTCTime <*> pContent

其中pTitle、pAuthor、pLocation、pType、pUTCTime和pContent就是分别处理标题、作者等子问题的函数。

定义Parser类型那一行不用深究，只需要知道如果一个函数的类型是Parser a，那么在实际parse时它会从字符串里拿一个a出来。我们也可以把Parser想象成某种列表：[a]代表列表里装着a，Parser a代表Parser里装着a。^[1]严格来讲，是列表和Parser都属于一种东西。不过并不需要知道它们属于什么也可以解决问题，所以我也不会讲到底属于什么。

<+>的意思是把它左边的函数拿进右边的Parser里调用，然后把结果继续装在Parser里。比如Clipping <$> pTitle代表把本来需要6个参数的Clipping构造函数放进Parser里拿到第一个参数（Parser里装的东西），然后我们得到一个Parser里装着还需要5个参数的函数。^[2]需要6个参数的函数和需要1个参数然后返回一个需要5个参数的函数是一个意思——实际上，每个函数都只需要一个参数。需要多个参数的函数不过是返回了新的函数。

<*>的意思是把左边的Parser里包着的函数和右边的Parser里包着的参数结合，然后把结果放进Parser里。它和<$>的区别在于它期望左边的函数是被Parser包住的，而<$>期望一个普通的函数——所以我们会经常看到一个<$>起头，后面跟着很多个<*>。

明白了<$>和<*>的意思，就可以看出pClipping函数所做的事是把Clipping函数拿进Parser里。然后一个一个地把参数喂给装进Parser之中的函数，最后我们可以得到一个装着Clipping类型的Parser。

pType

先让我们从最简单的子问题入手：区分被parse的字符串是标注还是笔记。

我们已经见过标注的例子，下面是笔记的例子：

番茄工作法【创始人毕生心血之作，已售11国版权，时间管理领域扛鼎作品！华尔街日报、哈佛商业评论等联袂推荐】 (弗朗西斯科·西里洛)
- 您在位置 #257 的笔记 | 添加于 2021年4月6日星期二 下午4:58:09

是么？
==========

可以看出，区别在于标注会写“您在位置 xxx的标注”，而笔记会写“您在位置 xxx的笔记”。My Clippings.txt中类似的类型还有“书签”和“文章剪切”，我就不举例了。

一个简单的思路是：定义一个有4种可能值的ClippingType类型，然后根据匹配到的是“标注”还是“笔记”来决定返回什么：

data ClippingType = Highlight | Bookmark | Cut | Note deriving (Show, Eq, Ord)

pType :: Parser ClippingType
pType = whichType <$> (string "标注" <|> string "笔记" <|> string "书签" <|> string "文章剪切")
  where
    whichType "标注" = Highlight
    whichType "笔记" = Note
    whichType "书签" = Bookmark
    whichType "文章剪切" = Cut

其中新出现的string函数意为匹配傻瓜引号里的字符串：string "标注"只有在遇到“标注”二字时才会成功，并且返回包着"标注"的Parser。而<|>的意思是先尝试匹配左边的Parser，如果不成功再尝试右边的。所以这个pType的意思是依次尝试匹配“标注”、“笔记”……然后再把匹配到的字符串转换成对应类型。

这个函数会正常工作，但我们重复写了两遍同样的字符串。有没有更好的方法直接让string "标注"成功后返回Highlight？有：<$函数。

<$和<$>类似，会将它左边的东西拿进Parser。不过区别在于<$>会拿进来一个函数，以右边被包住的参数调用函数；而<$会把左边的东西放进Parser，舍弃右边的值——只有string "标注"成功时才会进行替换，所以并不是白白舍弃。另外，我们还会看到类似<*>的<*和*>。后两者的区别和<$及<$>的区别类似：舍弃右边或左边的值（尖括号指着的一边才会被保留）。

有了<$，我们可以写出更紧凑的pType函数：

pType :: Parser ClippingType
pType =
  choice
    [ Highlight <$ string "标注",
      Note <$ string "笔记",
      Bookmark <$ string "书签",
      Cut <$ string "文章剪切"
    ]
    <* string " | 添加于 "

其中choice是<|>的另一种写法，它相当于用<|>串联起列表里的每一项——不过以一对方括号代替了好多圆、尖括号。

另外我还在末尾添加了<* string " | 添加于 "，意为匹配“ | 添加于 ”，但舍弃匹配掉的值。这是因为My Clippings.txt中有许多对我们的程序没意义的字符，在parse时我们需要手动跳过它们。我倾向于让每个小parser在最后处理掉那些没用的字符，这样的话下一个parser就可以直接写重要的逻辑了。^[3]我这样操作，其实是受了Megaparsec教程的启发。

pLocation

从前面的两个例子可以看出，标注位置是一个范围，而笔记位置只有一个数字。实际上，每做一个笔记都会生成相应的标注，而标注范围的最后一个数字和笔记的数字是一样的（确实有反例，但5212条里只见过一个）。所以我只用一个数字表示位置：遇到范围时只保留横线后的数字。

pLocation :: Parser Int
pLocation = (try range <|> L.decimal) <* (string "）的" <|> string " 的" <|> string "的")  
  where
    range = L.decimal *> char '-' *> L.decimal

L.decimal是匹配十进制数字，char是匹配一个字符，所以L.decimal *> char '-' *> L.decimal代表匹配并舍弃一个十进制数和横线，然后再匹配并保留一个十进制数。

我们已经见过<|>表示“先尝试左边的，不成功再尝试右边的”。但如果它尝试完左边的，没有恢复尝试之前的状态就去调用右边的函数会有问题：我叫你在这个路口右拐，你先左拐发现走错了，直接右拐是不对的——你应该回到这个路口再右拐。pType的<|>没问题，因为string是很基础的函数（primitive），失败后会自动恢复之前的状态（回溯）。我们的range函数不是primitive，所以要叠加try函数来达成失败时回溯的功能。^[4]Attoparsec会自动回溯所有parser，但Megaparsec只能自动回溯primitive。

这下就可以看出try range <|> L.decimal是先尝试匹配“x-y”的格式，若成功则保留y，失败则单独匹配一个数字——parse位置的功能到此结束了。但别忘了我们还得继续匹配后面“没用的字符”：三种“的”——也就是<*后面的代码。

pContent

接下来相对简单的子问题是parse标注/笔记的内容。我扫了下我两万多行的My Clippings.txt，发现内容就是一行字。所以可以写出如下代码：

pLine :: Parser Text
pLine = T.pack <$> manyTill anySingle eof

pContent :: Parser Text
pContent = pLine <* (string "==========" <* eol)

manyTill anySingle eof这一句可读性很高：尝试匹配足够多的字符，知道遇到换行符。T.pack的出现是因为我们希望用高性能的Text类型表示字符串，而manyTill anySingle eof返回的是一个装着单个字符的列表。

这个实现很好，但有两个性能问题：我们的输入和输出都是Text，中间却要分配内存开个链表完全是多余的；而且manyTill anySingle eof意味着每匹配一个字符，就要用eof匹配一下，不成功再回溯。虽然说我们要匹配的文本规模是如此之小，以至于没必要关心性能问题，但更好的方法也很简单：

pLine = takeWhileP (Just "a line") (/= '\r') <* eol

takeWhileP的第一个参数是用来生成报错信息的，我们可以不必理会。第二个参数是一个函数，用来控制takeWhileP什么时候停——因为这是一个匹配整行的parser，所以遇到换行符（My Clippings.txt的换行符是"\r\n"，而且可以肯定'\r'不会出现在其他地方）才会停止。takeWhileP返回的直接是Parser Text，没有中间商赚差价。而且相比前面的版本，它会直接匹配一整行，少掉了每匹配一个普通字符都要回溯eof的问题。

这下pContent大概能parse 99%的标注/笔记内容了——等下，为什么还有1%？因为内容部分有极少数可能是多行——这种情况一般出现在写笔记时手动换行的情况：

世界上最简单的会计书 (会计极速入职晋级) (达雷尔·穆利斯)
- 您在第 20 页（位置 #152）的笔记 | 添加于 2022年5月19日星期四 下午8:36:00

Equity
初始投资
净值
是一回事啊
==========

前面已经提到“匹配多个x直到y”的manyTill了，我们可以用它来匹配好几个pLine，然后把[Text]合并成Text。不过，manyTill（和many）类似正则表达式的*：匹配0个也算成功。My Clippings.txt就算没有内容，也会空出来一行，所以我们至少能匹配到一个空行。表达“匹配多个x直到y，并且至少有一个x”的函数，叫someTill。综上，我们可以写出：

pContent = T.intercalate "\n" <$> someTill pLine (string "==========" <* eol)

至此，匹配内容就没问题了。

pUTCTime

比匹配内容稍微繁琐的是匹配时间。其实一般来讲，编程语言的时间库自带parse时间的函数，比如Haskell的parseTimeOrError。不过很少有时间库能parse中文，而My Clippings.txt中用“上午”、“下午”表示12小时制的上下午，所以我们还是得自己动手。

前面的例子已经够多了，可以看到My Clippings.txt中的时间是类似“2022年5月19日星期四 下午8:36:00”的格式。我们可以由此写出：

pUTCTime :: Parser UTCTime
pUTCTime = UTCTime <$> pDay <*> (timeOfDayToTime <$> pTime)

pDay :: Parser Day
pDay = fromGregorian <$> L.decimal <* char '年' <*> L.decimal <* char '月' <*> L.decimal <* takeP (Just "忽略“日星期几 ”") 5

pTime :: Parser TimeOfDay
pTime = TimeOfDay <$> pHour <*> pMinute <*> pSecond
  where
    pHour = (+) <$> (0 <$ string "上午" <|> 12 <$ string "下午") <*> L.decimal <* char ':'
    pMinute = L.decimal <* char ':'
    pSecond = L.decimal <* eol <* eol

其中UTCTime、timeOfDayToTime、fromGregorian和TimeOfDay是时间库中用于组装日期、时间的函数，可以不必理睬。takeP类似takeWhileP，不过把判断停止的函数换成了匹配几个字符就停止的数字。剩下的函数都是前面提过的，而且日期格式本身也很简单，所以不用说明了。

不过，上面的代码有一个问题：“上午12”会被转换成12点，“下午12”会被转换成24点——正确的结果应该是0点和12点。错误的原因在于我直接把“上午”变成了0，“下午”变成了12去和接下来的数字相加。如果接下来的数字是12，应该有特殊处理才对（注意新增的zero12函数）：

pTime = TimeOfDay <$> pHour <*> pMinute <*> pSecond
  where
    pHour = (+) <$> (0 <$ string "上午" <|> 12 <$ string "下午") <*> (zero12 <$> L.decimal) <* char ':'
    zero12 12 = 0 -- 上午12 -> 0，下午12 -> 12
    zero12 x = x
    pMinute = L.decimal <* char ':'
    pSecond = L.decimal <* eol <* eol

如果没有特殊处理，会生成“24点xx时xx分xx秒”的奇怪时间，在格式化输出时会输出一分钟不止六十秒的结果。

pAuthor'

Parse标题和作者是最难的部分：因为标题和作者之间的广告词，以及作者本身格式不统一。在最初写程序时我直接不分割标题、作者，把第一行直接记录成title_author，等其他parser都写完并测试无误了才转过头去写pTitle和pAuthor分别parse标题和作者。

前面介绍的parser都有两项工作：

1. Parse Clipping类型的某个组成部分；
2. 消耗但舍弃掉文本剩下的垃圾字符。

但是对于pTitle来说，判断哪些是垃圾字符需要能够识别作者，而pAuthor中同样需要识别作者的部分。所以我将“parse作者，但不匹配作者后面垃圾字符”的parser单独抽了出来，命名为pAuthor'。

因为作者的格式确实很多，所以先容我列出一些例子：

((德)沃尔夫冈·希弗尔布施)
(［苏］帕斯捷尔纳克)
([巴西] Luciano Ramalho)
([美]詹姆斯·罗姆（James Romm）)
(【日】支仓冻砂)
(诺姆·乔姆斯基(Noam Chomsky))
(赫尔曼·黑塞（Hermann Hesse）)
(彼得•梅尔)
(Drew Neil 尼尔)
……

可以看出，作者名被包在半角括号之间，有些作者名前有任意括号包住的国家名，有些作者名后有任意括号包住的原名。其实还有不符合这种描述的，但82本书里只有两本不符合，所以我就忽略它俩了。

对于可有可无的空格，我们可以用hspace描述；对于可有可无的其他部分，则用optional函数去描述。所以我们可以把上面的作者格式翻译成如下代码：

pAuthor' :: Parser Text
pAuthor' = T.strip <$> (char '(' *> optional nation *> name <* optional origName <* char ')' <* hspace)
  where
    name = takeWhileP (Just "作者名") (\c -> c /= '(' && c /= ')' && c /= '（' && c /= '）')
    nation =
      choice
        [ between' '(' ')',
          between' '（' '）',
          between' '[' ']',
          between' '［' '］',
          between' '【' '】'
        ]
        <* hspace
    between' open close = (char open *> takeWhileP (Just "国籍") (/= close) <* char close) :: Parser Text
    origName = (char '(' *> name <* char ')') <|> char '（' *> name <* char '）'

Megaparsec有负责parse开闭括号之间内容的between，但那个函数并不使用Text类型，所以我写了自己的between'。T.strip是因为有些作者中文名和原名之间有空格，我们需要把空格去掉。

其实我最开始的思路是写一个递归parse所有括号之间内容的parser，但那样描述出的语法不够贴切，所以最后采用了这种比较机械的方法。

pTitle

有了pAuthor'，我们就可以判断哪里是标题和作者之间的广告词：先匹配到半角开括号之前。然后每匹配一个字符都尝试下剩下的字符串能不能匹配上pAuthor' <* eol*（作者紧跟着换行），能就停止，不能就回溯然后继续。

junks =
  takeWhileP (Just "作者前的垃圾话") (/= '(')
    <* manyTill anySingle (try . lookAhead $ pAuthor' <* eol)

这里用try . lookAhead的意思是匹配成功失败与否都不消耗字符串（都会回溯），单独使用try的话成功会消耗字符串，单独使用lookAhead的话失败会报错。另外啊，之所以匹配到半角开括号之后还要继续尝试是不是到作者了，是因为有这么一个广告词以半角开括号开始，全角闭括号结束的例子：

希腊罗马神话(古典学学者写给大众的神话小书，追溯古希腊罗马神话的前世今生。） (菲利普·马蒂塞克)

一般的广告词以各种开括号和全角冒号开头：

从一到无穷大【爱因斯坦亲写推荐语、20世纪的科普经典！《浪潮之巅》、《文明之光》作者吴军博士力荐！】 (乔治·伽莫夫)
Docker实践（异步图书） (伊恩·米尔(Ian Miell))
世界美术名作二十讲：有人通过此书欣赏世界，有人通过此书寻找本心。傅雷经传世之作，打开艺术鉴赏之门。全新修订，彩色典藏版。 (傅雷)

所以我们可以用那些符号做标题的终止符，再配合前面定义的junks，完成parse标题及其后广告词的pTitle：

pTitle :: Parser Text
pTitle = T.strip <$> takeWhile1P (Just "标题") (not . isTitleEndMark) <* junks
  where
    isTitleEndMark c = c == '(' || c == '（' || c == '【' || c == '：'
    junks = takeWhileP (Just "作者前的垃圾话") (/= '(') <* manyTill anySingle (try $ lookAhead $ pAuthor' <* eol)

pAuthor

其实前面的pAuthor'和使用它的pTitle有一个假设：广告词不会被包裹在半角括号之中。但现实否定了该假设，因为有如下反例：

哲人与权臣：尼禄宫廷里的塞内加 (甲骨文系列) ([美]詹姆斯·罗姆（James Romm）)
大师和玛格丽特(译文名著精选) (米·布尔加科夫 (M.Bulgakov))

在经过pTitle之后，留下的是：

(甲骨文系列) ([美]詹姆斯·罗姆（James Romm）)
(译文名著精选) (米·布尔加科夫 (M.Bulgakov))

显然，我们的pAuthor需要使用多次pAuthor'，然后保留最后一次的结果——用some匹配至少一次，用last取列表的最后一项：

pAuthor :: Parser Text
pAuthor = last <$> some pAuthor' <* eol <* takeWhile1P (Just "- 您在位置 #") (/= '#') <* char '#'

pFile

欢呼吧，我的朋友！\^o^/ 因为我们已经可以parse完整的Clipping了！

不过，在结束parser小节之前，我们还差最后一个parser没写——parse整个文件的pFile：

pFile :: Parser [Clipping]
pFile = some pClipping

清理数据

我们的目的是导出Readwise需要的标注和笔记，而My Clippings.txt中还有书签以及内容为“<您已达到本内容的剪贴上限>”的标注。在parse之后，我们需要清理一下，把没用的数据过滤掉：

clean :: [Clipping] -> [Clipping]
clean =
  filter $ \case
    Clipping {type_ = Bookmark} -> False
    Clipping {type_ = Highlight, content = " <您已达到本内容的剪贴上限>"} -> False
    _ -> True

合并笔记和对应标注

前文说过，在Kindle里做笔记时会生成两条位置相同的标注和笔记（两个Clipping，loc相同，但一个type_是Highlight另一个则是Note）。Readwise期望笔记和标注在CSV的同一行，所以我们需要写个函数把它俩合并起来。找出可以合并的标注和笔记需要遍历列表，而遍历列表还可以进行去重。总之，我的思路是：

1. 按照位置、类型和内容长度按升序排序；
2. 遍历列表，每次取两个出来：
   1. 如果位置相同，且类型也相同，留下内容长的（舍弃第一个，把第二个放回列表，继续两两遍历）
   2. 如果位置相同，第二个类型为Note，把两个合成一个同时拥有标注和笔记的ReadwiseRow。
   3. 否则，把第一个转换成没有笔记的ReadwiseRow，把把第二个放回列表，继续两两遍历。

上面几点写成代码就是这样：

type ReadwiseRow = (Text, Text, Text, Maybe Text, Int, Text)

toRows :: [Clipping] -> [ReadwiseRow]
toRows = go . sort
  where
    sort = sortOn (\case Clipping {loc, type_, content} -> (loc, type_, T.length content)) -- 1
    go [] = []
    go [x] = [to x Nothing]
    go (x : xs@(y : ys))
      | eqOn loc x y && eqOn type_ x y = go xs -- 2.1
      | eqOn loc x y && type_ y == Note = to x (Just $ content y) : go ys -- 2.2
      | otherwise = to x Nothing : go xs -- 2.3
    to x = (title x,author x,content x,,loc x,utcToText $ date x)
    eqOn f = (==) `on` f

输出成CSV

如果是简单的数字的话，输出CSV时只需要加逗号即可。但如果标注/笔记里有半角逗号和傻瓜双引号，就需要对它们特殊处理（quote）。我是懒得手动处理了，所以直接用cassava库把元组转成CSV好了。

使用cassava生成CSV，需要实现ToNamedRecord接口，然后调用encodeByName：

instance ToNamedRecord ReadwiseRow where
  toNamedRecord (title, author, highlight, note, loc, date) =
    namedRecord ["Title" .= title, "Author" .= author, "Highlight" .= highlight, "Note" .= note, "Location" .= loc, "Date" .= date]

toCSV = encodeByName (header ["Title", "Author", "Highlight", "Note", "Location", "Date"]) . toRows

这里标题的重复是必须的，因为cassava可以按任意顺序输出每一列。如果不在encodeByName里重新提供标题列表，就要在实现DefaultOrdered接口时重新提供标题列表。规避重复的办法是使用GHC.Generics，不过和我的需求有冲突——我需要大写标题，而Haskell中只有类型名可以大写，record里每一项必须用小写。

完整代码

还有一些main函数、测试代码之类的因为哪个程序都有，所以就不细说了。完整代码我放在GitHub上了。欢迎各位尝试。

Readwise不好用

最后我想说的是，Readwise真不好用，尤其是它的CSV导入页面：你可以上传多个CSV（我喜欢一个CSV放一本书的标注），而且从进度条来看那些文件也确实上传了，但最终只有其中的一个文件会被导入。

好呀，那我们一个文件一个文件上传好了——当你上传第二个文件后，有90%几率会跳到第一个文件的成功页面。此时你要再退回去，用Ctrl-F5彻底刷新页面，再上传。

至于每天随机显示5条标注，确实不错，让我来告诉你一个不用每月掏8美元也能做到的办法：

shuf -n 5 <(cat *.csv)

我本来是去尝试Readwise Reader的，结果发现Reader目前处于基本不可用的状态，所以又退回去尝试他们家的老本行——毕竟我确实烦恼过摘抄或导入标注的难题。结果发现老本行的使用体验也是稀碎。好了，不折腾了。我要回去读书了——直到我们再次相见。