{- SPDX-FileCopyrightText: 2018-2019 Serokell <https://serokell.io>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# LANGUAGE ApplicativeDo #-}

module Xrefcheck.CLI
    ( VerifyMode (..)
    , shouldCheckLocal
    , shouldCheckExternal
    , Command (..)
    , Options (..)
    , TraversalOptions (..)
    , addTraversalOptions
    , defaultConfigPaths
    , getCommand
    ) where

import qualified Data.List as L
import Data.Version (showVersion)
import Options.Applicative (Parser, ReadM, command, eitherReader, execParser, flag', footerDoc, fullDesc,
                            help, helper, hsubparser, info, infoOption, long, metavar, option, progDesc,
                            short, strOption, switch, value)
import Options.Applicative.Help.Pretty (Doc, displayS, fill, fillSep, indent, renderPretty, text)

import Paths_xrefcheck (version)
import Xrefcheck.Config
import Xrefcheck.Core

modeReadM :: ReadM VerifyMode
modeReadM :: ReadM VerifyMode
modeReadM = (String -> Either String VerifyMode) -> ReadM VerifyMode
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String VerifyMode) -> ReadM VerifyMode)
-> (String -> Either String VerifyMode) -> ReadM VerifyMode
forall a b. (a -> b) -> a -> b
$ \String
s ->
    case (Element [(String, VerifyMode)] -> Bool)
-> [(String, VerifyMode)] -> Maybe (Element [(String, VerifyMode)])
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s) (String -> Bool)
-> ((String, VerifyMode) -> String) -> (String, VerifyMode) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, VerifyMode) -> String
forall a b. (a, b) -> a
fst) [(String, VerifyMode)]
modes of
        Just (_, mode) -> VerifyMode -> Either String VerifyMode
forall a b. b -> Either a b
Right VerifyMode
mode
        Maybe (Element [(String, VerifyMode)])
Nothing -> String -> Either String VerifyMode
forall a b. a -> Either a b
Left (String -> Either String VerifyMode)
-> ([String] -> String) -> [String] -> Either String VerifyMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> Either String VerifyMode)
-> [String] -> Either String VerifyMode
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n"
            [ String
"Unknown mode " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall b a. (Show a, IsString b) => a -> b
show String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
            , String
"Allowed values: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Monoid a => [a] -> a
mconcat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, VerifyMode) -> String)
-> [(String, VerifyMode)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (String -> String
forall b a. (Show a, IsString b) => a -> b
show (String -> String)
-> ((String, VerifyMode) -> String)
-> (String, VerifyMode)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, VerifyMode) -> String
forall a b. (a, b) -> a
fst) [(String, VerifyMode)]
modes)
            ]
  where
    modes :: [(String, VerifyMode)]
modes =
        [ (String
"local-only", VerifyMode
LocalOnlyMode)
        , (String
"external-only", VerifyMode
ExternalOnlyMode)
        , (String
"full", VerifyMode
FullMode)
        ]

data Command
  = DefaultCommand Options
  | DumpConfig FilePath

data Options = Options
    { Options -> Maybe String
oConfigPath       :: Maybe FilePath
    , Options -> String
oRoot             :: FilePath
    , Options -> VerifyMode
oMode             :: VerifyMode
    , Options -> Bool
oVerbose          :: Bool
    , Options -> Maybe Bool
oShowProgressBar  :: Maybe Bool
    , Options -> TraversalOptions
oTraversalOptions :: TraversalOptions
    }

data TraversalOptions = TraversalOptions
    { TraversalOptions -> [String]
toIgnored :: [FilePath]
    }

addTraversalOptions :: TraversalConfig -> TraversalOptions -> TraversalConfig
addTraversalOptions :: TraversalConfig -> TraversalOptions -> TraversalConfig
addTraversalOptions TraversalConfig{[String]
tcIgnored :: TraversalConfig -> [String]
tcIgnored :: [String]
..} (TraversalOptions [String]
ignored) =
  TraversalConfig :: [String] -> TraversalConfig
