Synopsis.hs

{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- | <https://mandoc.bsd.lv/mdoc/style/options.html>
module Mdoc.Gen.Synopsis
  ( man1Synopsis
  , man5Synopsis
  ) where

import Mdoc.Prelude

import Data.Char (toLower)
import Data.List (sortOn)
import Mdoc.Gen.Argument
import Mdoc.Gen.Described
import Mdoc.Gen.File
import Mdoc.Gen.Flag
import Mdoc.Gen.Man1
import Mdoc.Gen.Man5
import Mdoc.Gen.Name
import Mdoc.Gen.Option
import Mdoc.Gen.Optionality
import Mdoc.MacroArg
import Mdoc.MacroName
import Mdoc.MdocLine

man1Synopsis :: Man1 -> NonEmpty MdocLine
man1Synopsis m =
  MacroLine Nm [Bare $ esc $ pack $ m.name.primary]
    :| concat
      [ [MacroLine Bk ["-words"]]
      , maybe [] (pure . shortsLine) $ shortSwitchChars m.switches
      , mapMaybe shortOptionLine m.options
      , map snd
          $ sortOn fst
          $ mapMaybe longSwitchLine m.switches
          <> mapMaybe longOptionLine m.options
      , map argLine m.arguments
      , [MacroLine Ek []]
      ]

shortsLine :: NonEmpty Char -> MdocLine
shortsLine cs = MacroLine Op [Callable Fl, Bare $ esc $ pack $ toList cs]

man5Synopsis :: Man5 -> NonEmpty MdocLine
man5Synopsis m = renderFilesCompact m.files

shortSwitchChars :: [Described Flag] -> Maybe (NonEmpty Char)
shortSwitchChars = nonEmpty . sortOn toLower . mapMaybe (\d -> withShort d.item id)

shortOptionLine :: Described Option -> Maybe MdocLine
shortOptionLine d = withShort d.item.flag $ \c ->
  opLine Fl (renderShort c $ Just d.item.argument) d.optionality

longSwitchLine :: Described Flag -> Maybe (String, MdocLine)
longSwitchLine d = withLong d.item $ \s ->
  (s, opLine Fl (renderLong s Nothing) d.optionality)

longOptionLine :: Described Option -> Maybe (String, MdocLine)
longOptionLine d = withLong d.item.flag $ \s ->
  (s, opLine Fl (renderLong s $ Just d.item.argument) d.optionality)

argLine :: Described Argument -> MdocLine
argLine d = opLine Ar margs d.optionality
 where
  margs
    | d.multiple = [Bare $ esc $ pack d.item.schema, "..."]
    | otherwise = [Bare $ esc $ pack d.item.schema]

withShort :: Flag -> (Char -> a) -> Maybe a
withShort flag f = case flag of
  Flag c _ -> Just $ f c
  _ -> Nothing

withLong :: Flag -> (String -> a) -> Maybe a
withLong flag f = case flag of
  GNUFlag s _ -> Just $ f s
  _ -> Nothing