{-# LANGUAGE OverloadedStrings #-}

module Language.Ltml.Parser.DocumentContainer
    ( documentContainerHeaderP
    )
where

import Data.Text (Text, unwords)
import Language.Ltml.AST.DocumentContainer (DocumentContainerHeader (..))
import Language.Ltml.Parser (Parser)
import Language.Ltml.Parser.Common.Lexeme (lexeme, nLexeme1, nSc, symbol)
import Language.Ltml.Parser.Text (rawWordP)
import Text.Megaparsec (many)
import Prelude hiding (unwords)

-- TODO: Permit different ordering.
-- TODO: Normalize comment syntax.
--  - Here, we do not recognice a comment in `word// comment` (due to the
--    missing space), but usually we do.
-- TODO: Document syntax.
documentContainerHeaderP :: Parser DocumentContainerHeader
documentContainerHeaderP :: Parser DocumentContainerHeader
documentContainerHeaderP = do
    ParsecT Void Text Identity ()
forall (m :: * -> *). MonadParser m => m ()
nSc
    Text
pdfTitle <- Text -> Parser Text
entryP Text
"pdf-title"
    Text
hfSuperTitle <- Text -> Parser Text
entryP Text
"header-footer-supertitle"
    Text
hfTitle <- Text -> Parser Text
entryP Text
"header-footer-title"
    Text
hfDate <- Text -> Parser Text
entryP Text
"header-footer-date"
    DocumentContainerHeader -> Parser DocumentContainerHeader
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (DocumentContainerHeader -> Parser DocumentContainerHeader)
-> DocumentContainerHeader -> Parser DocumentContainerHeader
forall a b. (a -> b) -> a -> b
$
        DocumentContainerHeader
            { dchPdfTitle :: Text
dchPdfTitle = Text
pdfTitle
            , dchHeaderFooterSuperTitle :: Text
dchHeaderFooterSuperTitle = Text
hfSuperTitle
            , dchHeaderFooterTitle :: Text
dchHeaderFooterTitle = Text
hfTitle
            , dchHeaderFooterDate :: Text
dchHeaderFooterDate = Text
hfDate
            }
  where
    entryP :: Text -> Parser Text
    entryP :: Text -> Parser Text
entryP Text
prefix = Parser Text -> Parser Text
forall (m :: * -> *) a. MonadParser m => m a -> m a
nLexeme1 (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
        Text -> ParsecT Void Text Identity ()
forall (m :: * -> *). MonadParser m => Text -> m ()
symbol (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")
        [Text] -> Text
unwords ([Text] -> Text)
-> ParsecT Void Text Identity [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser Text -> Parser Text
forall (m :: * -> *) a. MonadParser m => m a -> m a
lexeme Parser Text
forall (m :: * -> *). MonadParser m => m Text
rawWordP)