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

Question

Supposing I have the following recursively defined ADT

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

I can define an Parser for this structure (using optparse-applicative, imported as OA), recursively, as follows:

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

This lets me pass arguments such as

• --colour to get a value of Colour
• --nested --colour to get a value of Nested Colour
• --nested --colour to get a value of Nested (Nested Colour)
• and so on

Unfortunately, if I try to generate help text for ths parser, it fails. This makes a degree of sense, because the "structure" of the parser is infinitely large. However, I'm optimistic that there might be a some kind of work around for this, for instance transforming the inner typeParser so that we don't try to generate help text for it.

What's the smallest modification that can be made to this Parser to leave it with working help text?

---

In addition to not being able to generate help text, if I wanted to modify the parser to the following (to add a default, but also allow --nested by itself to parse as Nested Character), this will also hang, as opposed to reaching the default:

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

---

I've already been able to work around the problem, by changing the Parser to the following

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

To specify a value of Nested (Nested Colour) in this parser, you'd pass --nest 2 --colour. This works, but it's not ideal, as I really like the "multiple --nesting arguments" style of command.

Answer 1

It's possible to modify the last parser in the question, to get the "multiple --nesting" style, using many, as follows:

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 outputs a list ([()]) with a length equal to the number of --nested arguments, which can then be used to apply Nested the correct number of times.

This works (unlike the original code) because optparse-applicative has a specialized implementation of many, which doesn't hang.