如何防止递归定义的 optparse-applicative Parser 挂起?

How do I prevent a recursively defined optparse-applicative Parser from hanging?

假设我有以下递归定义的 ADT

data GraphType = Character | Colour | Nested GraphType deriving (Show)

我可以为这个结构定义一个解析器(使用optparse-applicative,导入为OA),递归地,如下:

typeParser :: OA.Parser GraphType
typeParser =
  OA.flag' Colour (OA.long "colour")
    <|> OA.flag' Character (OA.long "character")
    <|> (OA.flag' Nested (OA.long "nested") <*> typeParser)

这让我可以传递参数,例如

不幸的是,如果我尝试为解析器生成帮助文本,它会失败。 这在一定程度上是有道理的,因为解析器的“结构”是无限大的。 但是,我很乐观地认为可能有某种解决方法,例如转换内部 typeParser 这样我们就不会尝试为其生成帮助文本。

可以对该解析器进行哪些最小的修改以使其保留有效的帮助文本?


除了无法生成帮助文本外,如果我想将解析器修改为以下内容(添加默认值,还允许 --nested 自己解析为 Nested Character ),这也会挂起,而不是达到默认值:

typeParser :: OA.Parser GraphType
typeParser =
  OA.flag' Colour (OA.long "colour")
    <|> OA.flag' Character (OA.long "character")
    <|> (OA.flag' Nested (OA.long "nested") <*> typeParser)
    <|> pure Character

我已经能够通过将解析器更改为以下内容来解决该问题

typeParser :: OA.Parser GraphType
typeParser = iter Nested <$> nestDepthParser <*> unnestedParser
  where
    iter f 0 v = v
    iter f n v = iter f (n - 1) (f v)
    nestDepthParser = OA.option OA.auto (OA.long "nest") <|> pure 0
    unnestedParser =
      OA.flag' Colour (OA.long "colour")
        <|> OA.flag' Character (OA.long "character")
        <|> pure Character

要在此解析器中指定值 Nested (Nested Colour),您需要传递 --nest 2 --colour。 这行得通,但并不理想,因为我真的很喜欢命令的“多个 --nesting 参数”风格。

可以修改问题中的最后一个解析器,以获得“多个--nesting”样式,使用many,如下:

typeParser :: OA.Parser GraphType
typeParser = iter Nested <$> nestDepthParser <*> unnestedParser
  where
    iter f 0 v = v
    iter f n v = iter f (n - 1) (f v)
    nestDepthParser = length <$> (many $ OA.flag' () (OA.long "nested"))
    unnestedParser =
      OA.flag' Colour (OA.long "colour")
        <|> OA.flag' Character (OA.long "character")
        <|> pure Character

nestDepthParser 输出一个列表 ([()]),其长度等于 --nested 个参数的数量,然后可用于应用 Nested 正确的数字次。

这有效(与原始代码不同)因为 optparse-applicative 有一个专门的 many 实现,它不会挂起。