-- |
--
-- 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 -> Text
ronnToText Ronn
ronn =
  [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    (RonnGroup -> Text) -> [RonnGroup] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RonnGroup -> Text
ronnGroupToText ([RonnGroup] -> [Text]) -> [RonnGroup] -> [Text]
forall a b. (a -> b) -> a -> b
$
      ManRef -> [RonnPart] -> RonnGroup
RonnTitle Ronn
ronn.name Ronn
ronn.description
        RonnGroup -> [RonnGroup] -> [RonnGroup]
forall a. a -> [a] -> [a]
: (RonnSection -> [RonnGroup]) -> [RonnSection] -> [RonnGroup]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RonnSection -> [RonnGroup]
ronnSectionToGroups Ronn
ronn.sections

ronnSectionToGroups :: RonnSection -> [RonnGroup]
ronnSectionToGroups :: RonnSection -> [RonnGroup]
ronnSectionToGroups RonnSection
section =
  Text -> RonnGroup
RonnHeader RonnSection
section.name RonnGroup -> [RonnGroup] -> [RonnGroup]
forall a. a -> [a] -> [a]
: (RonnContent -> [RonnGroup]) -> [RonnContent] -> [RonnGroup]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> RonnContent -> [RonnGroup]
ronnContentToGroups Int
0) RonnSection
section.content

ronnContentToGroups :: Int -> RonnContent -> [RonnGroup]
ronnContentToGroups :: Int -> RonnContent -> [RonnGroup]
ronnContentToGroups Int
indentLevel = \case
  RonnDefinitions [RonnDefinition]
defns ->
    (RonnDefinition -> [RonnGroup]) -> [RonnDefinition] -> [RonnGroup]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> RonnDefinition -> [RonnGroup]
ronnDefinitionToGroups (Int -> RonnDefinition -> [RonnGroup])
-> Int -> RonnDefinition -> [RonnGroup]
forall a b. (a -> b) -> a -> b
$ Int
indentLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) [RonnDefinition]
defns
  RonnGroups [RonnGroup]
gs -> (RonnGroup -> RonnGroup) -> [RonnGroup] -> [RonnGroup]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> RonnGroup -> RonnGroup
indentRonnGroup Int
indentLevel) [RonnGroup]
gs

ronnDefinitionToGroups :: Int -> RonnDefinition -> [RonnGroup]
ronnDefinitionToGroups :: Int -> RonnDefinition -> [RonnGroup]
ronnDefinitionToGroups Int
indentLevel RonnDefinition
defn =
  [ [RonnLine] -> RonnGroup
RonnLines
      [ Int -> RonnLine -> RonnLine
indentRonnLine Int
indentLevel (RonnLine -> RonnLine) -> RonnLine -> RonnLine
forall a b. (a -> b) -> a -> b
$ [RonnPart] -> RonnLine
RonnLine [RonnPart
"* " RonnPart -> RonnPart -> RonnPart
forall a. Semigroup a => a -> a -> a
<> RonnDefinition
defn.name RonnPart -> RonnPart -> RonnPart
forall a. Semigroup a => a -> a -> a
<> RonnPart
":"]
      , Int -> RonnLine -> RonnLine
indentRonnLine Int
nextIndentLevel RonnDefinition
defn.description
      ]
  ]
    [RonnGroup] -> [RonnGroup] -> [RonnGroup]
forall a. Semigroup a => a -> a -> a
<> [RonnGroup]
nested
 where
  nested :: [RonnGroup]
nested = [RonnGroup]
-> ([RonnContent] -> [RonnGroup])
-> Maybe [RonnContent]
-> [RonnGroup]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((RonnContent -> [RonnGroup]) -> [RonnContent] -> [RonnGroup]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((RonnContent -> [RonnGroup]) -> [RonnContent] -> [RonnGroup])
-> (RonnContent -> [RonnGroup]) -> [RonnContent] -> [RonnGroup]
forall a b. (a -> b) -> a -> b
$ Int -> RonnContent -> [RonnGroup]
ronnContentToGroups Int
nextIndentLevel) RonnDefinition
defn.content
  nextIndentLevel :: Int
nextIndentLevel = Int
indentLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2

ronnGroupToText :: RonnGroup -> Text
ronnGroupToText :: RonnGroup -> Text
ronnGroupToText = [Text] -> Text
T.unlines ([Text] -> Text) -> (RonnGroup -> [Text]) -> RonnGroup -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RonnLine -> Text) -> [RonnLine] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RonnLine -> Text
ronnLineToText ([RonnLine] -> [Text])
-> (RonnGroup -> [RonnLine]) -> RonnGroup -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RonnGroup -> [RonnLine]
ronnGroupToLines

ronnGroupToLines :: RonnGroup -> [RonnLine]
ronnGroupToLines :: RonnGroup -> [RonnLine]
ronnGroupToLines = \case
  RonnTitle ManRef
ref [RonnPart]
description ->
    let nameLine :: RonnLine
nameLine = ManRef -> [RonnPart] -> RonnLine
ronnNameLine ManRef
ref [RonnPart]
description
    in  [ RonnLine
nameLine
        , [RonnPart] -> RonnLine
RonnLine [Text -> RonnPart
RonnRaw (Text -> RonnPart) -> Text -> RonnPart
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (RonnLine -> Int
ronnLineLength RonnLine
nameLine) Text
"="]
        ]
  RonnHeader Text
