diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +## [_Unreleased_](https://github.com/pbrisbin/ronn/compare/v1.0.0.0...main) + +## [v1.0.0.0](https://github.com/pbrisbin/ronn/tree/v1.0.0.0) + +First tagged pre-release. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,93 @@ +## Ronn + +[![Hackage](https://img.shields.io/hackage/v/ronn.svg?style=flat)](https://hackage.haskell.org/package/ronn) +[![Stackage Nightly](http://stackage.org/package/ronn/badge/nightly)](http://stackage.org/nightly/package/ronn) +[![Stackage LTS](http://stackage.org/package/ronn/badge/lts)](http://stackage.org/lts/package/ronn) +[![CI](https://github.com/pbrisbin/ronn/actions/workflows/ci.yml/badge.svg)](https://github.com/pbrisbin/ronn/actions/workflows/ci.yml) + +Describe and render Ronn documentation. + +## Why Ronn? + +Ronn is a [markdown-like format][ronn-format.7] for describing man-pages. Files +written in Ronn can be viewed as markdown (e.g. rendered on GitHub), or +converted to Roff or HTML using the `ronn` command-line. + +[ronn-format.7]: https://github.com/apjanke/ronn-ng/blob/main/man/ronn-format.7.ronn + +There are _many_ ways to author or produce man-pages in Roff and HTML formats +from a single source, but Ronn produces *by far* the highest-quality outputs +from the simplest source. Tools like `man2html` or even Pandoc often produce +sub-standard output in certain cases, or lack features such as cross-references. + +Here is some example Ronn: + +```ronn +ronn(1) -- example ronn man-page +================================ + +## SYNOPSIS + +`ronn` [options] + +## DESCRIPTION + +This is an example man-page to show how rendering the AST Looks + +## OPTIONS + + * `-h`, `--help`: + Display this help + + * `-o`, `--output`=: + Output to `FILE` + +## ENVIRONMENT + + * `HOME`: + User's HOME directory + + Some further details: + + * foo: + The foo + + * bar: + The bar + +## SEE ALSO + +**markdown(7)**, **roff(7)** +``` + +Here is it rendered to Roff and opened with `man`: + +![](./examples/roff.png) + +And here it is rendered to HTML: + +![](./examples/html.png) + +This package contains the `Ronn` AST type and a rendering function. Companion +packages are planned to automatically convert any `optparse-applicative`, +`envparse`, or `opt-env-conf` `Parser` type into a `Ronn` value. This will allow +any application using one of these libraries to maintain high-quality man-pages +automatically. + +## Usage + +For an example of building an AST by hand, and what the rendered `Text` looks +like, see the [test suite](./tests/Ronn/RenderSpec.hs) + +Once you've created a `.ronn` file from the rendered `Text`, you can use the +[`ronn-ng`][ronn-ng] gem produce a high-quality man-page and HTML: + +```console +% ronn --style toc --roff --html path/*.ronn +``` + +[ronn-ng]: https://github.com/apjanke/ronn-ng + +--- + +[LICENSE](./LICENSE) | [CHANGELOG](./CHANGELOG.md) diff --git a/ronn.cabal b/ronn.cabal new file mode 100644 --- /dev/null +++ b/ronn.cabal @@ -0,0 +1,85 @@ +cabal-version: 1.18 +name: ronn +version: 1.0.0.0 +license: AGPL-3 +maintainer: Pat Brisbin +homepage: https://github.com/pbrisbin/ronn#readme +bug-reports: https://github.com/pbrisbin/ronn/issues +synopsis: Describe and render Ronn documentation +description: Please see README.md +category: Documentation +build-type: Simple +extra-doc-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/pbrisbin/ronn + +library + exposed-modules: + Ronn + Ronn.Argument + Ronn.AST + Ronn.Env + Ronn.Opt + Ronn.Render + + hs-source-dirs: src + other-modules: Paths_ronn + default-language: GHC2021 + default-extensions: + DataKinds DeriveAnyClass DerivingStrategies DerivingVia + DuplicateRecordFields GADTs LambdaCase NoFieldSelectors + NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot + OverloadedStrings RecordWildCards TypeFamilies + + ghc-options: + -fignore-optim-changes -fwrite-ide-info -Weverything + -Wno-all-missed-specialisations -Wno-missing-exported-signatures + -Wno-missing-import-lists -Wno-missing-kind-signatures + -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode + -Wno-monomorphism-restriction -Wno-prepositive-qualified-module + -Wno-safe -Wno-unsafe + + build-depends: + base >=4.16.4.0 && <5, + text >=1.2.5.0 + + if impl(ghc >=9.8) + ghc-options: + -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests + other-modules: + Ronn.RenderSpec + Paths_ronn + + default-language: GHC2021 + default-extensions: + DataKinds DeriveAnyClass DerivingStrategies DerivingVia + DuplicateRecordFields GADTs LambdaCase NoFieldSelectors + NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot + OverloadedStrings RecordWildCards TypeFamilies + + ghc-options: + -fignore-optim-changes -fwrite-ide-info -Weverything + -Wno-all-missed-specialisations -Wno-missing-exported-signatures + -Wno-missing-import-lists -Wno-missing-kind-signatures + -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode + -Wno-monomorphism-restriction -Wno-prepositive-qualified-module + -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N + + build-depends: + base >=4.16.4.0 && <5, + hspec >=2.9.7, + ronn, + text >=1.2.5.0 + + if impl(ghc >=9.8) + ghc-options: + -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures diff --git a/src/Ronn.hs b/src/Ronn.hs new file mode 100644 --- /dev/null +++ b/src/Ronn.hs @@ -0,0 +1,17 @@ +-- | +-- +-- Module : Ronn +-- Copyright : (c) 2024 Patrick Brisbin +-- License : AGPL-3 +-- Maintainer : pbrisbin@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Ronn + ( module X + ) +where + +import Ronn.AST as X +import Ronn.Env as X +import Ronn.Opt as X +import Ronn.Render as X diff --git a/src/Ronn/AST.hs b/src/Ronn/AST.hs new file mode 100644 --- /dev/null +++ b/src/Ronn/AST.hs @@ -0,0 +1,113 @@ +-- | +-- +-- Module : Ronn.AST +-- Copyright : (c) 2024 Patrick Brisbin +-- License : AGPL-3 +-- Maintainer : pbrisbin@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Ronn.AST + ( Ronn (..) + , RonnSection (..) + , RonnContent (..) + , RonnDefinition (..) + , RonnGroup (..) + , RonnLine (..) + , RonnPart (..) + + -- * References + , ManRef (..) + , ManSection (..) + , manSectionNumber + ) where + +import Prelude + +import Data.String (IsString (..)) +import Data.Text (Text, pack) + +data Ronn = Ronn + { name :: ManRef + , description :: [RonnPart] + , sections :: [RonnSection] + } + +data RonnSection = RonnSection + { name :: Text + , content :: [RonnContent] + } + +data RonnContent + = RonnDefinitions [RonnDefinition] + | RonnGroups [RonnGroup] + +instance IsString RonnContent where + fromString = RonnGroups . pure . fromString + +data RonnDefinition = RonnDefinition + { name :: RonnPart + , description :: RonnLine + -- ^ A line of nested description is required + , content :: Maybe [RonnContent] + -- ^ More content can be optionally nested + } + +data RonnGroup + = RonnTitle ManRef [RonnPart] + | RonnHeader Text + | RonnLines [RonnLine] + +instance IsString RonnGroup where + fromString = RonnLines . pure . fromString + +newtype RonnLine = RonnLine + { unwrap :: [RonnPart] + } + +instance IsString RonnLine where + fromString = RonnLine . pure . fromString + +data RonnPart + = -- | 'RonnConcat' joins 'RonnPart's without automaticaly inserting a space + -- + -- The following expressions are equivalent: + -- + -- - @'ronnLineToText' $ 'RonnLine' [p1, p2]@ + -- - @'ronnLineToText' $ 'RonnLine' ['RonnConcat' [p1, " ", p2]]@ + -- - @'ronnLineToText' $ 'RonnLine' [p1 <> " " <> p2]@ + -- + -- Using the 'Semigroup' instance should be preferred, in case the AST + -- changes in the future. + RonnConcat [RonnPart] + | RonnCode RonnPart + | RonnUserInput RonnPart + | RonnStrong RonnPart + | RonnVariable RonnPart + | RonnEphasis RonnPart + | RonnBrackets RonnPart + | RonnParens RonnPart + | RonnRef ManRef + | RonnRaw Text + +instance IsString RonnPart where + fromString = RonnRaw . pack + +instance Semigroup RonnPart where + RonnConcat as <> RonnConcat bs = RonnConcat $ as <> bs + RonnConcat as <> b = RonnConcat $ as <> [b] + a <> RonnConcat bs = RonnConcat $ a : bs + a <> b = RonnConcat [a, b] + +instance Monoid RonnPart where + mempty = RonnConcat [] + +data ManRef = ManRef + { name :: Text + , section :: ManSection + } + +-- TODO: enum? +newtype ManSection = ManSection Int + +manSectionNumber :: ManSection -> Int +manSectionNumber (ManSection n) = n diff --git a/src/Ronn/Argument.hs b/src/Ronn/Argument.hs new file mode 100644 --- /dev/null +++ b/src/Ronn/Argument.hs @@ -0,0 +1,27 @@ +-- | +-- +-- Module : Ronn.Argument +-- Copyright : (c) 2024 Patrick Brisbin +-- License : AGPL-3 +-- Maintainer : pbrisbin@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Ronn.Argument + ( HasArgument (..) + , addArgument + ) +where + +import Prelude + +import Data.String (IsString (..)) +import Data.Text (Text) +import Ronn.AST + +class HasArgument a where + getArgument :: a -> Maybe String + +addArgument :: HasArgument a => Text -> a -> RonnPart -> RonnPart +addArgument sep a p = case getArgument a of + Nothing -> p + Just arg -> mconcat [p, RonnRaw sep, RonnVariable $ fromString arg] diff --git a/src/Ronn/Env.hs b/src/Ronn/Env.hs new file mode 100644 --- /dev/null +++ b/src/Ronn/Env.hs @@ -0,0 +1,50 @@ +-- | +-- +-- Module : Ronn.Env +-- Copyright : (c) 2024 Patrick Brisbin +-- License : AGPL-3 +-- Maintainer : pbrisbin@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Ronn.Env + ( Env (..) + , envToDefinition + , environmentSection + ) where + +import Prelude + +import Data.List (intersperse) +import Data.Maybe (fromMaybe) +import Data.String (IsString (..)) +import Ronn.AST +import Ronn.Argument + +data Env = Env + { vars :: [String] + , argument :: Maybe String + , default_ :: Maybe String + , help :: Maybe RonnLine + } + +instance HasArgument Env where + getArgument = (.argument) + +envToDefinition :: Env -> RonnDefinition +envToDefinition env = + RonnDefinition + { name = + addArgument "=" env $ + RonnConcat $ + intersperse "|" $ + map (RonnCode . fromString) env.vars + , description = fromMaybe (RonnLine []) env.help + , content = Nothing + } + +environmentSection :: [Env] -> RonnSection +environmentSection envs = + RonnSection + { name = "ENVIRONMENT" + , content = [RonnDefinitions $ map envToDefinition envs] + } diff --git a/src/Ronn/Opt.hs b/src/Ronn/Opt.hs new file mode 100644 --- /dev/null +++ b/src/Ronn/Opt.hs @@ -0,0 +1,105 @@ +-- | +-- +-- Module : Ronn.Opt +-- Copyright : (c) 2024 Patrick Brisbin +-- License : AGPL-3 +-- Maintainer : pbrisbin@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Ronn.Opt + ( Opts (..) + , optsToDefinitions + , Opt (..) + , optToDefinition + , optionsSection + , synopsisSection + , synopsisLine + ) where + +import Prelude + +import Data.List (intersperse) +import Data.Maybe (fromMaybe, isJust) +import Data.String (IsString (..)) +import Ronn.AST +import Ronn.Argument + +data Opts + = OptsOr Opts + | OptsAnd Opts + | OptsMany [Opts] + | OptsOne Opt + +optsToDefinitions :: Opts -> [RonnDefinition] +optsToDefinitions = \case + OptsOr opts -> optsToDefinitions opts + OptsAnd opts -> optsToDefinitions opts + OptsMany opts -> concatMap optsToDefinitions opts + OptsOne opts -> [optToDefinition opts] + +data Opt = Opt + { shorts :: [Char] + , longs :: [String] + , argument :: Maybe String + , default_ :: Maybe String + , help :: Maybe RonnLine + } + +instance HasArgument Opt where + getArgument = (.argument) + +optToDefinition :: Opt -> RonnDefinition +optToDefinition opt = + RonnDefinition + { name = mconcat $ intersperse ", " $ optParts opt + , description = fromMaybe (RonnLine []) opt.help + , content = Nothing + } + +optionsSection :: Opts -> RonnSection +optionsSection opts = + RonnSection + { name = "OPTIONS" + , content = [RonnDefinitions $ optsToDefinitions opts] + } + +synopsisSection + :: String + -- ^ Program name + -> Opts + -> RonnSection +synopsisSection name opts = + RonnSection + { name = "SYNOPSIS" + , content = [RonnGroups [RonnLines [synopsisLine name opts]]] + } + +synopsisLine :: String -> Opts -> RonnLine +synopsisLine name = RonnLine . (RonnCode (fromString name) :) . go + where + go :: Opts -> [RonnPart] + go = \case + OptsOr os -> [RonnBrackets $ mconcat $ intersperse " \\| " $ go os] + OptsAnd os -> [RonnParens $ mconcat $ intersperse " " $ go os] + OptsMany os -> concatMap go os + OptsOne opt -> map (bracketize opt) $ optParts opt + + bracketize :: Opt -> RonnPart -> RonnPart + bracketize opt + | isJust opt.default_ = RonnBrackets + | otherwise = id + +optParts :: Opt -> [RonnPart] +optParts opt + | null opt.shorts && null opt.longs + , Just arg <- opt.argument = + [RonnVariable $ fromString arg] + | otherwise = + map (addArgument " " opt . short) opt.shorts + <> map (addArgument "=" opt . long) opt.longs + where + short :: Char -> RonnPart + short = RonnCode . fromString . ('-' :) . pure + + long :: String -> RonnPart + long = RonnCode . fromString . ("--" <>) diff --git a/src/Ronn/Render.hs b/src/Ronn/Render.hs new file mode 100644 --- /dev/null +++ b/src/Ronn/Render.hs @@ -0,0 +1,103 @@ +-- | +-- +-- Module : Ronn.Render +-- Copyright : (c) 2024 Patrick Brisbin +-- License : AGPL-3 +-- Maintainer : pbrisbin@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Ronn.Render + ( ronnToText + ) where + +import Prelude + +import Data.Text (Text, pack) +import Data.Text qualified as T +import Ronn.AST + +ronnToText :: Ronn -> Text +ronnToText ronn = + T.unlines $ + map ronnGroupToText $ + RonnTitle ronn.name ronn.description + : concatMap ronnSectionToGroups ronn.sections + +ronnSectionToGroups :: RonnSection -> [RonnGroup] +ronnSectionToGroups section = + RonnHeader section.name : concatMap (ronnContentToGroups 0) section.content + +ronnContentToGroups :: Int -> RonnContent -> [RonnGroup] +ronnContentToGroups indentLevel = \case + RonnDefinitions defns -> + concatMap (ronnDefinitionToGroups $ indentLevel + 2) defns + RonnGroups gs -> map (indentRonnGroup indentLevel) gs + +ronnDefinitionToGroups :: Int -> RonnDefinition -> [RonnGroup] +ronnDefinitionToGroups indentLevel defn = + [ RonnLines + [ indentRonnLine indentLevel $ RonnLine ["* " <> defn.name <> ":"] + , indentRonnLine nextIndentLevel defn.description + ] + ] + <> nested + where + nested = maybe [] (concatMap $ ronnContentToGroups nextIndentLevel) defn.content + nextIndentLevel = indentLevel + 2 + +ronnGroupToText :: RonnGroup -> Text +ronnGroupToText = T.unlines . map ronnLineToText . ronnGroupToLines + +ronnGroupToLines :: RonnGroup -> [RonnLine] +ronnGroupToLines = \case + RonnTitle ref description -> + let nameLine = ronnNameLine ref description + in [ nameLine + , RonnLine [RonnRaw $ T.replicate (ronnLineLength nameLine) "="] + ] + RonnHeader name -> [RonnLine ["##", RonnRaw name]] + RonnLines ls -> ls + +ronnNameLine :: ManRef -> [RonnPart] -> RonnLine +ronnNameLine ref = + RonnLine . (RonnRaw (manRefToText ref) :) . ("--" :) + +ronnLineToText :: RonnLine -> Text +ronnLineToText = T.unwords . map ronnPartToText . (.unwrap) + +ronnPartToText :: RonnPart -> Text +ronnPartToText = \case + RonnConcat xs -> mconcat $ map ronnPartToText xs + RonnCode x -> "`" <> ronnPartToText x <> "`" + RonnUserInput x -> "`" <> ronnPartToText x <> "`" + RonnStrong x -> "**" <> ronnPartToText x <> "**" + RonnVariable x -> "<" <> ronnPartToText x <> ">" + RonnEphasis x -> "_" <> ronnPartToText x <> "_" + RonnBrackets x -> "[" <> ronnPartToText x <> "]" + RonnParens x -> "(" <> ronnPartToText x <> ")" + RonnRef ref -> ronnPartToText $ RonnStrong $ RonnRaw $ manRefToText ref + RonnRaw x -> x + +manRefToText :: ManRef -> Text +manRefToText ref = + ref.name + <> "(" + <> pack (show $ manSectionNumber ref.section) + <> ")" + +ronnLineLength :: RonnLine -> Int +ronnLineLength = T.length . ronnLineToText + +indentRonnGroup :: Int -> RonnGroup -> RonnGroup +indentRonnGroup indentLevel = \case + g@RonnTitle {} -> g + g@RonnHeader {} -> g + RonnLines ls -> RonnLines $ map (indentRonnLine indentLevel) ls + +-- | Prepends the given number of spaces to the first 'RonnPart' of the line +indentRonnLine :: Int -> RonnLine -> RonnLine +indentRonnLine n = \case + RonnLine [] -> RonnLine [] + RonnLine (p : ps) -> RonnLine $ (spaces <> p) : ps + where + spaces = RonnRaw $ pack $ replicate n ' ' diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-missing-export-lists #-} diff --git a/tests/Ronn/RenderSpec.hs b/tests/Ronn/RenderSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Ronn/RenderSpec.hs @@ -0,0 +1,189 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +module Ronn.RenderSpec + ( spec + ) where + +import Prelude + +import Data.List (intersperse) +import Data.Text qualified as T +import Ronn.AST +import Ronn.Env +import Ronn.Opt +import Ronn.Render +import Test.Hspec + +spec :: Spec +spec = do + describe "ronnToText" $ do + specify "a complete example" $ do + let + opts = + OptsMany + [ OptsOne $ + Opt + { shorts = ['h'] + , longs = ["help"] + , argument = Nothing + , default_ = Just "" + , help = Just "Display this help" + } + , OptsOr $ + OptsMany + [ OptsOne $ + Opt + { shorts = [] + , longs = ["debug"] + , argument = Nothing + , default_ = Nothing + , help = Just "Enable debug" + } + , OptsOne $ + Opt + { shorts = [] + , longs = ["trace"] + , argument = Nothing + , default_ = Nothing + , help = Just "Enable trace" + } + ] + , OptsOne $ + Opt + { shorts = ['o'] + , longs = ["output"] + , argument = Just "FILE" + , default_ = Just "-" + , help = Just $ RonnLine ["Output to", RonnVariable "FILE"] + } + , OptsOne $ + Opt + { shorts = [] + , longs = [] + , argument = Just "INPUT" + , default_ = Nothing + , help = Just "Source input" + } + ] + + ronn = + Ronn + { name = ManRef "ronn" $ ManSection 1 + , description = ["example ronn man-page"] + , sections = + [ synopsisSection "ronn" opts + , RonnSection + { name = "DESCRIPTION" + , content = + [ RonnGroups + [ RonnLines + [ RonnLine -- test unwords-like behavior + [ "This is an" + , "example man-page to show" + , "how rendering the AST looks." + ] + ] + ] + ] + } + , optionsSection opts + , RonnSection + { name = "ENVIRONMENT" + , content = + [ RonnDefinitions + [ ( envToDefinition $ + Env + { vars = ["HOME"] + , argument = Nothing + , default_ = Nothing + , help = Just "User's HOME directory" + } + ) + { content = + Just + [ "Some further details:" + , RonnDefinitions + [ RonnDefinition + { name = "foo" + , description = "The foo" + , content = Nothing + } + , RonnDefinition + { name = "bar" + , description = "The bar" + , content = Nothing + } + ] + ] + } + ] + ] + } + , RonnSection + { name = "SEE ALSO" + , content = + [ RonnGroups + [ RonnLines + [ RonnLine + [ RonnConcat $ + intersperse + (RonnRaw ", ") + [ RonnRef $ ManRef "markdown" $ ManSection 7 + , RonnRef $ ManRef "roff" $ ManSection 7 + ] + ] + ] + ] + ] + } + ] + } + + ronnToText ronn + `shouldBe` T.unlines + [ "ronn(1) -- example ronn man-page" + , "================================" + , "" + , "## SYNOPSIS" + , "" + , "`ronn` [`-h`] [`--help`] [`--debug` \\| `--trace`] [`-o` ] [`--output`=] " + , "" + , "## DESCRIPTION" + , "" + , "This is an example man-page to show how rendering the AST looks." + , "" + , "## OPTIONS" + , "" + , " * `-h`, `--help`:" + , " Display this help" + , "" + , " * `--debug`:" + , " Enable debug" + , "" + , " * `--trace`:" + , " Enable trace" + , "" + , " * `-o` , `--output`=:" + , " Output to " + , "" + , " * :" + , " Source input" + , "" + , "## ENVIRONMENT" + , "" + , " * `HOME`:" + , " User's HOME directory" + , "" + , " Some further details:" + , "" + , " * foo:" + , " The foo" + , "" + , " * bar:" + , " The bar" + , "" + , "## SEE ALSO" + , "" + , "**markdown(7)**, **roff(7)**" + , "" + ]