{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module Language.Lsd.AST.Type.Section
    ( SectionFormat (..)
    , SectionFormatted (..)
    , SectionType (..)
    , FormattedSectionType
    , HeadingType (..)
    , SectionBodyType (..)
    , sectionBodyChildrenOrderMap
    )
where

import Control.Functor.Utils (TraversableF (traverseF))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Void (Void)
import Language.Lsd.AST.Common (Keyword)
import Language.Lsd.AST.Format
    ( IdentifierFormat
    , InnerHeadingFormat
    , TocKeyFormat
    )
import Language.Lsd.AST.SimpleRegex (Star (Star))
import Language.Lsd.AST.Type
    ( ChildrenOrder (StarOrder)
    , HasEditableHeader (HasEditableHeader)
    , NamedType
    , ProperNodeKind
    , RawProperNodeKind (..)
    , TreeSyntax (LeafSyntax, TreeSyntax)
    )
import Language.Lsd.AST.Type.Paragraph (ParagraphType)
import Language.Lsd.AST.Type.SimpleBlock (SimpleBlockType)
import Language.Lsd.AST.Type.Text (TextType)

data SectionFormat
    = SectionFormat
        IdentifierFormat
        TocKeyFormat
        IsInserted
    deriving (Int -> SectionFormat -> ShowS
[SectionFormat] -> ShowS
SectionFormat -> String
(Int -> SectionFormat -> ShowS)
-> (SectionFormat -> String)
-> ([SectionFormat] -> ShowS)
-> Show SectionFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SectionFormat -> ShowS
showsPrec :: Int -> SectionFormat -> ShowS
$cshow :: SectionFormat -> String
show :: SectionFormat -> String
$cshowList :: [SectionFormat] -> ShowS
showList :: [SectionFormat] -> ShowS
Show)

type IsInserted = Bool

data SectionFormatted a = SectionFormatted SectionFormat a
    deriving (Int -> SectionFormatted a -> ShowS
[SectionFormatted a] -> ShowS
SectionFormatted a -> String
(Int -> SectionFormatted a -> ShowS)
-> (SectionFormatted a -> String)
-> ([SectionFormatted a] -> ShowS)
-> Show (SectionFormatted a)
forall a. Show a => Int -> SectionFormatted a -> ShowS
forall a. Show a => [SectionFormatted a] -> ShowS
forall a. Show a => SectionFormatted a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SectionFormatted a -> ShowS
showsPrec :: Int -> SectionFormatted a -> ShowS
$cshow :: forall a. Show a => SectionFormatted a -> String
show :: SectionFormatted a -> String
$cshowList :: forall a. Show a => [SectionFormatted a] -> ShowS
showList :: [SectionFormatted a] -> ShowS
Show, (forall a b. (a -> b) -> SectionFormatted a -> SectionFormatted b)
-> (forall a b. a -> SectionFormatted b -> SectionFormatted a)
-> Functor SectionFormatted
forall a b. a -> SectionFormatted b -> SectionFormatted a
forall a b. (a -> b) -> SectionFormatted a -> SectionFormatted b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SectionFormatted a -> SectionFormatted b
fmap :: forall a b. (a -> b) -> SectionFormatted a -> SectionFormatted b
$c<$ :: forall a b. a -> SectionFormatted b -> SectionFormatted a
<$ :: forall a b. a -> SectionFormatted b -> SectionFormatted a
Functor)

instance TraversableF SectionFormatted where
    traverseF :: forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> SectionFormatted a -> f (SectionFormatted b)
traverseF a -> f b
f (SectionFormatted SectionFormat
fmt a
x) = SectionFormat -> b -> SectionFormatted b
forall a. SectionFormat -> a -> SectionFormatted a
SectionFormatted SectionFormat
fmt (b -> SectionFormatted b) -> f b -> f (SectionFormatted b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

type FormattedSectionType = NonEmpty (SectionFormatted SectionType)

data SectionType
    = SectionType
        Keyword
        HeadingType
        SectionBodyType

instance RawProperNodeKind FormattedSectionType where
    kindNameOfRaw :: Proxy FormattedSectionType -> KindName
kindNameOfRaw Proxy FormattedSectionType
_ = KindName
"section"

    -- Note: The parser also permits super-sections as leafs in the input tree.
    --  - Ideally, this should also somehow be reflected here. (TODO)
    treeSyntaxMapRaw :: forall a.
(forall t'. ProperNodeKind t' => t' -> a)
-> FormattedSectionType -> TreeSyntax a
treeSyntaxMapRaw forall t'. ProperNodeKind t' => t' -> a
f (SectionFormatted SectionFormat
_ (SectionType Keyword
_ HeadingType
_ SectionBodyType
bodyT) :| [SectionFormatted SectionType]
_) =
        case (forall t'. ProperNodeKind t' => t' -> a)
-> SectionBodyType -> Maybe (ChildrenOrder a)
forall a.
(forall t'. ProperNodeKind t' => t' -> a)
-> SectionBodyType -> Maybe (ChildrenOrder a)
sectionBodyChildrenOrderMap t' -> a
forall t'. ProperNodeKind t' => t' -> a
f SectionBodyType
bodyT of
            Just ChildrenOrder a
co -> HasEditableHeader -> ChildrenOrder a -> TreeSyntax a
forall a. HasEditableHeader -> ChildrenOrder a -> TreeSyntax a
TreeSyntax (IsInserted -> HasEditableHeader
HasEditableHeader IsInserted
True) ChildrenOrder a
co
            Maybe (ChildrenOrder a)
Nothing -> TreeSyntax a
forall a. TreeSyntax a
LeafSyntax

data HeadingType
    = HeadingType
        InnerHeadingFormat
        (TextType Void)

data SectionBodyType
    = InnerSectionBodyType (Star (NamedType FormattedSectionType))
    | LeafSectionBodyType (Star (NamedType ParagraphType))
    | SimpleLeafSectionBodyType (Star (NamedType SimpleBlockType))

sectionBodyChildrenOrderMap
    :: (forall t'. (ProperNodeKind t') => t' -> a)
    -> SectionBodyType
    -> Maybe (ChildrenOrder a)
sectionBodyChildrenOrderMap :: forall a.
(forall t'. ProperNodeKind t' => t' -> a)
-> SectionBodyType -> Maybe (ChildrenOrder a)
sectionBodyChildrenOrderMap forall t'. ProperNodeKind t' => t' -> a
f (InnerSectionBodyType (Star NamedType FormattedSectionType
t)) =
    ChildrenOrder a -> Maybe (ChildrenOrder a)
forall a. a -> Maybe a
Just (ChildrenOrder a -> Maybe (ChildrenOrder a))
-> ChildrenOrder a -> Maybe (ChildrenOrder a)
forall a b. (a -> b) -> a -> b
$ Disjunction a -> ChildrenOrder a
forall a. Disjunction a -> ChildrenOrder a
StarOrder (Disjunction a -> ChildrenOrder a)
-> Disjunction a -> ChildrenOrder a
forall a b. (a -> b) -> a -> b
$ a -> Disjunction a
forall a. a -> Disjunction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Disjunction a) -> a -> Disjunction a
forall a b. (a -> b) -> a -> b
$ NamedType FormattedSectionType -> a
forall t'. ProperNodeKind t' => t' -> a
f NamedType FormattedSectionType
t
sectionBodyChildrenOrderMap forall t'. ProperNodeKind t' => t' -> a
_ SectionBodyType
_ = Maybe (ChildrenOrder a)
forall a. Maybe a
Nothing