TraversalConfig
  { tcIgnored :: [String]
tcIgnored = [String]
tcIgnored [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ignored
  , ..
  }

-- | Where to try to seek configuration if specific path is not set.
defaultConfigPaths :: [FilePath]
defaultConfigPaths :: [String]
defaultConfigPaths = [String
"./xrefcheck.yaml", String
"./.xrefcheck.yaml"]

optionsParser :: Parser Options
optionsParser :: Parser Options
optionsParser = do
    Maybe String
oConfigPath <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$
        Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help (String
"Path to configuration file. \
             \If not specified, tries to read config from one of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
             ([String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map String -> String
forall b a. (Show a, IsString b) => a -> b
show [String]
defaultConfigPaths) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". \
             \If none of these files exist, default configuration is used."
             )
    String
oRoot <- Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
        Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"root" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIRECTORY" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to repository root." Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"."
    VerifyMode
oMode <- ReadM VerifyMode
-> Mod OptionFields VerifyMode -> Parser VerifyMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM VerifyMode
modeReadM (Mod OptionFields VerifyMode -> Parser VerifyMode)
-> Mod OptionFields VerifyMode -> Parser VerifyMode
forall a b. (a -> b) -> a -> b
$
        Char -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm' Mod OptionFields VerifyMode
-> Mod OptionFields VerifyMode -> Mod OptionFields VerifyMode
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"mode" Mod OptionFields VerifyMode
-> Mod OptionFields VerifyMode -> Mod OptionFields VerifyMode
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"KEYWORD" Mod OptionFields VerifyMode
-> Mod OptionFields VerifyMode -> Mod OptionFields VerifyMode
forall a. Semigroup a => a -> a -> a
<>
        VerifyMode -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value VerifyMode
FullMode Mod OptionFields VerifyMode
-> Mod OptionFields VerifyMode -> Mod OptionFields VerifyMode
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. String -> Mod f a
help String
"Which parts of verification to invoke. \
             \You can enable only verification of repository-local references, \
             \only verification of external references or both. \
             \Default mode: full."
    Bool
oVerbose <- Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
        Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbose" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Report repository scan and verification details."
    Maybe Bool
oShowProgressBar <- [Parser (Maybe Bool)] -> Parser (Maybe Bool)
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
        [ Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool))
-> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"progress" Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<>
            String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Display progress bar during verification. \
                 \This is enabled by default unless `CI` env var is set to true."
        , Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) (Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool))
-> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-progress" Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<>
            String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Do not display progress bar during verification."
        , Maybe Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
        ]
    TraversalOptions
oTraversalOptions <- Parser TraversalOptions
traversalOptionsParser
    return Options :: Maybe String
-> String
-> VerifyMode
-> Bool
-> Maybe Bool
-> TraversalOptions
-> Options
Options{Bool
String
Maybe Bool
Maybe String
VerifyMode
TraversalOptions
oTraversalOptions :: TraversalOptions
oShowProgressBar :: Maybe Bool
oVerbose :: Bool
oMode :: VerifyMode
oRoot :: String
oConfigPath :: Maybe String
oTraversalOptions :: TraversalOptions
oShowProgressBar :: Maybe Bool
oVerbose :: Bool
oMode :: VerifyMode
oRoot :: String
oConfigPath :: Maybe String
..}

traversalOptionsParser :: Parser TraversalOptions
traversalOptionsParser :: Parser TraversalOptions
traversalOptionsParser = do
    [String]
toIgnored <- Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser String -> Parser [String])
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser [String])
-> Mod OptionFields String -> Parser [String]
forall a b. (a -> b) -> a -> b
$
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ignored" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Files and folders which we pretend do not exist."
    return TraversalOptions :: [String] -> TraversalOptions
TraversalOptions{[String]
toIgnored :: [String]
toIgnored :: [String]
..}

