Haskell如何改造group函数实现相邻不同元素拼接分组

Data.List模块的group函数会将列表中相邻的相同元素分组，示例输入：

import Data.List(group)
group "mississippi time"

运行输出为：

["m","i","ss","i","ss","i","pp","i"," ","t","i","m","e"]

需要改造分组逻辑：保留所有长度大于1的连续相同元素块，将所有相邻的长度为1的元素块拼接为一组，期望输出如下：

["mi","ss","i","ss","i","pp","i time"]

原有实现分两步：先通过groupSame完成相邻相同元素分组，再通过groupDiff拼接相邻单元素，代码如下：

-- |
-- >>> groupSame "mississippi time"
-- ["m","i","ss","i","ss","i","pp","i"," ","t","i","m","e"]
groupSame :: String -> [String]
groupSame [] = []
groupSame (x:xs) = (x : takeWhile (== x) xs) : groupSame (dropWhile (== x) xs)

-- >>> groupDiff ["m","i","ss","i","ss","i","pp","i"," ","t","i","m","e"]
-- ["mi","ss","i","ss","i","pp","i time"]
groupDiff :: [String] -> [String]
groupDiff [] = []
groupDiff [x] = [x]
groupDiff (x:y:xs)
 |length x > 1 && length y > 1 =  x:y : groupDiff xs 
 |length x > 1 && length y ==1 =  x: groupDiff (y:xs)
 |length x ==1 && length y > 1 =  x:y: groupDiff xs
 |length x ==1 && length y ==1 =  (x++y): groupDiff xs

上述代码实际运行输出不符合预期，实际结果为：

["mi","ss","i","ss","i","pp","i"," t","im","e"]

原groupDiff的递归逻辑有本质缺陷：采用逐对匹配的方式处理列表，遇到两个相邻单元素时，仅拼接这两个元素就直接存入结果列表，没有继续判断后续元素是否也是需要拼接的单元素，导致连续3个及以上的单元素块会被错误拆分，无法把所有相邻单元素拼成完整的一组。

核心思路是增加一个累积缓冲区，存储当前正在拼接的单元素串，遍历分组后的列表：

• 如果遇到长度大于1的块：先把缓冲区中已经累积的单元素串存入结果，再存入当前长块，清空缓冲区
• 如果遇到长度为1的块：直接把块内容拼接到缓冲区末尾
• 遍历完成后，如果缓冲区还有内容，就把剩余内容存入结果

修正后的代码如下：

groupDiff :: [String] -> [String]
groupDiff = go []
  where
    go acc [] = [acc | not (null acc)]
    go acc (s:ss)
      | length s > 1 =
          let prefix = if null acc then [] else [acc]
          in prefix ++ [s] ++ go [] ss
      | otherwise = go (acc ++ s) ss

-- 组合为最终调用函数，groupSame与原生group功能完全一致，可直接替换为导入的group
customGroup :: String -> [String]
customGroup = groupDiff . groupSame

运行测试customGroup "mississippi time"，即可得到期望输出["mi","ss","i","ss","i","pp","i time"]。

内容的提问来源于stack exchange，提问作者CN_Cabbage