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

    -- * References
  , ManRef (..)
  , ManSection (..)
  , manSectionNumber
  ) where

import Prelude

import Data.String (IsString (..))
import Data.Text (Text, pack)
import Data.Text qualified as T
import Prettyprinter
import Ronn.ManRef

data Ronn = Ronn
  { Ronn -> ManRef
name :: ManRef
  , Ronn -> [Part]
description :: [Part]
  , Ronn -> [Section]
sections :: [Section]
  }

data Section = Section
  { Section -> Text
name :: Text
  , Section -> [Content]
content :: [Content]
  }

instance Pretty Section where
  pretty :: forall ann. Section -> Doc ann
pretty Section
s = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Doc ann
"##" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Section
s.name) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Content -> Doc ann) -> [Content] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Content -> Doc ann
pretty Section
s.content

data Content
  = -- | Reflowed line
    Para [Part]
  | -- | Unbroken line
    Line [Part]
  | -- | Single definition
    Defn Definition

instance IsString Content where
  fromString :: String -> Content
fromString = [Part] -> Content
Para ([Part] -> Content) -> (String -> [Part]) -> String -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Part -> [Part]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Part -> [Part]) -> (String -> Part) -> String -> [Part]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Part
forall a. IsString a => String -> a
fromString

instance Pretty Content where
  pretty :: forall ann. Content -> Doc ann
pretty =
    (Doc ann
forall ann. Doc ann
hardline <>) (Doc ann -> Doc ann) -> (Content -> Doc ann) -> Content -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Para [Part]
ps -> [Part] -> Doc ann
forall ann. [Part] -> Doc ann
reflow [Part]
ps
      Line [Part]
ps -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Part -> Doc ann) -> [Part] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty [Part]
ps
      Defn Definition
dn -> Definition -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Definition -> Doc ann
pretty Definition
dn

data Definition = Definition
  { Definition -> Part
name :: Part
  , Definition -> [Part]
description :: [Part]
  -- ^ A line of nested description is required
  , Definition -> Maybe [Content]
content :: Maybe [Content]
  -- ^ More content can be optionally nested
  }

instance Pretty Definition where
  pretty :: forall ann. Definition -> Doc ann
pretty Definition
d =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"*"
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align
          ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
              [ Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty Definition
d.name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
              , [Part] -> Doc ann
forall ann. [Part] -> Doc ann
reflow Definition
d.description
              ]
          )
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> ([Content] -> Doc ann) -> Maybe [Content] -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty (Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann)
-> ([Content] -> Doc ann) -> [Content] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Doc ann) -> [Content] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Doc ann
forall ann. Doc ann
hardline <>) (Doc ann -> Doc ann) -> (Content -> Doc ann) -> Content -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Content -> Doc ann
pretty)) Definition
d.content

data Part
  = -- | 'Concat' joins 'Part's without automaticaly inserting a space
    --
    -- - @'pretty' [p1, p2]@ (may be broken for reflow)
    -- - @'pretty' ['Concat' [p1, " ", p2]]@ (never broken)
    --
    -- '(<>)' is implemented with 'Concat' and should be preferred, to avoid
    -- unnecessary nesting.
    Concat [Part]
  | Code Part
  | UserInput Part
  | Strong Part
  | Variable Part
  | Ephasis Part
  | Brackets Part
  | Parens Part
  | Ref ManRef
  | Raw Text

instance IsString Part where
  fromString :: String -> Part
fromString = Text -> Part
Raw (Text -> Part) -> (String -> Text) -> String -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

instance Semigroup Part where
  Concat [Part]
as <> :: Part -> Part -> Part
<> Concat [Part]
bs = [Part] -> Part
Concat ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ [Part]
as [Part] -> [Part] -> [Part]
forall a. Semigroup a => a -> a -> a
<> [Part]
bs
  Concat [Part]
as <> Part
b = [Part] -> Part
Concat ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ [Part]
as [Part] -> [Part] -> [Part]
forall a. Semigroup a => a -> a -> a
<> [Part
b]
  Part
a <> Concat [Part]
bs = [Part] -> Part
Concat ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ Part
a Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
bs
  Part
a <> Part
b = [Part] -> Part
Concat [Part
a, Part
b]

instance Monoid Part where
  mempty :: Part
mempty = [Part] -> Part
Concat []

instance Pretty Part where
  pretty :: forall ann. Part -> Doc ann
pretty = \case
    Concat [Part]
ps -> (Part -> Doc ann) -> [Part] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty [Part]
ps
    Code Part
p -> Doc ann
"`" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty Part
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"`"
    UserInput Part
p -> Doc ann
"`" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty Part
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"`"
    Strong Part
p -> Doc ann
"**" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty Part
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"**"
    Variable Part
p -> Doc ann
"<" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty Part
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
">"
    Ephasis Part
p -> Doc ann
"_" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty Part
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"_"
    Brackets Part
p -> Doc ann
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty Part
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"
    Parens Part
p -> Doc ann
"(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty Part
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
    Ref ManRef
ref -> Doc ann
"**" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ManRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ManRef -> Doc ann
pretty ManRef
ref Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"**"
    Raw Text
t -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
t

-- | Reflow a paragraph by tokenizing words and inserting softlines
--
-- This function will split any 'Raw' parts into multiple 'Raw' parts, one per
-- word, so that 'fillSep' will insert softlines between them.
reflow :: [Part] -> Doc ann
reflow :: forall ann. [Part] -> Doc ann
reflow = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ([Doc ann] -> Doc ann)
-> ([Part] -> [Doc ann]) -> [Part] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Part -> Doc ann) -> [Part] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Part -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Part -> Doc ann
pretty ([Part] -> [Doc ann]) -> ([Part] -> [Part]) -> [Part] -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Part -> [Part]) -> [Part] -> [Part]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Part -> [Part]
reword
 where
  reword :: Part -> [Part]
reword = \case
    Raw Text
t -> (Text -> Part) -> [Text] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Part
Raw ([Text] -> [Part]) -> [Text] -> [Part]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
t
    Part
p -> [Part
p]