name -> [[RonnPart] -> RonnLine
RonnLine [RonnPart
"##", Text -> RonnPart
RonnRaw Text
name]]
  RonnLines [RonnLine]
ls -> [RonnLine]
ls

ronnNameLine :: ManRef -> [RonnPart] -> RonnLine
ronnNameLine :: ManRef -> [RonnPart] -> RonnLine
ronnNameLine ManRef
ref =
  [RonnPart] -> RonnLine
RonnLine ([RonnPart] -> RonnLine)
-> ([RonnPart] -> [RonnPart]) -> [RonnPart] -> RonnLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> RonnPart
RonnRaw (ManRef -> Text
manRefToText ManRef
ref) :) ([RonnPart] -> [RonnPart])
-> ([RonnPart] -> [RonnPart]) -> [RonnPart] -> [RonnPart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RonnPart
"--" :)

ronnLineToText :: RonnLine -> Text
ronnLineToText :: RonnLine -> Text
ronnLineToText = [Text] -> Text
T.unwords ([Text] -> Text) -> (RonnLine -> [Text]) -> RonnLine -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RonnPart -> Text) -> [RonnPart] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RonnPart -> Text
ronnPartToText ([RonnPart] -> [Text])
-> (RonnLine -> [RonnPart]) -> RonnLine -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.unwrap)

ronnPartToText :: RonnPart -> Text
ronnPartToText :: RonnPart -> Text
ronnPartToText = \case
  RonnConcat [RonnPart]
xs -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RonnPart -> Text) -> [RonnPart] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RonnPart -> Text
ronnPartToText [RonnPart]
xs
  RonnCode RonnPart
x -> Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RonnPart -> Text
ronnPartToText RonnPart
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
  RonnUserInput RonnPart
x -> Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RonnPart -> Text
ronnPartToText RonnPart
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
  RonnStrong RonnPart
x -> Text
"**" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RonnPart -> Text
ronnPartToText RonnPart
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"**"
  RonnVariable RonnPart
x -> Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RonnPart -> Text
ronnPartToText RonnPart
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
  RonnEphasis RonnPart
x -> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RonnPart -> Text
ronnPartToText RonnPart
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
  RonnBrackets RonnPart
x -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RonnPart -> Text
ronnPartToText RonnPart
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  RonnParens RonnPart
x -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RonnPart -> Text
ronnPartToText RonnPart
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  RonnRef ManRef
ref -> RonnPart -> Text
ronnPartToText (RonnPart -> Text) -> RonnPart -> Text
forall a b. (a -> b) -> a -> b
$ RonnPart -> RonnPart
RonnStrong (RonnPart -> RonnPart) -> RonnPart -> RonnPart
forall a b. (a -> b) -> a -> b
$ Text -> RonnPart
RonnRaw (Text -> RonnPart) -> Text -> RonnPart
forall a b. (a -> b) -> a -> b
$ ManRef -> Text
manRefToText ManRef
ref
  RonnRaw Text
x -> Text
x

manRefToText :: ManRef -> Text
manRefToText :: ManRef -> Text
manRefToText ManRef
ref =
  ManRef
ref.name
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"("
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ ManSection -> Int
manSectionNumber ManRef
ref.section)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

ronnLineLength :: RonnLine -> Int
ronnLineLength :: RonnLine -> Int
ronnLineLength = Text -> Int
T.length (Text -> Int) -> (RonnLine -> Text) -> RonnLine -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RonnLine -> Text
ronnLineToText

indentRonnGroup :: Int -> RonnGroup -> RonnGroup
indentRonnGroup :: Int -> RonnGroup -> RonnGroup
indentRonnGroup Int
indentLevel = \case
  g :: RonnGroup
g@RonnTitle {} -> RonnGroup
g
  g :: RonnGroup
g@RonnHeader {} -> RonnGroup
g
  RonnLines [RonnLine]
ls -> [RonnLine] -> RonnGroup
RonnLines ([RonnLine] -> RonnGroup) -> [RonnLine] -> RonnGroup
forall a b. (a -> b) -> a -> b
$ (RonnLine -> RonnLine) -> [RonnLine] -> [RonnLine]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> RonnLine -> RonnLine
indentRonnLine Int
indentLevel) [RonnLine]
ls

-- | Prepends the given number of spaces to the first 'RonnPart' of the line
indentRonnLine :: Int -> RonnLine -> RonnLine
indentRonnLine :: Int -> RonnLine -> RonnLine
indentRonnLine Int
n = \case
  RonnLine [] -> [RonnPart] -> RonnLine
RonnLine []
  RonnLine (RonnPart
p : [RonnPart]
ps) -> [RonnPart] -> RonnLine
RonnLine ([RonnPart] -> RonnLine) -> [RonnPart] -> RonnLine
forall a b. (a -> b) -> a -> b
$ (RonnPart
spaces RonnPart -> RonnPart -> RonnPart
forall a. Semigroup a => a -> a -> a
<> RonnPart
p) RonnPart -> [RonnPart] -> [RonnPart]
forall a. a -> [a] -> [a]
: [RonnPart]
ps
 where
  spaces :: RonnPart
spaces = Text -> RonnPart
RonnRaw (Text -> RonnPart) -> Text -> RonnPart
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '