-- |
--
-- 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
  { Ronn -> ManRef
name :: ManRef
  , Ronn -> [RonnPart]
description :: [RonnPart]
  , Ronn -> [RonnSection]
sections :: [RonnSection]
  }

data RonnSection = RonnSection
  { RonnSection -> Text
name :: Text
  , RonnSection -> [RonnContent]
content :: [RonnContent]
  }

data RonnContent
  = RonnDefinitions [RonnDefinition]
  | RonnGroups [RonnGroup]

instance IsString RonnContent where
  fromString :: String -> RonnContent
fromString = [RonnGroup] -> RonnContent
RonnGroups ([RonnGroup] -> RonnContent)
-> (String -> [RonnGroup]) -> String -> RonnContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RonnGroup -> [RonnGroup]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RonnGroup -> [RonnGroup])
-> (String -> RonnGroup) -> String -> [RonnGroup]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RonnGroup
forall a. IsString a => String -> a
fromString

data RonnDefinition = RonnDefinition
  { RonnDefinition -> RonnPart
name :: RonnPart
  , RonnDefinition -> RonnLine
description :: RonnLine
  -- ^ A line of nested description is required
  , RonnDefinition -> Maybe [RonnContent]
content :: Maybe [RonnContent]
  -- ^ More content can be optionally nested
  }

data RonnGroup
  = RonnTitle ManRef [RonnPart]
  | RonnHeader Text
  | RonnLines [RonnLine]

instance IsString RonnGroup where
  fromString :: String -> RonnGroup
fromString = [RonnLine] -> RonnGroup
RonnLines ([RonnLine] -> RonnGroup)
-> (String -> [RonnLine]) -> String -> RonnGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RonnLine -> [RonnLine]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RonnLine -> [RonnLine])
-> (String -> RonnLine) -> String -> [RonnLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RonnLine
forall a. IsString a => String -> a
fromString

newtype RonnLine = RonnLine
  { RonnLine -> [RonnPart]
unwrap :: [RonnPart]
  }

instance IsString RonnLine where
  fromString :: String -> RonnLine
fromString = [RonnPart] -> RonnLine
RonnLine ([RonnPart] -> RonnLine)
-> (String -> [RonnPart]) -> String -> RonnLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RonnPart -> [RonnPart]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RonnPart -> [RonnPart])
-> (String -> RonnPart) -> String -> [RonnPart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RonnPart
forall a. IsString a => String -> a
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 :: String -> RonnPart
fromString = Text -> RonnPart
RonnRaw (Text -> RonnPart) -> (String -> Text) -> String -> RonnPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

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

instance Monoid RonnPart where
  mempty :: RonnPart
mempty = [RonnPart] -> RonnPart
RonnConcat []

data ManRef = ManRef
  { ManRef -> Text
name :: Text
  , ManRef -> ManSection
section :: ManSection
  }

-- TODO: enum?
newtype ManSection = ManSection Int

manSectionNumber :: ManSection -> Int
manSectionNumber :: ManSection -> Int
manSectionNumber (ManSection Int
n) = Int
n