{-# LANGUAGE OverloadedStrings #-}

module Language.Lsd.AST.Type.Document
    ( DocumentFormat (..)
    , TocFormat (..)
    , TocHeading (..)
    , DocumentType (..)
    , DocumentHeadingType (..)
    , DocumentBodyType (..)
    , DocumentMainBodyType (..)
    , DocumentIntroType (..)
    , DocumentExtroType (..)
    )
where

import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Void (Void)
import Language.Lsd.AST.Common (Keyword, NavTocHeading)
import Language.Lsd.AST.SimpleRegex (Disjunction, Sequence)
import Language.Lsd.AST.Type
    ( ChildrenOrder (SequenceOrder)
    , HasEditableHeader (HasEditableHeader)
    , NamedType
    , ProperNodeKind (..)
    , RawProperNodeKind (..)
    , TreeSyntax (LeafSyntax, TreeSyntax)
    )
import Language.Lsd.AST.Type.Footnote (FootnoteType)
import Language.Lsd.AST.Type.Section
    ( SectionBodyType (..)
    , sectionBodyChildrenOrderMap
    )
import Language.Lsd.AST.Type.SimpleSection (SimpleSectionType)
import Language.Lsd.AST.Type.Text (TextType)

newtype DocumentFormat
    = -- | ()
      DocumentFormat
        (Maybe TocFormat)
        -- ^ @Just fmt@ iff a TOC is desired.
    deriving (Int -> DocumentFormat -> ShowS
[DocumentFormat] -> ShowS
DocumentFormat -> String
(Int -> DocumentFormat -> ShowS)
-> (DocumentFormat -> String)
-> ([DocumentFormat] -> ShowS)
-> Show DocumentFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocumentFormat -> ShowS
showsPrec :: Int -> DocumentFormat -> ShowS
$cshow :: DocumentFormat -> String
show :: DocumentFormat -> String
$cshowList :: [DocumentFormat] -> ShowS
showList :: [DocumentFormat] -> ShowS
Show)

newtype TocFormat
    = TocFormat
        TocHeading
    deriving (Int -> TocFormat -> ShowS
[TocFormat] -> ShowS
TocFormat -> String
(Int -> TocFormat -> ShowS)
-> (TocFormat -> String)
-> ([TocFormat] -> ShowS)
-> Show TocFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TocFormat -> ShowS
showsPrec :: Int -> TocFormat -> ShowS
$cshow :: TocFormat -> String
show :: TocFormat -> String
$cshowList :: [TocFormat] -> ShowS
showList :: [TocFormat] -> ShowS
Show)

newtype TocHeading = TocHeading Text
    deriving (Int -> TocHeading -> ShowS
[TocHeading] -> ShowS
TocHeading -> String
(Int -> TocHeading -> ShowS)
-> (TocHeading -> String)
-> ([TocHeading] -> ShowS)
-> Show TocHeading
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TocHeading -> ShowS
showsPrec :: Int -> TocHeading -> ShowS
$cshow :: TocHeading -> String
show :: TocHeading -> String
$cshowList :: [TocHeading] -> ShowS
showList :: [TocHeading] -> ShowS
Show)

data DocumentType
    = DocumentType
        Keyword
        DocumentFormat
        DocumentHeadingType
        DocumentBodyType
        (Disjunction (NamedType FootnoteType))

instance RawProperNodeKind DocumentType where
    kindNameOfRaw :: Proxy DocumentType -> KindName
kindNameOfRaw Proxy DocumentType
_ = KindName
"document"

    treeSyntaxMapRaw :: forall a.
(forall t'. ProperNodeKind t' => t' -> a)
-> DocumentType -> TreeSyntax a
treeSyntaxMapRaw forall t'. ProperNodeKind t' => t' -> a
f (DocumentType Keyword
_ DocumentFormat
_ DocumentHeadingType
_ DocumentBodyType
bodyT Disjunction (NamedType FootnoteType)
_) =
        HasEditableHeader -> ChildrenOrder a -> TreeSyntax a
forall a. HasEditableHeader -> ChildrenOrder a -> TreeSyntax a
TreeSyntax (Bool -> HasEditableHeader
HasEditableHeader Bool
True) (ChildrenOrder a -> TreeSyntax a)
-> ChildrenOrder a -> TreeSyntax a
forall a b. (a -> b) -> a -> b
$ DocumentBodyType -> ChildrenOrder a
aux DocumentBodyType
bodyT
      where
        aux :: DocumentBodyType -> ChildrenOrder a
aux (DocumentBodyType Maybe DocumentIntroType
introT Disjunction (NamedType DocumentMainBodyType)
mainT Maybe DocumentExtroType
extroT) =
            [Disjunction a] -> ChildrenOrder a
forall a. [Disjunction a] -> ChildrenOrder a
SequenceOrder ([Disjunction a] -> ChildrenOrder a)
-> ([Maybe (Disjunction a)] -> [Disjunction a])
-> [Maybe (Disjunction a)]
-> ChildrenOrder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Disjunction a)] -> [Disjunction a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Disjunction a)] -> ChildrenOrder a)
-> [Maybe (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)
-> (DocumentIntroType -> a) -> DocumentIntroType -> Disjunction a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentIntroType -> a
forall t'. ProperNodeKind t' => t' -> a
f (DocumentIntroType -> Disjunction a)
-> Maybe DocumentIntroType -> Maybe (Disjunction a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DocumentIntroType
introT
                , Disjunction a -> Maybe (Disjunction a)
forall a. a -> Maybe a
Just (Disjunction a -> Maybe (Disjunction a))
-> Disjunction a -> Maybe (Disjunction a)
forall a b. (a -> b) -> a -> b
$ (NamedType DocumentMainBodyType -> a)
-> Disjunction (NamedType DocumentMainBodyType) -> Disjunction a
forall a b. (a -> b) -> Disjunction a -> Disjunction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedType DocumentMainBodyType -> a
forall t'. ProperNodeKind t' => t' -> a
f Disjunction (NamedType DocumentMainBodyType)
mainT
                , a -> Disjunction a
forall a. a -> Disjunction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Disjunction a)
-> (DocumentExtroType -> a) -> DocumentExtroType -> Disjunction a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentExtroType -> a
forall t'. ProperNodeKind t' => t' -> a
f (DocumentExtroType -> Disjunction a)
-> Maybe DocumentExtroType -> Maybe (Disjunction a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DocumentExtroType
extroT
                ]

newtype DocumentHeadingType = DocumentHeadingType (TextType Void)

data DocumentBodyType
    = DocumentBodyType
        (Maybe DocumentIntroType)
        (Disjunction (NamedType DocumentMainBodyType))
        (Maybe DocumentExtroType)

data DocumentMainBodyType
    = DocumentMainBodyType
        NavTocHeading
        SectionBodyType

instance RawProperNodeKind DocumentMainBodyType where
    kindNameOfRaw :: Proxy DocumentMainBodyType -> KindName
kindNameOfRaw Proxy DocumentMainBodyType
_ = KindName
"document-mainbody"

    treeSyntaxMapRaw :: forall a.
(forall t'. ProperNodeKind t' => t' -> a)
-> DocumentMainBodyType -> TreeSyntax a
treeSyntaxMapRaw forall t'. ProperNodeKind t' => t' -> a
f (DocumentMainBodyType NavTocHeading
_ SectionBodyType
t) =
        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
t of
            Just ChildrenOrder a
co -> HasEditableHeader -> ChildrenOrder a -> TreeSyntax a
forall a. HasEditableHeader -> ChildrenOrder a -> TreeSyntax a
TreeSyntax (Bool -> HasEditableHeader
HasEditableHeader Bool
False) ChildrenOrder a
co
            Maybe (ChildrenOrder a)
Nothing -> TreeSyntax a
forall a. TreeSyntax a
LeafSyntax

data DocumentIntroType
    = DocumentIntroType
        NavTocHeading
        (Sequence (NamedType SimpleSectionType))

instance ProperNodeKind DocumentIntroType where
    kindNameOf :: Proxy DocumentIntroType -> KindName
kindNameOf Proxy DocumentIntroType
_ = KindName
"document-intro"
    typeNameOf :: DocumentIntroType -> TypeName
typeNameOf DocumentIntroType
_ = TypeName
""
    displayTypeNameOf :: DocumentIntroType -> DisplayTypeName
displayTypeNameOf DocumentIntroType
_ = DisplayTypeName
"document intro"
    treeSyntaxMap :: forall a.
(forall t'. ProperNodeKind t' => t' -> a)
-> DocumentIntroType -> TreeSyntax a
treeSyntaxMap forall t'. ProperNodeKind t' => t' -> a
_ DocumentIntroType
_ = TreeSyntax a
forall a. TreeSyntax a
LeafSyntax

data DocumentExtroType
    = DocumentExtroType
        NavTocHeading
        (Sequence (NamedType SimpleSectionType))

instance ProperNodeKind DocumentExtroType where
    kindNameOf :: Proxy DocumentExtroType -> KindName
kindNameOf Proxy DocumentExtroType
_ = KindName
"document-extro"
    typeNameOf :: DocumentExtroType -> TypeName
typeNameOf DocumentExtroType
_ = TypeName
""
    displayTypeNameOf :: DocumentExtroType -> DisplayTypeName
displayTypeNameOf DocumentExtroType
_ = DisplayTypeName
"document extro"
    treeSyntaxMap :: forall a.
(forall t'. ProperNodeKind t' => t' -> a)
-> DocumentExtroType -> TreeSyntax a
treeSyntaxMap forall t'. ProperNodeKind t' => t' -> a
_ DocumentExtroType
_ = TreeSyntax a
forall a. TreeSyntax a
LeafSyntax