-- |
--
-- 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 (..)
  , Group (..)
  , Line (..)
  , Part (..)

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

import Prelude

import Data.String (IsString (..))
import Data.Text (Text, pack)
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]
  }

data Content
  = Definitions [Definition]
  | Groups [Group]

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

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

data Group
  = Title ManRef [Part]
  | Header Text
  | Lines [Line]

instance IsString Group where
  fromString :: String -> Group
fromString = [Line] -> Group
Lines ([Line] -> Group) -> (String -> [Line]) -> String -> Group
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> [Line]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Line -> [Line]) -> (String -> Line) -> String -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Line
forall a. IsString a => String -> a
fromString

newtype Line = Line
  { Line -> [Part]
unwrap :: [Part]
  }

instance IsString Line where
  fromString :: String -> Line
fromString = [Part] -> Line
Line ([Part] -> Line) -> (String -> [Part]) -> String -> Line
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

data Part
  = -- | 'Concat' joins 'Part's without automaticaly inserting a space
    --
    -- The following expressions are equivalent:
    --
    -- - @'ronnLineToText' $ 'Line' [p1, p2]@
    -- - @'ronnLineToText' $ 'Line' ['Concat' [p1, " ", p2]]@
    -- - @'ronnLineToText' $ 'Line' [p1 <> " " <> p2]@
    --
    -- Using the 'Semigroup' instance should be preferred, in case the AST
    -- changes in the future.
    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 []