1  {-# LANGUAGE OverloadedStrings #-}
  2  {-# LANGUAGE RecordWildCards #-}
  3  
  4  {- | Parser for clap (Rust) -h/--help output
  5  
  6  Clap is the most common CLI library in the Rust ecosystem, used by:
  7    ripgrep, fd, bat, hyperfine, tokei, dust, exa
  8    cloud-hypervisor, mdbook, nixdoc, ndg, deadnix, statix
  9    ruff, biome, stylua, taplo
 10  
 11  Works best with short help (-h), handles:
 12    -s, --long=VALUE    Description
 13    --long <value>      Description
 14    -x                  Short only
 15  -}
 16  module Main where
 17  
 18  import Control.Monad (void)
 19  import Data.Maybe (catMaybes)
 20  import Data.Text (Text)
 21  import qualified Data.Text as T
 22  import qualified Data.Text.IO as TIO
 23  import Data.Void
 24  import System.Environment (getArgs)
 25  import Text.Megaparsec
 26  import Text.Megaparsec.Char hiding (hspace, hspace1)
 27  
 28  type Parser = Parsec Void Text
 29  
 30  -- | A CLI option/flag
 31  data ClapOption = ClapOption
 32      { optShort :: Maybe Char
 33      , optLong :: Maybe Text
 34      , optArg :: Maybe Text
 35      , optDesc :: Text
 36      }
 37      deriving (Show, Eq)
 38  
 39  -- | A section of options
 40  data ClapSection = ClapSection
 41      { secName :: Text
 42      , secOptions :: [ClapOption]
 43      }
 44      deriving (Show, Eq)
 45  
 46  -- | Full parsed help
 47  data ClapHelp = ClapHelp
 48      { helpSections :: [ClapSection]
 49      }
 50      deriving (Show, Eq)
 51  
 52  -- Horizontal whitespace
 53  hspace :: Parser ()
 54  hspace = void $ takeWhileP Nothing (\c -> c == ' ' || c == '\t')
 55  
 56  -- Rest of line
 57  restOfLine :: Parser Text
 58  restOfLine = do
 59      content <- takeWhileP Nothing (/= '\n')
 60      void (char '\n') <|> eof
 61      return content
 62  
 63  -- Parse short option: -x or -.
 64  shortOpt :: Parser Char
 65  shortOpt = char '-' *> (letterChar <|> digitChar <|> char '.')
 66  
 67  -- Parse long option: --name
 68  longOpt :: Parser Text
 69  longOpt = string "--" *> takeWhile1P Nothing isOptChar
 70    where
 71      isOptChar c = c == '-' || c == '_' || c `elem` ['a' .. 'z'] || c `elem` ['A' .. 'Z'] || c `elem` ['0' .. '9']
 72  
 73  -- Parse argument: =VAL or <val> or space <val>
 74  argPlaceholder :: Parser Text
 75  argPlaceholder =
 76      choice
 77          [ char '=' *> takeWhile1P Nothing (\c -> c /= ' ' && c /= '\t' && c /= '\n')
 78          , try $ hspace *> char '<' *> takeWhile1P Nothing (/= '>') <* char '>'
 79          , char '[' *> (char '=' *> takeWhile1P Nothing (\c -> c /= ']' && c /= '\n')) <* char ']' -- [=val]
 80          ]
 81  
 82  -- Parse one option line
 83  optionLine :: Parser ClapOption
 84  optionLine = do
 85      hspace
 86      -- Short option
 87      mShort <- optional $ try (shortOpt <* optional (string ", "))
 88      -- Long option
 89      mLong <- optional $ try longOpt
 90      -- Argument
 91      mArg <- optional $ try argPlaceholder
 92      -- Description (rest of line)
 93      hspace
 94      desc <- restOfLine
 95      -- Must have at least short or long
 96      case (mShort, mLong) of
 97          (Nothing, Nothing) -> empty
 98          _ ->
 99              return
100                  ClapOption
101                      { optShort = mShort
102                      , optLong = mLong
103                      , optArg = mArg
104                      , optDesc = T.strip desc
105                      }
106  
107  -- Check if line looks like section header (ends with :, not indented, not an option)
108  isSectionLine :: Text -> Bool
109  isSectionLine t =
110      let stripped = T.strip t
111       in not (T.null stripped)
112              && T.last stripped == ':'
113              && not (T.isPrefixOf "-" stripped)
114              && not (T.isPrefixOf " " t) -- not indented
115              && not (T.isInfixOf "://" stripped) -- not a URL
116  
117  -- Parse all content, extracting sections
118  parseHelp :: Text -> ClapHelp
119  parseHelp input = ClapHelp{helpSections = go [] Nothing (T.lines input)}
120    where
121      go acc _curSec [] =
122          case _curSec of
123              Just (name, opts) -> reverse (ClapSection name (reverse opts) : acc)
124              Nothing -> reverse acc
125      go acc curSec (line : rest)
126          | isSectionLine line =
127              let secName = T.dropEnd 1 (T.strip line)
128                  acc' = case curSec of
129                      Just (name, opts) -> ClapSection name (reverse opts) : acc
130                      Nothing -> acc
131               in go acc' (Just (secName, [])) rest
132          | Just (name, opts) <- curSec =
133              case parse optionLine "" (line <> "\n") of
134                  Right opt -> go acc (Just (name, opt : opts)) rest
135                  Left _ ->
136                      -- Skip blank lines and continuation lines (indented)
137                      if T.null (T.strip line) || T.isPrefixOf "  " line
138                          then go acc curSec rest
139                          else go (ClapSection name (reverse opts) : acc) Nothing rest
140          | otherwise = go acc curSec rest
141  
142  -- Pretty print
143  ppClapHelp :: ClapHelp -> Text
144  ppClapHelp ClapHelp{..} = T.unlines $ concatMap ppSection helpSections
145    where
146      ppSection ClapSection{..} =
147          [secName <> ":"] ++ map ppOpt secOptions ++ [""]
148      ppOpt ClapOption{..} =
149          let short = maybe "" (\c -> "-" <> T.singleton c) optShort
150              long = maybe "" ("--" <>) optLong
151              arg = maybe "" (\a -> "=" <> a) optArg
152              flags = T.intercalate ", " $ filter (not . T.null) [short, long <> arg]
153           in "  " <> flags <> ": " <> optDesc
154  
155  main :: IO ()
156  main = do
157      args <- getArgs
158      input <- case args of
159          [] -> TIO.getContents
160          [f] -> TIO.readFile f
161          _ -> error "Usage: clap-parser [FILE]"
162      let help = parseHelp input
163          total = sum $ map (length . secOptions) (helpSections help)
164      TIO.putStr $ ppClapHelp help
165      putStrLn $
166          "Parsed "
167              ++ show total
168              ++ " options in "
169              ++ show (length (helpSections help))
170              ++ " sections"