{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Language.Ltml.Parser.Text
    ( ParagraphParser
    , textForestP
    , pipeSeperatedTextForestsP
    , hangingTextP
    , HangingTextP
    , hangingTextP'
    , rawWordP
    )
where

import Control.Applicative (empty, (<|>))
import Control.Applicative.Combinators (choice)
import Control.Monad (guard, void)
import Control.Monad.Identity (Identity (Identity), runIdentity)
import Control.Monad.State (StateT, get, put)
import Control.Monad.Trans.Class (lift)
import qualified Data.Char as Char (isControl)
import Data.List (singleton)
import Data.Maybe (maybeToList)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import qualified Data.Text as Text (singleton)
import Data.Typography (FontStyle (..))
import Data.Void (Void)
import Language.Lsd.AST.Common (Keyword)
import Language.Lsd.AST.SimpleRegex (Disjunction (Disjunction))
import Language.Lsd.AST.Type (unwrapNT)
import Language.Lsd.AST.Type.Enum (EnumType (EnumType))
import Language.Lsd.AST.Type.Text (TextType (TextType))
import Language.Ltml.AST.Label (Label)
import Language.Ltml.AST.Node (Node (Node))
import Language.Ltml.AST.Text
    ( EnumItem (EnumItem)
    , Enumeration (Enumeration)
    , FootnoteReference (FootnoteReference)
    , HardLineBreak (HardLineBreak)
    , SentenceStart (SentenceStart)
    , TextTree (..)
    )
import Language.Ltml.Parser
    ( MonadParser
    , Parser
    , ParserWrapper (wrapParser)
    )
import Language.Ltml.Parser.Common.Indent (someIndented)
import Language.Ltml.Parser.Common.Lexeme (isLineCommentPrefixFirstChar)
import Language.Ltml.Parser.Keyword (keywordP, lKeywordP, mlKeywordP)
import Language.Ltml.Parser.Label (bracedLabelingP, labelP)
import Language.Ltml.Parser.MiTree
    ( InlineParser (BracketingParser, LeafParser)
    , MiElementConfig (..)
    , Restricted
    , hangingBlock'
    , hangingBlock_
    , miForest
    , pipeSeparated
    , unbracketed
    , unrestricted
    )
import Text.Megaparsec
    ( Pos
    , lookAhead
    , optional
    , satisfy
    , some
    , takeWhile1P
    , try
    )
import Text.Megaparsec.Char (char, string)

type ParagraphParser =
    StateT
        Bool -- whether sentence start is expected
        Parser

instance ParserWrapper ParagraphParser where
    wrapParser :: forall a. Parser a -> ParagraphParser a
wrapParser = ParsecT Void Text Identity a
-> StateT Bool (ParsecT Void Text Identity) a
forall (m :: * -> *) a. Monad m => m a -> StateT Bool m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

textForestP
    :: ( ParserWrapper m
       , LineBreakP lbrk
       , FootnoteRefP fnref
       , StyleP style
       , EnumP enumType enum
       , SpecialP m special
       )
    => TextType enumType
    -> m [TextTree lbrk fnref style enum special]
textForestP :: forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
TextType enumType -> m [TextTree lbrk fnref style enum special]
textForestP TextType enumType
t = [Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
-> (Maybe Pos -> m (TextTree lbrk fnref style enum special))
-> m [TextTree lbrk fnref style enum special]
forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
[Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m [a]
miForest [Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
forall (m :: * -> *) lbrk fnref style enum special.
(MonadParser m, LineBreakP lbrk, FootnoteRefP fnref, StyleP style,
 SpecialP m special) =>
[Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
inlinePs (TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, EnumP enumType enum, SpecialP m special) =>
TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
blockPF TextType enumType
t)

pipeSeperatedTextForestsP
    :: ( ParserWrapper m
       , LineBreakP lbrk
       , FootnoteRefP fnref
       , StyleP style
       , EnumP enumType enum
       , SpecialP m special
       )
    => TextType enumType
    -> m [[TextTree lbrk fnref style enum special]]
pipeSeperatedTextForestsP :: forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
TextType enumType -> m [[TextTree lbrk fnref style enum special]]
pipeSeperatedTextForestsP TextType enumType
tt = [Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
-> (Maybe Pos -> m (TextTree lbrk fnref style enum special))
-> m [[TextTree lbrk fnref style enum special]]
forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
[Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m [[a]]
pipeSeparated [Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
forall (m :: * -> *) lbrk fnref style enum special.
(MonadParser m, LineBreakP lbrk, FootnoteRefP fnref, StyleP style,
 SpecialP m special) =>
[Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
inlinePs (TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, EnumP enumType enum, SpecialP m special) =>
TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
blockPF TextType enumType
tt)

-- Note on sentence start tokens (SSTs):
--  * Labeled SSTs are permitted anywhere, while unlabeled SSTs are only
--    permitted in certain places.
--     - In particular, in case of styling, the default (empty) SST is parsed
--       after the opening styling tag, but can be forced before by a labeled
--       SST.
inlinePs
    :: forall m lbrk fnref style enum special
     . ( MonadParser m
       , LineBreakP lbrk
       , FootnoteRefP fnref
       , StyleP style
       , SpecialP m special
       )
    => [Restricted (InlineParser m (TextTree lbrk fnref style enum special))]
inlinePs :: forall (m :: * -> *) lbrk fnref style enum special.
(MonadParser m, LineBreakP lbrk, FootnoteRefP fnref, StyleP style,
 SpecialP m special) =>
[Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
inlinePs =
    [ InlineParser m (TextTree lbrk fnref style enum special)
-> Restricted
     (InlineParser m (TextTree lbrk fnref style enum special))
forall a. a -> Restricted a
unrestricted (InlineParser m (TextTree lbrk fnref style enum special)
 -> Restricted
      (InlineParser m (TextTree lbrk fnref style enum special)))
-> InlineParser m (TextTree lbrk fnref style enum special)
-> Restricted
     (InlineParser m (TextTree lbrk fnref style enum special))
forall a b. (a -> b) -> a -> b
$ m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> InlineParser m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) a.
m (MiElementConfig, [a]) -> InlineParser m a
LeafParser (m (MiElementConfig, [TextTree lbrk fnref style enum special])
 -> InlineParser m (TextTree lbrk fnref style enum special))
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> InlineParser m (TextTree lbrk fnref style enum special)
forall a b. (a -> b) -> a -> b
$ m (TextTree lbrk fnref style enum special)
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall {a}. m a -> m (MiElementConfig, [a])
mkXP_ (TextTree lbrk fnref style enum special
forall lbrk fnref style enum special.
TextTree lbrk fnref style enum special
NonBreakingSpace TextTree lbrk fnref style enum special
-> m Char -> m (TextTree lbrk fnref style enum special)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'~')
    , InlineParser m (TextTree lbrk fnref style enum special)
-> Restricted
     (InlineParser m (TextTree lbrk fnref style enum special))
forall a. a -> Restricted a
unrestricted (InlineParser m (TextTree lbrk fnref style enum special)
 -> Restricted
      (InlineParser m (TextTree lbrk fnref style enum special)))
-> InlineParser m (TextTree lbrk fnref style enum special)
-> Restricted
     (InlineParser m (TextTree lbrk fnref style enum special))
forall a b. (a -> b) -> a -> b
$ m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> InlineParser m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) a.
m (MiElementConfig, [a]) -> InlineParser m a
LeafParser (m (MiElementConfig, [TextTree lbrk fnref style enum special])
 -> InlineParser m (TextTree lbrk fnref style enum special))
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> InlineParser m (TextTree lbrk fnref style enum special)
forall a b. (a -> b) -> a -> b
$ m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{' m Char
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall {style} {enum}.
m (MiElementConfig, [TextTree lbrk fnref style enum special])
bracedP m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> m Char
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}')
    , InlineParser m (TextTree lbrk fnref style enum special)
-> Restricted
     (InlineParser m (TextTree lbrk fnref style enum special))
forall a. a -> Restricted a
unrestricted InlineParser m (TextTree lbrk fnref style enum special)
forall {lbrk} {fnref} {enum} {special}.
InlineParser m (TextTree lbrk fnref style enum special)
styledElementP
    , InlineParser m (TextTree lbrk fnref style enum special)
-> Restricted
     (InlineParser m (TextTree lbrk fnref style enum special))
forall a. a -> Restricted a
unrestricted (InlineParser m (TextTree lbrk fnref style enum special)
 -> Restricted
      (InlineParser m (TextTree lbrk fnref style enum special)))
-> InlineParser m (TextTree lbrk fnref style enum special)
-> Restricted
     (InlineParser m (TextTree lbrk fnref style enum special))
forall a b. (a -> b) -> a -> b
$ m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> InlineParser m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) a.
m (MiElementConfig, [a]) -> InlineParser m a
LeafParser (m (MiElementConfig, [TextTree lbrk fnref style enum special])
 -> InlineParser m (TextTree lbrk fnref style enum special))
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> InlineParser m (TextTree lbrk fnref style enum special)
forall a b. (a -> b) -> a -> b
$ m (TextTree lbrk fnref style enum special)
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall {f :: * -> *} {a} {lbrk} {fnref} {style} {enum}.
(Monad f, Alternative f, SpecialP f a) =>
f (TextTree lbrk fnref style enum a)
-> f (MiElementConfig, [TextTree lbrk fnref style enum a])
mkP (Text -> TextTree lbrk fnref style enum special
forall lbrk fnref style enum special.
Text -> TextTree lbrk fnref style enum special
Word (Text -> TextTree lbrk fnref style enum special)
-> m Text -> m (TextTree lbrk fnref style enum special)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy special -> m Text
forall (m :: * -> *) special.
SpecialP m special =>
Proxy special -> m Text
wordP (Proxy special
forall {k} (t :: k). Proxy t
Proxy :: Proxy special))
    , InlineParser m (TextTree lbrk fnref style enum special)
-> Restricted
     (InlineParser m (TextTree lbrk fnref style enum special))
forall a. a -> Restricted a
unbracketed (InlineParser m (TextTree lbrk fnref style enum special)
 -> Restricted
      (InlineParser m (TextTree lbrk fnref style enum special)))
-> InlineParser m (TextTree lbrk fnref style enum special)
-> Restricted
     (InlineParser m (TextTree lbrk fnref style enum special))
forall a b. (a -> b) -> a -> b
$ m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> InlineParser m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) a.
m (MiElementConfig, [a]) -> InlineParser m a
LeafParser (m (MiElementConfig, [TextTree lbrk fnref style enum special])
 -> InlineParser m (TextTree lbrk fnref style enum special))
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> InlineParser m (TextTree lbrk fnref style enum special)
forall a b. (a -> b) -> a -> b
$ m (TextTree lbrk fnref style enum special)
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall {f :: * -> *} {a} {lbrk} {fnref} {style} {enum}.
(Monad f, Alternative f, SpecialP f a) =>
f (TextTree lbrk fnref style enum a)
-> f (MiElementConfig, [TextTree lbrk fnref style enum a])
mkP (Text -> TextTree lbrk fnref style enum special
forall lbrk fnref style enum special.
Text -> TextTree lbrk fnref style enum special
Word (Text -> TextTree lbrk fnref style enum special)
-> (Char -> Text) -> Char -> TextTree lbrk fnref style enum special
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton (Char -> TextTree lbrk fnref style enum special)
-> m Char -> m (TextTree lbrk fnref style enum special)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>')
    ]
  where
    -- This should not be expensive, it is indirectly wrapped in `try`.
    bracedP :: m (MiElementConfig, [TextTree lbrk fnref style enum special])
bracedP =
        m (TextTree lbrk fnref style enum special)
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall {f :: * -> *} {a} {lbrk} {fnref} {style} {enum}.
(Monad f, Alternative f, SpecialP f a) =>
f (TextTree lbrk fnref style enum a)
-> f (MiElementConfig, [TextTree lbrk fnref style enum a])
mkP (Label -> TextTree lbrk fnref style enum special
forall lbrk fnref style enum special.
Label -> TextTree lbrk fnref style enum special
Reference (Label -> TextTree lbrk fnref style enum special)
-> m Char -> m (Label -> TextTree lbrk fnref style enum special)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' m (Label -> TextTree lbrk fnref style enum special)
-> m Label -> m (TextTree lbrk fnref style enum special)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Label
forall (m :: * -> *). MonadParser m => m Label
labelP)
            m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (TextTree lbrk fnref style enum special)
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall {f :: * -> *} {a} {lbrk} {fnref} {style} {enum}.
(Monad f, Alternative f, SpecialP f a) =>
f (TextTree lbrk fnref style enum a)
-> f (MiElementConfig, [TextTree lbrk fnref style enum a])
mkP (fnref -> TextTree lbrk fnref style enum special
forall lbrk fnref style enum special.
fnref -> TextTree lbrk fnref style enum special
FootnoteRef (fnref -> TextTree lbrk fnref style enum special)
-> m fnref -> m (TextTree lbrk fnref style enum special)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m fnref
forall fnref (m :: * -> *).
(FootnoteRefP fnref, MonadParser m) =>
m fnref
forall (m :: * -> *). MonadParser m => m fnref
bracedFootnoteRefP)
            m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (lbrk -> [TextTree lbrk fnref style enum special])
-> (MiElementConfig, lbrk)
-> (MiElementConfig, [TextTree lbrk fnref style enum special])
forall a b.
(a -> b) -> (MiElementConfig, a) -> (MiElementConfig, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TextTree lbrk fnref style enum special
-> [TextTree lbrk fnref style enum special]
forall a. a -> [a]
singleton (TextTree lbrk fnref style enum special
 -> [TextTree lbrk fnref style enum special])
-> (lbrk -> TextTree lbrk fnref style enum special)
-> lbrk
-> [TextTree lbrk fnref style enum special]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. lbrk -> TextTree lbrk fnref style enum special
forall lbrk fnref style enum special.
lbrk -> TextTree lbrk fnref style enum special
LineBreak) ((MiElementConfig, lbrk)
 -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
-> m (MiElementConfig, lbrk)
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (MiElementConfig, lbrk)
forall lbrk (m :: * -> *).
(LineBreakP lbrk, MonadParser m) =>
m (MiElementConfig, lbrk)
forall (m :: * -> *). MonadParser m => m (MiElementConfig, lbrk)
bracedLineBreakP
            m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe special -> [TextTree lbrk fnref style enum special])
-> (MiElementConfig, Maybe special)
-> (MiElementConfig, [TextTree lbrk fnref style enum special])
forall a b.
(a -> b) -> (MiElementConfig, a) -> (MiElementConfig, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (TextTree lbrk fnref style enum special)
-> [TextTree lbrk fnref style enum special]
forall a. Maybe a -> [a]
maybeToList (Maybe (TextTree lbrk fnref style enum special)
 -> [TextTree lbrk fnref style enum special])
-> (Maybe special
    -> Maybe (TextTree lbrk fnref style enum special))
-> Maybe special
-> [TextTree lbrk fnref style enum special]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (special -> TextTree lbrk fnref style enum special)
-> Maybe special -> Maybe (TextTree lbrk fnref style enum special)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap special -> TextTree lbrk fnref style enum special
forall lbrk fnref style enum special.
special -> TextTree lbrk fnref style enum special
Special) ((MiElementConfig, Maybe special)
 -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
-> m (MiElementConfig, Maybe special)
-> m (MiElementConfig, [TextTree lbrk fnref style enum special])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (MiElementConfig, Maybe special)
forall (m :: * -> *) special.
SpecialP m special =>
m (MiElementConfig, Maybe special)
bracedSpecialP

    styledElementP :: InlineParser m (TextTree lbrk fnref style enum special)
styledElementP =
        m ([TextTree lbrk fnref style enum special]
   -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
-> m () -> InlineParser m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) a.
m ([a] -> (MiElementConfig, [a])) -> m () -> InlineParser m a
BracketingParser
            (m ([TextTree lbrk fnref style enum special]
   -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
-> m ([TextTree lbrk fnref style enum special]
      -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m ([TextTree lbrk fnref style enum special]
    -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
 -> m ([TextTree lbrk fnref style enum special]
       -> (MiElementConfig, [TextTree lbrk fnref style enum special])))
-> m ([TextTree lbrk fnref style enum special]
      -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
-> m ([TextTree lbrk fnref style enum special]
      -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
forall a b. (a -> b) -> a -> b
$ m ([TextTree lbrk fnref style enum special]
   -> TextTree lbrk fnref style enum special)
-> m ([TextTree lbrk fnref style enum special]
      -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
forall a b. m (a -> b) -> m (a -> (MiElementConfig, [b]))
mkP_' (m ([TextTree lbrk fnref style enum special]
    -> TextTree lbrk fnref style enum special)
 -> m ([TextTree lbrk fnref style enum special]
       -> (MiElementConfig, [TextTree lbrk fnref style enum special])))
-> m ([TextTree lbrk fnref style enum special]
      -> TextTree lbrk fnref style enum special)
-> m ([TextTree lbrk fnref style enum special]
      -> (MiElementConfig, [TextTree lbrk fnref style enum special]))
forall a b. (a -> b) -> a -> b
$ style
-> [TextTree lbrk fnref style enum special]
-> TextTree lbrk fnref style enum special
forall lbrk fnref style enum special.
style
-> [TextTree lbrk fnref style enum special]
-> TextTree lbrk fnref style enum special
Styled (style
 -> [TextTree lbrk fnref style enum special]
 -> TextTree lbrk fnref style enum special)
-> m Char
-> m (style
      -> [TextTree lbrk fnref style enum special]
      -> TextTree lbrk fnref style enum special)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<' m (style
   -> [TextTree lbrk fnref style enum special]
   -> TextTree lbrk fnref style enum special)
-> m style
-> m ([TextTree lbrk fnref style enum special]
      -> TextTree lbrk fnref style enum special)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m style
forall style (m :: * -> *).
(StyleP style, MonadParser m) =>
m style
forall (m :: * -> *). MonadParser m => m style
styleP)
            (m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Char -> m ()) -> m Char -> m ()
forall a b. (a -> b) -> a -> b
$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>')
      where
        mkP_' :: m (a -> b) -> m (a -> (MiElementConfig, [b]))
        mkP_' :: forall a b. m (a -> b) -> m (a -> (MiElementConfig, [b]))
mkP_' = ((a -> b) -> a -> (MiElementConfig, [b]))
-> m (a -> b) -> m (a -> (MiElementConfig, [b]))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((MiElementConfig
regularCfg,) ([b] -> (MiElementConfig, [b]))
-> (b -> [b]) -> b -> (MiElementConfig, [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [b]
forall a. a -> [a]
singleton) (b -> (MiElementConfig, [b]))
-> (a -> b) -> a -> (MiElementConfig, [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

    -- Note: Using mkP and mkXP_ repeatedly instead of grouping appropriately
    --   is maybe less efficient, but IMHO better readable.

    -- Make a simple parser, permitting preceding empty SST.
    mkP :: f (TextTree lbrk fnref style enum a)
-> f (MiElementConfig, [TextTree lbrk fnref style enum a])
mkP f (TextTree lbrk fnref style enum a)
p =
        (MiElementConfig
regularCfg,) ([TextTree lbrk fnref style enum a]
 -> (MiElementConfig, [TextTree lbrk fnref style enum a]))
-> f [TextTree lbrk fnref style enum a]
-> f (MiElementConfig, [TextTree lbrk fnref style enum a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            Maybe (TextTree lbrk fnref style enum a)
mSst <- f (TextTree lbrk fnref style enum a)
-> f (Maybe (TextTree lbrk fnref style enum a))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (f (TextTree lbrk fnref style enum a)
 -> f (Maybe (TextTree lbrk fnref style enum a)))
-> f (TextTree lbrk fnref style enum a)
-> f (Maybe (TextTree lbrk fnref style enum a))
forall a b. (a -> b) -> a -> b
$ a -> TextTree lbrk fnref style enum a
forall lbrk fnref style enum special.
special -> TextTree lbrk fnref style enum special
Special (a -> TextTree lbrk fnref style enum a)
-> f a -> f (TextTree lbrk fnref style enum a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
forall (m :: * -> *) special. SpecialP m special => m special
emptySentenceStartP
            TextTree lbrk fnref style enum a
x <- f (TextTree lbrk fnref style enum a)
p
            [TextTree lbrk fnref style enum a]
-> f [TextTree lbrk fnref style enum a]
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TextTree lbrk fnref style enum a]
 -> f [TextTree lbrk fnref style enum a])
-> [TextTree lbrk fnref style enum a]
-> f [TextTree lbrk fnref style enum a]
forall a b. (a -> b) -> a -> b
$ ([TextTree lbrk fnref style enum a]
 -> [TextTree lbrk fnref style enum a])
-> (TextTree lbrk fnref style enum a
    -> [TextTree lbrk fnref style enum a]
    -> [TextTree lbrk fnref style enum a])
-> Maybe (TextTree lbrk fnref style enum a)
-> [TextTree lbrk fnref style enum a]
-> [TextTree lbrk fnref style enum a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [TextTree lbrk fnref style enum a]
-> [TextTree lbrk fnref style enum a]
forall a. a -> a
id (:) Maybe (TextTree lbrk fnref style enum a)
mSst [TextTree lbrk fnref style enum a
x]

    -- Make a simple parser, not permitting preceding empty SST, and dropping
    -- surrounding whitespace.
    mkXP_ :: m a -> m (MiElementConfig, [a])
mkXP_ = (a -> (MiElementConfig, [a])) -> m a -> m (MiElementConfig, [a])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MiElementConfig
specialCfg,) ([a] -> (MiElementConfig, [a]))
-> (a -> [a]) -> a -> (MiElementConfig, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
forall a. a -> [a]
singleton)

    regularCfg :: MiElementConfig
regularCfg =
        MiElementConfig
            { miecRetainPrecedingWhitespace :: Bool
miecRetainPrecedingWhitespace = Bool
True
            , miecRetainTrailingWhitespace :: Bool
miecRetainTrailingWhitespace = Bool
True
            }

    specialCfg :: MiElementConfig
specialCfg =
        MiElementConfig
            { miecRetainPrecedingWhitespace :: Bool
miecRetainPrecedingWhitespace = Bool
False
            , miecRetainTrailingWhitespace :: Bool
miecRetainTrailingWhitespace = Bool
False
            }

blockPF
    :: forall m lbrk fnref style enumType enum special
     . (ParserWrapper m, EnumP enumType enum, SpecialP m special)
    => TextType enumType
    -> Maybe Pos
    -> m (TextTree lbrk fnref style enum special)
blockPF :: forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, EnumP enumType enum, SpecialP m special) =>
TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
blockPF (TextType (Disjunction [NamedType enumType]
enumTypes)) Maybe Pos
lvl =
    Parser (TextTree lbrk fnref style enum special)
-> m (TextTree lbrk fnref style enum special)
forall a. Parser a -> m a
forall (m :: * -> *) a. ParserWrapper m => Parser a -> m a
wrapParser (enum -> TextTree lbrk fnref style enum special
forall lbrk fnref style enum special.
enum -> TextTree lbrk fnref style enum special
Enum (enum -> TextTree lbrk fnref style enum special)
-> ParsecT Void Text Identity enum
-> Parser (TextTree lbrk fnref style enum special)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void Text Identity enum]
-> ParsecT Void Text Identity enum
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((NamedType enumType -> ParsecT Void Text Identity enum)
-> [NamedType enumType] -> [ParsecT Void Text Identity enum]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Pos -> enumType -> ParsecT Void Text Identity enum
forall enumType enum.
EnumP enumType enum =>
Maybe Pos -> enumType -> Parser enum
enumP Maybe Pos
lvl (enumType -> ParsecT Void Text Identity enum)
-> (NamedType enumType -> enumType)
-> NamedType enumType
-> ParsecT Void Text Identity enum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedType enumType -> enumType
forall t. NamedType t -> t
unwrapNT) [NamedType enumType]
enumTypes))
        m (TextTree lbrk fnref style enum special)
-> m () -> m (TextTree lbrk fnref style enum special)
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Proxy special -> m ()
forall (m :: * -> *) special.
SpecialP m special =>
Proxy special -> m ()
postEnumP (Proxy special
forall {k} (t :: k). Proxy t
Proxy :: Proxy special)

-- TODO: Unused.
hangingTextP
    :: ( ParserWrapper m
       , LineBreakP lbrk
       , FootnoteRefP fnref
       , StyleP style
       , EnumP enumType enum
       , SpecialP m special
       )
    => Keyword
    -> TextType enumType
    -> m [TextTree lbrk fnref style enum special]
hangingTextP :: forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
Keyword
-> TextType enumType -> m [TextTree lbrk fnref style enum special]
hangingTextP Keyword
kw TextType enumType
t = Identity [TextTree lbrk fnref style enum special]
-> [TextTree lbrk fnref style enum special]
forall a. Identity a -> a
runIdentity (Identity [TextTree lbrk fnref style enum special]
 -> [TextTree lbrk fnref style enum special])
-> m (Identity [TextTree lbrk fnref style enum special])
-> m [TextTree lbrk fnref style enum special]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Keyword
-> TextType enumType
-> m (Identity [TextTree lbrk fnref style enum special])
forall (f :: * -> *) (m :: * -> *) lbrk fnref style enumType enum
       special.
(HangingTextP f, ParserWrapper m, LineBreakP lbrk,
 FootnoteRefP fnref, StyleP style, EnumP enumType enum,
 SpecialP m special) =>
Keyword
-> TextType enumType
-> m (f [TextTree lbrk fnref style enum special])
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
Keyword
-> TextType enumType
-> m (Identity [TextTree lbrk fnref style enum special])
hangingTextP' Keyword
kw TextType enumType
t

class (Functor f) => HangingTextP f where
    hangingTextP'
        :: ( ParserWrapper m
           , LineBreakP lbrk
           , FootnoteRefP fnref
           , StyleP style
           , EnumP enumType enum
           , SpecialP m special
           )
        => Keyword
        -> TextType enumType
        -> m (f [TextTree lbrk fnref style enum special])

instance HangingTextP Identity where
    hangingTextP' :: forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
Keyword
-> TextType enumType
-> m (Identity [TextTree lbrk fnref style enum special])
hangingTextP' Keyword
kw TextType enumType
t =
        [TextTree lbrk fnref style enum special]
-> Identity [TextTree lbrk fnref style enum special]
forall a. a -> Identity a
Identity ([TextTree lbrk fnref style enum special]
 -> Identity [TextTree lbrk fnref style enum special])
-> m [TextTree lbrk fnref style enum special]
-> m (Identity [TextTree lbrk fnref style enum special])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ()
-> [Restricted
      (InlineParser m (TextTree lbrk fnref style enum special))]
-> (Maybe Pos -> m (TextTree lbrk fnref style enum special))
-> m [TextTree lbrk fnref style enum special]
forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
m ()
-> [Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m [a]
hangingBlock_ (Keyword -> m ()
forall (m :: * -> *). MonadParser m => Keyword -> m ()
keywordP Keyword
kw) [Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
forall (m :: * -> *) lbrk fnref style enum special.
(MonadParser m, LineBreakP lbrk, FootnoteRefP fnref, StyleP style,
 SpecialP m special) =>
[Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
inlinePs (TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, EnumP enumType enum, SpecialP m special) =>
TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
blockPF TextType enumType
t)

instance HangingTextP Node where
    hangingTextP' :: forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
Keyword
-> TextType enumType
-> m (Node [TextTree lbrk fnref style enum special])
hangingTextP' Keyword
kw TextType enumType
t = (Maybe Label
 -> [TextTree lbrk fnref style enum special]
 -> Node [TextTree lbrk fnref style enum special])
-> (Maybe Label, [TextTree lbrk fnref style enum special])
-> Node [TextTree lbrk fnref style enum special]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Label
-> [TextTree lbrk fnref style enum special]
-> Node [TextTree lbrk fnref style enum special]
forall a. Maybe Label -> a -> Node a
Node ((Maybe Label, [TextTree lbrk fnref style enum special])
 -> Node [TextTree lbrk fnref style enum special])
-> m (Maybe Label, [TextTree lbrk fnref style enum special])
-> m (Node [TextTree lbrk fnref style enum special])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Keyword
-> TextType enumType
-> m (Maybe Label, [TextTree lbrk fnref style enum special])
forall (f :: * -> *) (m :: * -> *) lbrk fnref style enumType enum
       special.
(HangingTextP f, ParserWrapper m, LineBreakP lbrk,
 FootnoteRefP fnref, StyleP style, EnumP enumType enum,
 SpecialP m special) =>
Keyword
-> TextType enumType
-> m (f [TextTree lbrk fnref style enum special])
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
Keyword
-> TextType enumType
-> m (Maybe Label, [TextTree lbrk fnref style enum special])
hangingTextP' Keyword
kw TextType enumType
t

instance HangingTextP ((,) Label) where
    hangingTextP' :: forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
Keyword
-> TextType enumType
-> m (Label, [TextTree lbrk fnref style enum special])
hangingTextP' Keyword
kw TextType enumType
t = m Label
-> [Restricted
      (InlineParser m (TextTree lbrk fnref style enum special))]
-> (Maybe Pos -> m (TextTree lbrk fnref style enum special))
-> m (Label, [TextTree lbrk fnref style enum special])
forall (m :: * -> *) a b.
(MonadParser m, FromWhitespace [a]) =>
m b
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> m (b, [a])
hangingBlock' (Keyword -> m Label
forall (m :: * -> *). MonadParser m => Keyword -> m Label
lKeywordP Keyword
kw) [Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
forall (m :: * -> *) lbrk fnref style enum special.
(MonadParser m, LineBreakP lbrk, FootnoteRefP fnref, StyleP style,
 SpecialP m special) =>
[Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
inlinePs (TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, EnumP enumType enum, SpecialP m special) =>
TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
blockPF TextType enumType
t)

instance HangingTextP ((,) (Maybe Label)) where
    hangingTextP' :: forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
Keyword
-> TextType enumType
-> m (Maybe Label, [TextTree lbrk fnref style enum special])
hangingTextP' Keyword
kw TextType enumType
t = m (Maybe Label)
-> [Restricted
      (InlineParser m (TextTree lbrk fnref style enum special))]
-> (Maybe Pos -> m (TextTree lbrk fnref style enum special))
-> m (Maybe Label, [TextTree lbrk fnref style enum special])
forall (m :: * -> *) a b.
(MonadParser m, FromWhitespace [a]) =>
m b
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> m (b, [a])
hangingBlock' (Keyword -> m (Maybe Label)
forall (m :: * -> *). MonadParser m => Keyword -> m (Maybe Label)
mlKeywordP Keyword
kw) [Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
forall (m :: * -> *) lbrk fnref style enum special.
(MonadParser m, LineBreakP lbrk, FootnoteRefP fnref, StyleP style,
 SpecialP m special) =>
[Restricted
   (InlineParser m (TextTree lbrk fnref style enum special))]
inlinePs (TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, EnumP enumType enum, SpecialP m special) =>
TextType enumType
-> Maybe Pos -> m (TextTree lbrk fnref style enum special)
blockPF TextType enumType
t)

class LineBreakP lbrk where
    bracedLineBreakP :: (MonadParser m) => m (MiElementConfig, lbrk)

instance LineBreakP Void where
    bracedLineBreakP :: forall (m :: * -> *). MonadParser m => m (MiElementConfig, Void)
bracedLineBreakP = m (MiElementConfig, Void)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

instance LineBreakP HardLineBreak where
    bracedLineBreakP :: forall (m :: * -> *).
MonadParser m =>
m (MiElementConfig, HardLineBreak)
bracedLineBreakP = (MiElementConfig
cfg, HardLineBreak
HardLineBreak) (MiElementConfig, HardLineBreak)
-> m (Tokens Text) -> m (MiElementConfig, HardLineBreak)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"nl"
      where
        cfg :: MiElementConfig
cfg =
            MiElementConfig
                { miecRetainPrecedingWhitespace :: Bool
miecRetainPrecedingWhitespace = Bool
False
                , miecRetainTrailingWhitespace :: Bool
miecRetainTrailingWhitespace = Bool
False
                }

class StyleP style where
    styleP :: (MonadParser m) => m style

instance StyleP Void where
    styleP :: forall (m :: * -> *). MonadParser m => m Void
styleP = m Void
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

instance StyleP FontStyle where
    styleP :: forall (m :: * -> *). MonadParser m => m FontStyle
styleP =
        FontStyle
Bold FontStyle -> m Char -> m FontStyle
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*'
            m FontStyle -> m FontStyle -> m FontStyle
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FontStyle
Italics FontStyle -> m Char -> m FontStyle
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/'
            m FontStyle -> m FontStyle -> m FontStyle
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FontStyle
Underlined FontStyle -> m Char -> m FontStyle
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_'

class EnumP enumType enum where
    enumP :: Maybe Pos -> enumType -> Parser enum

instance EnumP Void Void where
    enumP :: Maybe Pos -> Void -> Parser Void
enumP Maybe Pos
_ Void
_ = Parser Void
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

instance EnumP EnumType Enumeration where
    enumP :: Maybe Pos -> EnumType -> Parser Enumeration
enumP Maybe Pos
lvl (EnumType Keyword
kw EnumFormat
fmt TextType EnumType
tt) =
        EnumFormat -> [Node EnumItem] -> Enumeration
Enumeration EnumFormat
fmt ([Node EnumItem] -> Enumeration)
-> ParsecT Void Text Identity [Node EnumItem] -> Parser Enumeration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Pos
-> ParsecT Void Text Identity (Node EnumItem)
-> ParsecT Void Text Identity [Node EnumItem]
forall (m :: * -> *) a. MonadParser m => Maybe Pos -> m a -> m [a]
someIndented Maybe Pos
lvl ParsecT Void Text Identity (Node EnumItem)
enumItemP
      where
        enumItemP :: ParsecT Void Text Identity (Node EnumItem)
enumItemP = (Maybe Label -> EnumItem -> Node EnumItem)
-> (Maybe Label, EnumItem) -> Node EnumItem
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Label -> EnumItem -> Node EnumItem
forall a. Maybe Label -> a -> Node a
Node ((Maybe Label, EnumItem) -> Node EnumItem)
-> ((Maybe Label, [RichTextTree]) -> (Maybe Label, EnumItem))
-> (Maybe Label, [RichTextTree])
-> Node EnumItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RichTextTree] -> EnumItem)
-> (Maybe Label, [RichTextTree]) -> (Maybe Label, EnumItem)
forall a b. (a -> b) -> (Maybe Label, a) -> (Maybe Label, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [RichTextTree] -> EnumItem
EnumItem ((Maybe Label, [RichTextTree]) -> Node EnumItem)
-> Parser (Maybe Label, [RichTextTree])
-> ParsecT Void Text Identity (Node EnumItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Keyword
-> TextType EnumType -> Parser (Maybe Label, [RichTextTree])
forall (f :: * -> *) (m :: * -> *) lbrk fnref style enumType enum
       special.
(HangingTextP f, ParserWrapper m, LineBreakP lbrk,
 FootnoteRefP fnref, StyleP style, EnumP enumType enum,
 SpecialP m special) =>
Keyword
-> TextType enumType
-> m (f [TextTree lbrk fnref style enum special])
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
Keyword
-> TextType enumType
-> m (Maybe Label, [TextTree lbrk fnref style enum special])
hangingTextP' Keyword
kw TextType EnumType
tt

class SpecialP m special | special -> m where
    emptySentenceStartP :: m special
    bracedSpecialP :: m (MiElementConfig, Maybe special)
    wordP :: Proxy special -> m Text
    postEnumP :: Proxy special -> m ()

instance SpecialP Parser Void where
    emptySentenceStartP :: Parser Void
emptySentenceStartP = Parser Void
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

    bracedSpecialP :: Parser (MiElementConfig, Maybe Void)
bracedSpecialP = Parser (MiElementConfig, Maybe Void)
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

    wordP :: Proxy Void -> Parser Text
wordP Proxy Void
_ = (Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> Parser Text
forall (m :: * -> *).
MonadParser m =>
(Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> m Text
gWordP Char -> Bool
isWordChar Char -> Bool
isWordSemiSpecialChar Char -> Bool
isWordSpecialChar

    postEnumP :: Proxy Void -> Parser ()
postEnumP Proxy Void
_ = () -> Parser ()
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Parse iff the paragraph state permits an SST and reset the state if
--   parsing successful.
--   Unrelated to 'try'.
sspTry :: ParagraphParser a -> ParagraphParser a
sspTry :: forall a. ParagraphParser a -> ParagraphParser a
sspTry ParagraphParser a
p = StateT Bool (ParsecT Void Text Identity) Bool
forall s (m :: * -> *). MonadState s m => m s
get StateT Bool (ParsecT Void Text Identity) Bool
-> (Bool -> StateT Bool (ParsecT Void Text Identity) ())
-> StateT Bool (ParsecT Void Text Identity) ()
forall a b.
StateT Bool (ParsecT Void Text Identity) a
-> (a -> StateT Bool (ParsecT Void Text Identity) b)
-> StateT Bool (ParsecT Void Text Identity) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> StateT Bool (ParsecT Void Text Identity) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard StateT Bool (ParsecT Void Text Identity) ()
-> ParagraphParser a -> ParagraphParser a
forall a b.
StateT Bool (ParsecT Void Text Identity) a
-> StateT Bool (ParsecT Void Text Identity) b
-> StateT Bool (ParsecT Void Text Identity) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParagraphParser a
p ParagraphParser a
-> StateT Bool (ParsecT Void Text Identity) () -> ParagraphParser a
forall a b.
StateT Bool (ParsecT Void Text Identity) a
-> StateT Bool (ParsecT Void Text Identity) b
-> StateT Bool (ParsecT Void Text Identity) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Bool -> StateT Bool (ParsecT Void Text Identity) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
False)

instance SpecialP ParagraphParser SentenceStart where
    emptySentenceStartP :: ParagraphParser SentenceStart
emptySentenceStartP = ParagraphParser SentenceStart -> ParagraphParser SentenceStart
forall a. ParagraphParser a -> ParagraphParser a
sspTry (ParagraphParser SentenceStart -> ParagraphParser SentenceStart)
-> ParagraphParser SentenceStart -> ParagraphParser SentenceStart
forall a b. (a -> b) -> a -> b
$ SentenceStart -> ParagraphParser SentenceStart
forall a. a -> StateT Bool (ParsecT Void Text Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SentenceStart -> ParagraphParser SentenceStart)
-> SentenceStart -> ParagraphParser SentenceStart
forall a b. (a -> b) -> a -> b
$ Maybe Label -> SentenceStart
SentenceStart Maybe Label
forall a. Maybe a
Nothing

    bracedSpecialP :: ParagraphParser (MiElementConfig, Maybe SentenceStart)
bracedSpecialP =
        (Maybe SentenceStart -> (MiElementConfig, Maybe SentenceStart))
-> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
-> ParagraphParser (MiElementConfig, Maybe SentenceStart)
forall a b.
(a -> b)
-> StateT Bool (ParsecT Void Text Identity) a
-> StateT Bool (ParsecT Void Text Identity) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MiElementConfig
specialCfg,) (StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
 -> ParagraphParser (MiElementConfig, Maybe SentenceStart))
-> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
-> ParagraphParser (MiElementConfig, Maybe SentenceStart)
forall a b. (a -> b) -> a -> b
$
            StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
-> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
forall a. ParagraphParser a -> ParagraphParser a
sspTry (StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
 -> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart))
-> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
-> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
forall a b. (a -> b) -> a -> b
$
                Maybe SentenceStart
forall a. Maybe a
Nothing Maybe SentenceStart
-> StateT Bool (ParsecT Void Text Identity) ()
-> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
forall a b.
a
-> StateT Bool (ParsecT Void Text Identity) b
-> StateT Bool (ParsecT Void Text Identity) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT Bool (ParsecT Void Text Identity) ()
continueP
                    StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
-> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
-> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
forall a.
StateT Bool (ParsecT Void Text Identity) a
-> StateT Bool (ParsecT Void Text Identity) a
-> StateT Bool (ParsecT Void Text Identity) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SentenceStart -> Maybe SentenceStart
forall a. a -> Maybe a
Just (SentenceStart -> Maybe SentenceStart)
-> ParagraphParser SentenceStart
-> StateT Bool (ParsecT Void Text Identity) (Maybe SentenceStart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParagraphParser SentenceStart
labeledSSP
      where
        specialCfg :: MiElementConfig
specialCfg =
            MiElementConfig
                { miecRetainPrecedingWhitespace :: Bool
miecRetainPrecedingWhitespace = Bool
True
                , miecRetainTrailingWhitespace :: Bool
miecRetainTrailingWhitespace = Bool
False
                }

        labeledSSP :: ParagraphParser SentenceStart
labeledSSP = Maybe Label -> SentenceStart
SentenceStart (Maybe Label -> SentenceStart)
-> (Label -> Maybe Label) -> Label -> SentenceStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> Maybe Label
forall a. a -> Maybe a
Just (Label -> SentenceStart)
-> StateT Bool (ParsecT Void Text Identity) Label
-> ParagraphParser SentenceStart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Bool (ParsecT Void Text Identity) Label
forall (m :: * -> *). MonadParser m => m Label
bracedLabelingP

        continueP :: StateT Bool (ParsecT Void Text Identity) ()
continueP = StateT Bool (ParsecT Void Text Identity) Char
-> StateT Bool (ParsecT Void Text Identity) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> StateT Bool (ParsecT Void Text Identity) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>')

    wordP :: Proxy SentenceStart -> ParagraphParser Text
wordP Proxy SentenceStart
_ = ParagraphParser Text
sentenceWordP ParagraphParser Text
-> ParagraphParser Text -> ParagraphParser Text
forall a.
StateT Bool (ParsecT Void Text Identity) a
-> StateT Bool (ParsecT Void Text Identity) a
-> StateT Bool (ParsecT Void Text Identity) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParagraphParser Text
sentenceEndP
      where
        sentenceWordP :: ParagraphParser Text
        sentenceWordP :: ParagraphParser Text
sentenceWordP =
            (Char -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> ParagraphParser Text
forall (m :: * -> *).
MonadParser m =>
(Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> m Text
gWordP Char -> Bool
isWordChar Char -> Bool
isWordSemiSpecialChar Char -> Bool
isSentenceSpecialChar

        sentenceEndP :: ParagraphParser Text
        sentenceEndP :: ParagraphParser Text
sentenceEndP = Char -> Text
Text.singleton (Char -> Text)
-> StateT Bool (ParsecT Void Text Identity) Char
-> ParagraphParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool)
-> StateT Bool (ParsecT Void Text Identity) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isSentenceEndChar ParagraphParser Text
-> StateT Bool (ParsecT Void Text Identity) ()
-> ParagraphParser Text
forall a b.
StateT Bool (ParsecT Void Text Identity) a
-> StateT Bool (ParsecT Void Text Identity) b
-> StateT Bool (ParsecT Void Text Identity) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Bool -> StateT Bool (ParsecT Void Text Identity) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
True

    -- An enumeration ends a sentence.
    postEnumP :: Proxy SentenceStart -> StateT Bool (ParsecT Void Text Identity) ()
postEnumP Proxy SentenceStart
_ = Bool -> StateT Bool (ParsecT Void Text Identity) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
True

class FootnoteRefP fnref where
    bracedFootnoteRefP :: (MonadParser m) => m fnref

instance FootnoteRefP Void where
    bracedFootnoteRefP :: forall (m :: * -> *). MonadParser m => m Void
bracedFootnoteRefP = m Void
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

instance FootnoteRefP FootnoteReference where
    bracedFootnoteRefP :: forall (m :: * -> *). MonadParser m => m FootnoteReference
bracedFootnoteRefP = Label -> FootnoteReference
FootnoteReference (Label -> FootnoteReference)
-> m (Tokens Text) -> m (Label -> FootnoteReference)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"^:" m (Label -> FootnoteReference) -> m Label -> m FootnoteReference
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Label
forall (m :: * -> *). MonadParser m => m Label
labelP

-- | Construct a word parser.
--
--   The first predicate determines valid characters, the second semi-special
--   characters, and the third special characters.
--
--   ASCII spaces and newlines must not count as valid.
--
--   Only valid characters are permitted in a word.
--
--   All valid characters may be escaped.
--   Special characters must be escaped.
--
--   Semi-special characters, if unescaped, form a full word.
gWordP
    :: (MonadParser m)
    => (Char -> Bool)
    -> (Char -> Bool)
    -> (Char -> Bool)
    -> m Text
gWordP :: forall (m :: * -> *).
MonadParser m =>
(Char -> Bool) -> (Char -> Bool) -> (Char -> Bool) -> m Text
gWordP Char -> Bool
isValid Char -> Bool
isSemiSpecial Char -> Bool
isSpecial =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text -> m [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (m Text
forall (m :: * -> *). MonadParser m => m Text
regularWordP m Text -> m Text -> m Text
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Text
forall (m :: * -> *). MonadParser m => m Text
escapedCharP) m Text -> m Text -> m Text
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Text
forall (m :: * -> *). MonadParser m => m Text
semiSpecialCharP
  where
    regularWordP :: (MonadParser m) => m Text
    regularWordP :: forall (m :: * -> *). MonadParser m => m Text
regularWordP = Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"regular character") Char -> Bool
Token Text -> Bool
isRegular
      where
        isRegular :: Char -> Bool
        isRegular :: Char -> Bool
isRegular Char
c = Char -> Bool
isValid Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSemiSpecial Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpecial Char
c)

    semiSpecialCharP :: (MonadParser m) => m Text
    semiSpecialCharP :: forall (m :: * -> *). MonadParser m => m Text
semiSpecialCharP = Char -> Text
Text.singleton (Char -> Text) -> m Char -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isSemiSpecial

    escapedCharP :: (MonadParser m) => m Text
    escapedCharP :: forall (m :: * -> *). MonadParser m => m Text
escapedCharP =
        Char -> Text
Text.singleton
            (Char -> Text) -> m Char -> m (Char -> Text)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\'
            m (Char -> Text) -> m Char -> m Text
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isValid
                    -- The lookAhead is purely for better error messages.
                    m Char -> m Char -> m Char
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\\' Char -> m (Token Text) -> m Char
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m (Token Text) -> m (Token Text)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ((Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isWordSepChar)
                )

-- TODO?: Handle `/`.
rawWordP :: (MonadParser m) => m Text
rawWordP :: forall (m :: * -> *). MonadParser m => m Text
rawWordP = Maybe String -> (Token Text -> Bool) -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"word character") Char -> Bool
Token Text -> Bool
isWordChar

isWordSepChar :: Char -> Bool
isWordSepChar :: Char -> Bool
isWordSepChar Char
' ' = Bool
True
isWordSepChar Char
'\n' = Bool
True
isWordSepChar Char
_ = Bool
False

-- NOTE: isControl '\n' == True
isWordChar :: Char -> Bool
isWordChar :: Char -> Bool
isWordChar Char
' ' = Bool
False
isWordChar Char
c = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
Char.isControl Char
c

isWordSemiSpecialChar :: Char -> Bool
isWordSemiSpecialChar :: Char -> Bool
isWordSemiSpecialChar Char
'{' = Bool
True
isWordSemiSpecialChar Char
'<' = Bool
True
isWordSemiSpecialChar Char
'|' = Bool
True
isWordSemiSpecialChar Char
c = Char -> Bool
isLineCommentPrefixFirstChar Char
c

isWordSpecialChar :: Char -> Bool
isWordSpecialChar :: Char -> Bool
isWordSpecialChar Char
'\\' = Bool
True
isWordSpecialChar Char
'>' = Bool
True
isWordSpecialChar Char
'~' = Bool
True
isWordSpecialChar Char
_ = Bool
False

isSentenceEndChar :: Char -> Bool
isSentenceEndChar :: Char -> Bool
isSentenceEndChar Char
'.' = Bool
True
isSentenceEndChar Char
'!' = Bool
True
isSentenceEndChar Char
'?' = Bool
True
isSentenceEndChar Char
_ = Bool
False

isSentenceSpecialChar :: Char -> Bool
isSentenceSpecialChar :: Char -> Bool
isSentenceSpecialChar Char
c = Char -> Bool
isWordSpecialChar Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSentenceEndChar Char
c