dumpConfigOptions :: Parser FilePath
dumpConfigOptions :: Parser String
dumpConfigOptions = Mod CommandFields String -> Parser String
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields String -> Parser String)
-> Mod CommandFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
  String -> ParserInfo String -> Mod CommandFields String
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"dump-config" (ParserInfo String -> Mod CommandFields String)
-> ParserInfo String -> Mod CommandFields String
forall a b. (a -> b) -> a -> b
$
    Parser String -> InfoMod String -> ParserInfo String
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser String
parser (InfoMod String -> ParserInfo String)
-> InfoMod String -> ParserInfo String
forall a b. (a -> b) -> a -> b
$
    String -> InfoMod String
forall a. String -> InfoMod a
progDesc String
"Dump default configuration into a file."
  where
    parser :: Parser String
parser = Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
      Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
".xrefcheck.yaml" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Name of created config file."

totalParser :: Parser Command
totalParser :: Parser Command
totalParser = [Parser Command] -> Parser Command
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
  [ Options -> Command
DefaultCommand (Options -> Command) -> Parser Options -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Options
optionsParser
  , String -> Command
DumpConfig (String -> Command) -> Parser String -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
dumpConfigOptions
  ]

versionOption :: Parser (a -> a)
versionOption :: Parser (a -> a)
versionOption = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (String
"xrefcheck-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version) (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$
    String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version."

getCommand :: IO Command
getCommand :: IO Command
getCommand = do
    ParserInfo Command -> IO Command
forall a. ParserInfo a -> IO a
execParser (ParserInfo Command -> IO Command)
-> ParserInfo Command -> IO Command
forall a b. (a -> b) -> a -> b
$
        Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ((Command -> Command) -> Command -> Command)
forall a. Parser (a -> a)
helper Parser ((Command -> Command) -> Command -> Command)
-> Parser (Command -> Command) -> Parser (Command -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Command -> Command)
forall a. Parser (a -> a)
versionOption Parser (Command -> Command) -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
totalParser) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$
        InfoMod Command
forall a. InfoMod a
fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<>
        String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Cross-references verifier for markdown documentation in \
                 \Git repositories." InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<>
        (Maybe Doc -> InfoMod Command
forall a. Maybe Doc -> InfoMod a
footerDoc (Maybe Doc -> InfoMod Command) -> Maybe Doc -> InfoMod Command
forall a b. (a -> b) -> a -> b
$ Doc -> Maybe Doc
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
ignoreModesMsg)

ignoreModesMsg :: Doc
ignoreModesMsg :: Doc
ignoreModesMsg = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
header String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
body
    where
        header :: String
header = String
"To ignore a link in your markdown, \
                 \include \"<!-- xrefcheck: ignore <mode> -->\"\n\
                 \comment with one of these modes:\n"
        body :: String
body = SimpleDoc -> String -> String
displayS (Float -> Int -> Doc -> SimpleDoc
renderPretty Float
pageParam Int
pageWidth Doc
doc) String
""

        pageWidth :: Int
pageWidth = Int
80
        pageParam :: Float
pageParam = Float
1

        doc :: Doc
doc = [Doc] -> Doc
fillSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((String, [String]) -> Doc) -> [(String, [String])] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (String, [String]) -> Doc
formatDesc [(String, [String])]
modeDescr

        modeDescr :: [(String, [String])]
modeDescr =
            [ (String
"  \"link\"",      String -> [String]
L.words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"Ignore the link right after the comment.")
            , (String
"  \"paragraph\"", String -> [String]
L.words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"Ignore the whole paragraph after the comment.")
            , (String
"  \"file\"",      String -> [String]
L.words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"This mode can only be used at the top of markdown \
                                            \or right after comments at the top.")
            ]

        modeIndent :: Int
modeIndent = String -> Int
forall t. Container t => t -> Int
length (String
"\"paragraph\"" :: String) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        descrIndent :: Int
descrIndent = Int
27 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
modeIndent

        formatDesc :: (String, [String]) -> Doc
formatDesc (String
mode, [String]
descr) =
            (Int -> Doc -> Doc
fill Int
modeIndent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
mode) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
            (Int -> Doc -> Doc
indent Int
descrIndent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fillSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map String -> Doc
text [String]
descr)