-- |
--
-- Module      : Ronn
-- Copyright   : (c) 2024 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Ronn
  ( module Ronn.AST
  , module Ronn.Render
  , ronnFilePath

    -- * Higher-level builders
  , synopsisSection
  , seeAlsoSection
  , oneLineSection
  , definitionsSection
  )
where

import Prelude

import Data.List (intersperse, sort)
import Data.Text (Text, unpack)
import Ronn.AST
import Ronn.Render

ronnFilePath :: Ronn -> FilePath
ronnFilePath :: Ronn -> FilePath
ronnFilePath Ronn
ronn =
  Text -> FilePath
unpack ManRef
ref.name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show (ManSection -> Int
manSectionNumber ManRef
ref.section) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".ronn"
 where
  ref :: ManRef
ref = Ronn
ronn.name

synopsisSection :: Text -> [Part] -> Section
synopsisSection :: Text -> [Part] -> Section
synopsisSection Text
name = Text -> [Part] -> Section
oneLineSection Text
"SYNOPSIS" ([Part] -> Section) -> ([Part] -> [Part]) -> [Part] -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Part -> Part
Code (Text -> Part
Raw Text
name) :)

seeAlsoSection :: [ManRef] -> Section
seeAlsoSection :: [ManRef] -> Section
seeAlsoSection [ManRef]
refs =
  Text -> [Part] -> Section
oneLineSection
    Text
"SEE ALSO"
    [ [Part] -> Part
forall a. Monoid a => [a] -> a
mconcat ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$
        Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
intersperse Part
", " ([Part] -> [Part]) -> [Part] -> [Part]
forall a b. (a -> b) -> a -> b
$
          (ManRef -> Part) -> [ManRef] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map ManRef -> Part
Ref ([ManRef] -> [Part]) -> [ManRef] -> [Part]
forall a b. (a -> b) -> a -> b
$
            [ManRef] -> [ManRef]
forall a. Ord a => [a] -> [a]
sort [ManRef]
refs
    ]

oneLineSection :: Text -> [Part] -> Section
oneLineSection :: Text -> [Part] -> Section
oneLineSection Text
name [Part]
ps =
  Section
    { Text
name :: Text
$sel:name:Section :: Text
name
    , $sel:content:Section :: [Content]
content = [[Group] -> Content
Groups [[Line] -> Group
Lines [[Part] -> Line
Line [Part]
ps]]]
    }

definitionsSection :: Text -> [Definition] -> Section
definitionsSection :: Text -> [Definition] -> Section
definitionsSection Text
name [Definition]
definitions =
  Section
    { Text
$sel:name:Section :: Text
name :: Text
name
    , $sel:content:Section :: [Content]
content = [[Definition] -> Content
Definitions [Definition]
definitions]
    }