-- | The parser for Unison’s @Doc@ syntax.
--
--   This is completely independent of the Unison language, and requires a couple parsers to be passed in to then
--   provide a parser for @Doc@ applied to any host language.
--
-- - an identifer parser
-- - a code parser (that accepts a termination parser)
-- - a termination parser, for this parser to know when to give up
--
-- Each of those parsers is expected to satisfy @(`Ord` e, `P.MonadParsec` e `String` m)@.
module Unison.Syntax.Parser.Doc
  ( Tree,
    Leaves,
    initialEnv,
    doc,
    untitledSection,
    sectionElem,
    leaf,

    -- * section elements
    section,
    eval,
    exampleBlock,
    codeBlock,
    list,
    bulletedList,
    numberedList,
    paragraph,

    -- * leaves
    link,
    namedLink,
    example,
    transclude,
    bold,
    italic,
    strikethrough,
    verbatim,
    source,
    foldedSource,
    evalInline,
    signatures,
    signatureInline,
    group,
    word,

    -- * other components
    column',
    embedLink,
    embedSignatureLink,
    join,
  )
where

import Control.Comonad.Cofree (Cofree ((:<)))
import Control.Monad.Reader qualified as R
import Data.Char (isControl, isSpace)
import Data.List qualified as List
import Data.List.Extra qualified as List
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NonEmpty
import Text.Megaparsec qualified as P
import Text.Megaparsec.Char (char)
import Text.Megaparsec.Char qualified as CP
import Text.Megaparsec.Char.Lexer qualified as LP
import Unison.Parser.Ann (Ann (Ann))
import Unison.Prelude hiding (Word, join)
import Unison.Syntax.Lexer (column, line, lit, sepBy1', some', someTill', (<+>))
import Unison.Syntax.Lexer.Token (Token (Token), posP, tokenP)
import Unison.Syntax.Parser.Doc.Data
import Prelude hiding (Word)

type Leaves ident code = Cofree (Leaf ident code) Ann

type Tree ident code = Cofree (Top code (Leaves ident code)) Ann

data ParsingEnv = ParsingEnv
  { -- | Use a stack to remember the parent section and allow docSections within docSections.
    -- - 1 means we are inside a # Heading 1
    ParsingEnv -> [Int]
parentSections :: [Int],
    -- | 4 means we are inside a list starting at the fourth column
    ParsingEnv -> Int
parentListColumn :: Int
  }
  deriving (Int -> ParsingEnv -> ShowS
[ParsingEnv] -> ShowS
ParsingEnv -> [Char]
(Int -> ParsingEnv -> ShowS)
-> (ParsingEnv -> [Char])
-> ([ParsingEnv] -> ShowS)
-> Show ParsingEnv
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParsingEnv -> ShowS
showsPrec :: Int -> ParsingEnv -> ShowS
$cshow :: ParsingEnv -> [Char]
show :: ParsingEnv -> [Char]
$cshowList :: [ParsingEnv] -> ShowS
showList :: [ParsingEnv] -> ShowS
Show)

initialEnv :: ParsingEnv
initialEnv :: ParsingEnv
initialEnv = [Int] -> Int -> ParsingEnv
ParsingEnv [Int
0] Int
0

doc ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m end ->
  m (UntitledSection (Tree ident code))
doc :: forall e (m :: * -> *) ident code end.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m end
-> m (UntitledSection (Tree ident code))
doc m ident
ident m () -> m code
code = (ReaderT ParsingEnv m (UntitledSection (Tree ident code))
 -> ParsingEnv -> m (UntitledSection (Tree ident code)))
-> ParsingEnv
-> ReaderT ParsingEnv m (UntitledSection (Tree ident code))
-> m (UntitledSection (Tree ident code))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT ParsingEnv m (UntitledSection (Tree ident code))
-> ParsingEnv -> m (UntitledSection (Tree ident code))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT ParsingEnv
initialEnv (ReaderT ParsingEnv m (UntitledSection (Tree ident code))
 -> m (UntitledSection (Tree ident code)))
-> (m end
    -> ReaderT ParsingEnv m (UntitledSection (Tree ident code)))
-> m end
-> m (UntitledSection (Tree ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ParsingEnv m (Tree ident code)
-> ReaderT ParsingEnv m (UntitledSection (Tree ident code))
forall e (m :: * -> *) a.
MonadParsec e [Char] m =>
m a -> m (UntitledSection a)
untitledSection (ReaderT ParsingEnv m (Tree ident code)
 -> ReaderT ParsingEnv m (UntitledSection (Tree ident code)))
-> (m end -> ReaderT ParsingEnv m (Tree ident code))
-> m end
-> ReaderT ParsingEnv m (UntitledSection (Tree ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
  ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT ParsingEnv m (Tree ident code)
forall e s (m :: * -> *) (f :: * -> *).
(Ord e, MonadParsec e s m, TraversableStream s) =>
m (f (Cofree f Ann)) -> m (Cofree f Ann)
wrap (ReaderT
   ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
 -> ReaderT ParsingEnv m (Tree ident code))
-> (m end
    -> ReaderT
         ParsingEnv m (Top code (Leaves ident code) (Tree ident code)))
-> m end
-> ReaderT ParsingEnv m (Tree ident code)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ident
-> (m () -> m code)
-> m ()
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
sectionElem m ident
ident m () -> m code
code (m ()
 -> ReaderT
      ParsingEnv m (Top code (Leaves ident code) (Tree ident code)))
-> (m end -> m ())
-> m end
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m end -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

-- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that
--   Unison wraps `Doc` literals in `}}`).
untitledSection :: (P.MonadParsec e String m) => m a -> m (UntitledSection a)
untitledSection :: forall e (m :: * -> *) a.
MonadParsec e [Char] m =>
m a -> m (UntitledSection a)
untitledSection m a
a = [a] -> UntitledSection a
forall a. [a] -> UntitledSection a
UntitledSection ([a] -> UntitledSection a) -> m [a] -> m (UntitledSection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (m a
a m a -> m () -> m a
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space)

sectionElem ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  R.ReaderT ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
sectionElem :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
sectionElem m ident
ident m () -> m code
code m ()
docClose =
  m ident
-> (m () -> m code)
-> m ()
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
section m ident
ident m () -> m code
code m ()
docClose
    ReaderT
  ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall a.
ReaderT ParsingEnv m a
-> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall (m :: * -> *) a. Monad m => m a -> ReaderT ParsingEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([Char]
-> m (Top code (Leaves ident code) (Tree ident code))
-> m (Top code (Leaves ident code) (Tree ident code))
forall a. [Char] -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
"block eval (syntax: a fenced code block)" ((m () -> m code)
-> m (Top code (Leaves ident code) (Tree ident code))
forall e (m :: * -> *) code ident.
MonadParsec e [Char] m =>
(m () -> m code)
-> m (Top code (Leaves ident code) (Tree ident code))
eval m () -> m code
code m (Top code (Leaves ident code) (Tree ident code))
-> m (Top code (Leaves ident code) (Tree ident code))
-> m (Top code (Leaves ident code) (Tree ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m () -> m code)
-> m (Top code (Leaves ident code) (Tree ident code))
forall e (m :: * -> *) code ident.
MonadParsec e [Char] m =>
(m () -> m code)
-> m (Top code (Leaves ident code) (Tree ident code))
exampleBlock m () -> m code
code m (Top code (Leaves ident code) (Tree ident code))
-> m (Top code (Leaves ident code) (Tree ident code))
-> m (Top code (Leaves ident code) (Tree ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Top code (Leaves ident code) (Tree ident code))
forall e (m :: * -> *) code ident.
(Ord e, MonadParsec e [Char] m) =>
m (Top code (Leaves ident code) (Tree ident code))
codeBlock))
    ReaderT
  ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall a.
ReaderT ParsingEnv m a
-> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (List (Leaves ident code)
 -> Top code (Leaves ident code) (Tree ident code))
-> ReaderT ParsingEnv m (List (Leaves ident code))
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall a b.
(a -> b) -> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List (Leaves ident code)
-> Top code (Leaves ident code) (Tree ident code)
forall code leaf a. List leaf -> Top code leaf a
List' (m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
list m ident
ident m () -> m code
code m ()
docClose)
    ReaderT
  ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall a.
ReaderT ParsingEnv m a
-> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall (m :: * -> *) a. Monad m => m a -> ReaderT ParsingEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Paragraph (Leaves ident code)
-> Top code (Leaves ident code) (Tree ident code)
forall code leaf a. Paragraph leaf -> Top code leaf a
Paragraph' (Paragraph (Leaves ident code)
 -> Top code (Leaves ident code) (Tree ident code))
-> m (Paragraph (Leaves ident code))
-> m (Top code (Leaves ident code) (Tree ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ident
-> (m () -> m code) -> m () -> m (Paragraph (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code) -> m () -> m (Paragraph (Leaves ident code))
paragraph m ident
ident m () -> m code
code m ()
docClose)

paragraph ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  m (Paragraph (Leaves ident code))
paragraph :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code) -> m () -> m (Paragraph (Leaves ident code))
paragraph m ident
ident m () -> m code
code m ()
docClose = (NonEmpty (Leaves ident code) -> Paragraph (Leaves ident code))
-> m (NonEmpty (Leaves ident code))
-> m (Paragraph (Leaves ident code))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (Leaves ident code) -> Paragraph (Leaves ident code)
forall a. NonEmpty a -> Paragraph a
Paragraph (m (NonEmpty (Leaves ident code))
 -> m (Paragraph (Leaves ident code)))
-> (m (Leaves ident code) -> m (NonEmpty (Leaves ident code)))
-> m (Leaves ident code)
-> m (Paragraph (Leaves ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m (Leaves ident code) -> m (NonEmpty (Leaves ident code))
forall e (m :: * -> *) a.
MonadParsec e [Char] m =>
m () -> m a -> m (NonEmpty a)
spaced m ()
docClose (m (Leaves ident code) -> m (Paragraph (Leaves ident code)))
-> m (Leaves ident code) -> m (Paragraph (Leaves ident code))
forall a b. (a -> b) -> a -> b
$ m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
leafy m ident
ident m () -> m code
code m ()
docClose

word :: (Ord e, P.MonadParsec e String m) => m end -> m Word
word :: forall e (m :: * -> *) end.
(Ord e, MonadParsec e [Char] m) =>
m end -> m Word
word m end
closing = ([Char] -> Word) -> m [Char] -> m Word
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Word
Word (m [Char] -> m Word)
-> (m [Char] -> m [Char]) -> m [Char] -> m Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m [Char] -> m [Char]
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m [Char] -> m Word) -> m [Char] -> m Word
forall a b. (a -> b) -> a -> b
$ do
  let end :: m ()
end = m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m (Token [Char]) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Token [Char] -> Bool) -> m (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
Token [Char] -> Bool
isSpace) m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m end -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m end
closing
  [Char]
word <- m Char -> m () -> m [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill ((Token [Char] -> Bool) -> m (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (\Token [Char]
ch -> Bool -> Bool
not (Char -> Bool
isSpace Char
Token [Char]
ch))) m ()
end
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
reserved [Char]
word Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
word)
  pure [Char]
word
  where
    reserved :: [Char] -> Bool
reserved [Char]
word = [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf [Char]
"}}" [Char]
word Bool -> Bool -> Bool
|| (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') [Char]
word

leaf ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  m (Leaf ident code (Leaves ident code))
leaf :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
leaf m ident
ident m () -> m code
code m ()
closing =
  m ident -> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (Leaf ident code a)
link m ident
ident
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
namedLink m ident
ident m () -> m code
code m ()
closing
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m () -> m code) -> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) code ident void.
MonadParsec e [Char] m =>
(m () -> m code) -> m (Leaf ident code void)
example m () -> m code
code
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Transclude code -> Leaf ident code (Leaves ident code)
forall ident code a. Transclude code -> Leaf ident code a
Transclude' (Transclude code -> Leaf ident code (Leaves ident code))
-> m (Transclude code) -> m (Leaf ident code (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m () -> m code) -> m (Transclude code)
forall e (m :: * -> *) code.
MonadParsec e [Char] m =>
(m () -> m code) -> m (Transclude code)
transclude m () -> m code
code)
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
bold m ident
ident m () -> m code
code m ()
closing
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
italic m ident
ident m () -> m code
code m ()
closing
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
strikethrough m ident
ident m () -> m code
code m ()
closing
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m (Leaf ident code a)
verbatim
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ident
-> (m () -> m code) -> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m (Leaf ident code a)
source m ident
ident m () -> m code
code
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ident
-> (m () -> m code) -> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m (Leaf ident code a)
foldedSource m ident
ident m () -> m code
code
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m () -> m code) -> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) code ident void.
MonadParsec e [Char] m =>
(m () -> m code) -> m (Leaf ident code void)
evalInline m () -> m code
code
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ident -> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (Leaf ident code a)
signatures m ident
ident
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ident -> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (Leaf ident code a)
signatureInline m ident
ident
    m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word -> Leaf ident code (Leaves ident code)
forall ident code a. Word -> Leaf ident code a
Word' (Word -> Leaf ident code (Leaves ident code))
-> m Word -> m (Leaf ident code (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m () -> m Word
forall e (m :: * -> *) end.
(Ord e, MonadParsec e [Char] m) =>
m end -> m Word
word m ()
closing)

leafy ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  m (Leaves ident code)
leafy :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
leafy m ident
ident m () -> m code
code m ()
closing = do
  Leaves ident code
p <- m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code)
forall e s (m :: * -> *) (f :: * -> *).
(Ord e, MonadParsec e s m, TraversableStream s) =>
m (f (Cofree f Ann)) -> m (Cofree f Ann)
wrap (m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code))
-> m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code)
forall a b. (a -> b) -> a -> b
$ m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
leaf m ident
ident m () -> m code
code m ()
closing
  Maybe (Leaves ident code)
after <- m (Leaves ident code) -> m (Maybe (Leaves ident code))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (m (Leaves ident code) -> m (Maybe (Leaves ident code)))
-> (m (Leaves ident code) -> m (Leaves ident code))
-> m (Leaves ident code)
-> m (Maybe (Leaves ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Leaves ident code) -> m (Leaves ident code)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m (Leaves ident code) -> m (Maybe (Leaves ident code)))
-> m (Leaves ident code) -> m (Maybe (Leaves ident code))
forall a b. (a -> b) -> a -> b
$ m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
leafy m ident
ident m () -> m code
code m ()
closing
  case Maybe (Leaves ident code)
after of
    Maybe (Leaves ident code)
Nothing -> Leaves ident code -> m (Leaves ident code)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Leaves ident code
p
    Just Leaves ident code
after -> m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code)
forall e s (m :: * -> *) (f :: * -> *).
(Ord e, MonadParsec e s m, TraversableStream s) =>
m (f (Cofree f Ann)) -> m (Cofree f Ann)
wrap (m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code))
-> (NonEmpty (Leaves ident code)
    -> m (Leaf ident code (Leaves ident code)))
-> NonEmpty (Leaves ident code)
-> m (Leaves ident code)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Group (Leaves ident code) -> Leaf ident code (Leaves ident code))
-> m (Group (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group (Leaves ident code) -> Leaf ident code (Leaves ident code)
forall ident code a. Group a -> Leaf ident code a
Group' (m (Group (Leaves ident code))
 -> m (Leaf ident code (Leaves ident code)))
-> (NonEmpty (Leaves ident code) -> m (Group (Leaves ident code)))
-> NonEmpty (Leaves ident code)
-> m (Leaf ident code (Leaves ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (NonEmpty (Leaves ident code)) -> m (Group (Leaves ident code))
forall e s (m :: * -> *) ident code.
MonadParsec e s m =>
m (NonEmpty (Leaves ident code)) -> m (Group (Leaves ident code))
group (m (NonEmpty (Leaves ident code)) -> m (Group (Leaves ident code)))
-> (NonEmpty (Leaves ident code)
    -> m (NonEmpty (Leaves ident code)))
-> NonEmpty (Leaves ident code)
-> m (Group (Leaves ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Leaves ident code) -> m (NonEmpty (Leaves ident code))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (Leaves ident code) -> m (Leaves ident code))
-> NonEmpty (Leaves ident code) -> m (Leaves ident code)
forall a b. (a -> b) -> a -> b
$ Leaves ident code
p Leaves ident code
-> [Leaves ident code] -> NonEmpty (Leaves ident code)
forall a. a -> [a] -> NonEmpty a
:| Leaves ident code -> [Leaves ident code]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Leaves ident code
after

comma :: (P.MonadParsec e String m) => m String
comma :: forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
comma = [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"," m [Char] -> m () -> m [Char]
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space

source :: (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m (Leaf ident code a)
source :: forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m (Leaf ident code a)
source m ident
ident = (NonEmpty (SourceElement ident (Transclude code))
 -> Leaf ident code a)
-> m (NonEmpty (SourceElement ident (Transclude code)))
-> m (Leaf ident code a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
forall ident code a.
NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
Source (m (NonEmpty (SourceElement ident (Transclude code)))
 -> m (Leaf ident code a))
-> ((m () -> m code)
    -> m (NonEmpty (SourceElement ident (Transclude code))))
-> (m () -> m code)
-> m (Leaf ident code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"@source" m [Char]
-> m (NonEmpty (SourceElement ident (Transclude code)))
-> m (NonEmpty (SourceElement ident (Transclude code)))
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (m (NonEmpty (SourceElement ident (Transclude code)))
 -> m (NonEmpty (SourceElement ident (Transclude code))))
-> ((m () -> m code)
    -> m (NonEmpty (SourceElement ident (Transclude code))))
-> (m () -> m code)
-> m (NonEmpty (SourceElement ident (Transclude code)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ident
-> (m () -> m code)
-> m (NonEmpty (SourceElement ident (Transclude code)))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m (NonEmpty (SourceElement ident (Transclude code)))
sourceElements m ident
ident

foldedSource :: (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m (Leaf ident code a)
foldedSource :: forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m (Leaf ident code a)
foldedSource m ident
ident = (NonEmpty (SourceElement ident (Transclude code))
 -> Leaf ident code a)
-> m (NonEmpty (SourceElement ident (Transclude code)))
-> m (Leaf ident code a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
forall ident code a.
NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
FoldedSource (m (NonEmpty (SourceElement ident (Transclude code)))
 -> m (Leaf ident code a))
-> ((m () -> m code)
    -> m (NonEmpty (SourceElement ident (Transclude code))))
-> (m () -> m code)
-> m (Leaf ident code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"@foldedSource" m [Char]
-> m (NonEmpty (SourceElement ident (Transclude code)))
-> m (NonEmpty (SourceElement ident (Transclude code)))
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (m (NonEmpty (SourceElement ident (Transclude code)))
 -> m (NonEmpty (SourceElement ident (Transclude code))))
-> ((m () -> m code)
    -> m (NonEmpty (SourceElement ident (Transclude code))))
-> (m () -> m code)
-> m (NonEmpty (SourceElement ident (Transclude code)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ident
-> (m () -> m code)
-> m (NonEmpty (SourceElement ident (Transclude code)))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m (NonEmpty (SourceElement ident (Transclude code)))
sourceElements m ident
ident

sourceElements ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m (NonEmpty (SourceElement ident (Transclude code)))
sourceElements :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m (NonEmpty (SourceElement ident (Transclude code)))
sourceElements m ident
ident m () -> m code
code = do
  ()
_ <- ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
" {" 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] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"{") m [Char] -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space
  NonEmpty (SourceElement ident (Transclude code))
s <- m (SourceElement ident (Transclude code))
-> m [Char] -> m (NonEmpty (SourceElement ident (Transclude code)))
forall e s (m :: * -> *) a sep.
MonadParsec e s m =>
m a -> m sep -> m (NonEmpty a)
sepBy1' m (SourceElement ident (Transclude code))
srcElem m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
comma
  [Char]
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"}"
  pure NonEmpty (SourceElement ident (Transclude code))
s
  where
    srcElem :: m (SourceElement ident (Transclude code))
srcElem =
      EmbedLink ident
-> [EmbedAnnotation ident (Transclude code)]
-> SourceElement ident (Transclude code)
forall ident a.
EmbedLink ident
-> [EmbedAnnotation ident a] -> SourceElement ident a
SourceElement
        (EmbedLink ident
 -> [EmbedAnnotation ident (Transclude code)]
 -> SourceElement ident (Transclude code))
-> m (EmbedLink ident)
-> m ([EmbedAnnotation ident (Transclude code)]
      -> SourceElement ident (Transclude code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ident -> m (EmbedLink ident)
forall e s (m :: * -> *) ident.
(Ord e, MonadParsec e s m, TraversableStream s) =>
m ident -> m (EmbedLink ident)
embedLink m ident
ident
        m ([EmbedAnnotation ident (Transclude code)]
   -> SourceElement ident (Transclude code))
-> m [EmbedAnnotation ident (Transclude code)]
-> m (SourceElement ident (Transclude code))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (Maybe [EmbedAnnotation ident (Transclude code)]
 -> [EmbedAnnotation ident (Transclude code)])
-> m (Maybe [EmbedAnnotation ident (Transclude code)])
-> m [EmbedAnnotation ident (Transclude code)]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([EmbedAnnotation ident (Transclude code)]
-> Maybe [EmbedAnnotation ident (Transclude code)]
-> [EmbedAnnotation ident (Transclude code)]
forall a. a -> Maybe a -> a
fromMaybe []) (m (Maybe [EmbedAnnotation ident (Transclude code)])
 -> m [EmbedAnnotation ident (Transclude code)])
-> (m [EmbedAnnotation ident (Transclude code)]
    -> m (Maybe [EmbedAnnotation ident (Transclude code)]))
-> m [EmbedAnnotation ident (Transclude code)]
-> m [EmbedAnnotation ident (Transclude code)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m [EmbedAnnotation ident (Transclude code)]
-> m (Maybe [EmbedAnnotation ident (Transclude code)])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (m [EmbedAnnotation ident (Transclude code)]
 -> m [EmbedAnnotation ident (Transclude code)])
-> m [EmbedAnnotation ident (Transclude code)]
-> m [EmbedAnnotation ident (Transclude code)]
forall a b. (a -> b) -> a -> b
$
                ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"@") m [Char]
-> m [EmbedAnnotation ident (Transclude code)]
-> m [EmbedAnnotation ident (Transclude code)]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space m ()
-> m [EmbedAnnotation ident (Transclude code)]
-> m [EmbedAnnotation ident (Transclude code)]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m [EmbedAnnotation ident (Transclude code)]
annotations)
            )
      where
        annotation :: m (Either ident (Transclude code))
annotation = (ident -> Either ident (Transclude code))
-> m ident -> m (Either ident (Transclude code))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ident -> Either ident (Transclude code)
forall a b. a -> Either a b
Left m ident
ident m (Either ident (Transclude code))
-> m (Either ident (Transclude code))
-> m (Either ident (Transclude code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Transclude code -> Either ident (Transclude code))
-> m (Transclude code) -> m (Either ident (Transclude code))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transclude code -> Either ident (Transclude code)
forall a b. b -> Either a b
Right ((m () -> m code) -> m (Transclude code)
forall e (m :: * -> *) code.
MonadParsec e [Char] m =>
(m () -> m code) -> m (Transclude code)
transclude m () -> m code
code) m (Either ident (Transclude code))
-> m () -> m (Either ident (Transclude code))
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space
        annotations :: m [EmbedAnnotation ident (Transclude code)]
annotations = m (EmbedAnnotation ident (Transclude code))
-> m [EmbedAnnotation ident (Transclude code)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some (Either ident (Transclude code)
-> EmbedAnnotation ident (Transclude code)
forall ident a. Either ident a -> EmbedAnnotation ident a
EmbedAnnotation (Either ident (Transclude code)
 -> EmbedAnnotation ident (Transclude code))
-> m (Either ident (Transclude code))
-> m (EmbedAnnotation ident (Transclude code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Either ident (Transclude code))
annotation)

signatures :: (Ord e, P.MonadParsec e String m) => m ident -> m (Leaf ident code a)
signatures :: forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (Leaf ident code a)
signatures m ident
ident = (NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a)
-> m (NonEmpty (EmbedSignatureLink ident)) -> m (Leaf ident code a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a
forall ident code a.
NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a
Signature (m (NonEmpty (EmbedSignatureLink ident)) -> m (Leaf ident code a))
-> m (NonEmpty (EmbedSignatureLink ident)) -> m (Leaf ident code a)
forall a b. (a -> b) -> a -> b
$ do
  ()
_ <- ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"@signatures" 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] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"@signature") m [Char] -> m [Char] -> m [Char]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
" {" 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] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"{") m [Char] -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space
  NonEmpty (EmbedSignatureLink ident)
s <- m (EmbedSignatureLink ident)
-> m [Char] -> m (NonEmpty (EmbedSignatureLink ident))
forall e s (m :: * -> *) a sep.
MonadParsec e s m =>
m a -> m sep -> m (NonEmpty a)
sepBy1' (m ident -> m (EmbedSignatureLink ident)
forall e (m :: * -> *) ident.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (EmbedSignatureLink ident)
embedSignatureLink m ident
ident) m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
comma
  [Char]
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"}"
  pure NonEmpty (EmbedSignatureLink ident)
s

signatureInline :: (Ord e, P.MonadParsec e String m) => m ident -> m (Leaf ident code a)
signatureInline :: forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (Leaf ident code a)
signatureInline m ident
ident = (EmbedSignatureLink ident -> Leaf ident code a)
-> m (EmbedSignatureLink ident) -> m (Leaf ident code a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EmbedSignatureLink ident -> Leaf ident code a
forall ident code a. EmbedSignatureLink ident -> Leaf ident code a
SignatureInline (m (EmbedSignatureLink ident) -> m (Leaf ident code a))
-> m (EmbedSignatureLink ident) -> m (Leaf ident code a)
forall a b. (a -> b) -> a -> b
$ do
  ()
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"@inlineSignature" m [Char] -> m [Char] -> m [Char]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
" {" 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] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"{") m [Char] -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space
  EmbedSignatureLink ident
s <- m ident -> m (EmbedSignatureLink ident)
forall e (m :: * -> *) ident.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (EmbedSignatureLink ident)
embedSignatureLink m ident
ident
  [Char]
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"}"
  pure EmbedSignatureLink ident
s

evalInline :: (P.MonadParsec e String m) => (m () -> m code) -> m (Leaf ident code a)
evalInline :: forall e (m :: * -> *) code ident void.
MonadParsec e [Char] m =>
(m () -> m code) -> m (Leaf ident code void)
evalInline m () -> m code
code = (code -> Leaf ident code a) -> m code -> m (Leaf ident code a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap code -> Leaf ident code a
forall ident code a. code -> Leaf ident code a
EvalInline (m code -> m (Leaf ident code a))
-> m code -> m (Leaf ident code a)
forall a b. (a -> b) -> a -> b
$ do
  ()
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"@eval" m [Char] -> m [Char] -> m [Char]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
" {" 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] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"{") m [Char] -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space
  let inlineEvalClose :: m ()
inlineEvalClose = 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
$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"}"
  code
s <- m () -> m code
code m ()
inlineEvalClose
  pure code
s

-- | Not an actual node, but this pattern is referenced in multiple places
embedLink :: (Ord e, P.MonadParsec e s m, P.TraversableStream s) => m ident -> m (EmbedLink ident)
embedLink :: forall e s (m :: * -> *) ident.
(Ord e, MonadParsec e s m, TraversableStream s) =>
m ident -> m (EmbedLink ident)
embedLink = (ident -> EmbedLink ident) -> m ident -> m (EmbedLink ident)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ident -> EmbedLink ident
forall a. a -> EmbedLink a
EmbedLink

embedSignatureLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedSignatureLink ident)
embedSignatureLink :: forall e (m :: * -> *) ident.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (EmbedSignatureLink ident)
embedSignatureLink m ident
ident = ident -> EmbedSignatureLink ident
forall a. a -> EmbedSignatureLink a
EmbedSignatureLink (ident -> EmbedSignatureLink ident)
-> m ident -> m (EmbedSignatureLink ident)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ident
ident m (EmbedSignatureLink ident)
-> m () -> m (EmbedSignatureLink ident)
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space

verbatim :: (Ord e, P.MonadParsec e String m) => m (Leaf ident code a)
verbatim :: forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m (Leaf ident code a)
verbatim =
  [Char] -> m (Leaf ident code a) -> m (Leaf ident code a)
forall a. [Char] -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
"code (examples: ''**unformatted**'', `words` or '''_words_''')" (m (Leaf ident code a) -> m (Leaf ident code a))
-> m (Leaf ident code a) -> m (Leaf ident code a)
forall a b. (a -> b) -> a -> b
$ do
    Token [Char]
originalText Pos
start Pos
stop <- m [Char] -> m (Token [Char])
forall e s (m :: * -> *) a.
(Ord e, TraversableStream s, MonadParsec e s m) =>
m a -> m (Token a)
tokenP do
      -- a single backtick followed by a non-backtick is treated as monospaced
      let tick :: m [Char]
tick = m [Char] -> m [Char]
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"`" m [Char] -> m (Token [Char]) -> m [Char]
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m (Token [Char]) -> m (Token [Char])
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead ((Token [Char] -> Bool) -> m (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Token [Char] -> Token [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token [Char]
'`')))
      -- also two or more ' followed by that number of closing '
      [Char]
quotes <- m [Char]
tick 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] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"''" m [Char] -> m [Char] -> m [Char]
forall (f :: * -> *) a.
(Applicative f, Monoid a) =>
f a -> f a -> f a
<+> Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Token [Char] -> Token [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token [Char]
'\''))
      m Char -> m [Char] -> m [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.someTill m Char
m (Token [Char])
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
P.anySingle ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
quotes)
    let isMultiLine :: Bool
isMultiLine = Pos -> Int
line Pos
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Pos -> Int
line Pos
stop
    Leaf ident code a -> m (Leaf ident code a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      if Bool
isMultiLine
        then
          let trimmed :: [Char]
trimmed = (ShowS
trimAroundDelimiters [Char]
originalText)
              txt :: [Char]
txt = Int -> ShowS
trimIndentFromVerbatimBlock (Pos -> Int
column Pos
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Char]
trimmed
           in -- If it's a multi-line verbatim block we trim any whitespace representing
              -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock'
              Word -> Leaf ident code a
forall ident code a. Word -> Leaf ident code a
Verbatim (Word -> Leaf ident code a)
-> ([Char] -> Word) -> [Char] -> Leaf ident code a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Word
Word ([Char] -> Leaf ident code a) -> [Char] -> Leaf ident code a
forall a b. (a -> b) -> a -> b
$ [Char]
txt
        else Word -> Leaf ident code a
forall ident code a. Word -> Leaf ident code a
Code (Word -> Leaf ident code a)
-> ([Char] -> Word) -> [Char] -> Leaf ident code a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Word
Word ([Char] -> Leaf ident code a) -> [Char] -> Leaf ident code a
forall a b. (a -> b) -> a -> b
$ [Char]
originalText

example :: (P.MonadParsec e String m) => (m () -> m code) -> m (Leaf ident code void)
example :: forall e (m :: * -> *) code ident void.
MonadParsec e [Char] m =>
(m () -> m code) -> m (Leaf ident code void)
example m () -> m code
code =
  [Char] -> m (Leaf ident code void) -> m (Leaf ident code void)
forall a. [Char] -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
"inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" (m (Leaf ident code void) -> m (Leaf ident code void))
-> m (Leaf ident code void) -> m (Leaf ident code void)
forall a b. (a -> b) -> a -> b
$
    (code -> Leaf ident code void)
-> m code -> m (Leaf ident code void)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap code -> Leaf ident code void
forall ident code a. code -> Leaf ident code a
Example (m code -> m (Leaf ident code void))
-> m code -> m (Leaf ident code void)
forall a b. (a -> b) -> a -> b
$ do
      Int
n <- m Int -> m Int
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ do
        [Char]
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"`"
        [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> m [Char] -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"backticks") (Token [Char] -> Token [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token [Char]
'`')
      let end :: m ()
end = m [Char] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [Char] -> m ()) -> ([Char] -> m [Char]) -> [Char] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
'`'
      m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space m () -> m code -> m code
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m code
code m ()
end

link :: (Ord e, P.MonadParsec e String m) => m ident -> m (Leaf ident code a)
link :: forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (Leaf ident code a)
link m ident
ident = [Char] -> m (Leaf ident code a) -> m (Leaf ident code a)
forall a. [Char] -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
"link (examples: {type List}, {Nat.+})" (m (Leaf ident code a) -> m (Leaf ident code a))
-> m (Leaf ident code a) -> m (Leaf ident code a)
forall a b. (a -> b) -> a -> b
$ EmbedLink ident -> Leaf ident code a
forall ident code a. EmbedLink ident -> Leaf ident code a
Link (EmbedLink ident -> Leaf ident code a)
-> m (EmbedLink ident) -> m (Leaf ident code a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (EmbedLink ident) -> m (EmbedLink ident)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"{" m [Char] -> m (EmbedLink ident) -> m (EmbedLink ident)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ident -> m (EmbedLink ident)
forall e s (m :: * -> *) ident.
(Ord e, MonadParsec e s m, TraversableStream s) =>
m ident -> m (EmbedLink ident)
embedLink m ident
ident m (EmbedLink ident) -> m [Char] -> m (EmbedLink ident)
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"}")

transclude :: (P.MonadParsec e String m) => (m () -> m code) -> m (Transclude code)
transclude :: forall e (m :: * -> *) code.
MonadParsec e [Char] m =>
(m () -> m code) -> m (Transclude code)
transclude m () -> m code
code =
  (code -> Transclude code) -> m code -> m (Transclude code)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap code -> Transclude code
forall a. a -> Transclude a
Transclude (m code -> m (Transclude code))
-> (m code -> m code) -> m code -> m (Transclude code)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m code -> m code
forall a. [Char] -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
"transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" (m code -> m (Transclude code)) -> m code -> m (Transclude code)
forall a b. (a -> b) -> a -> b
$
    [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"{{" m [Char] -> m code -> m code
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m code
code (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
$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"}}")

nonNewlineSpaces :: (P.MonadParsec e String m) => m String
nonNewlineSpaces :: forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces = Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing Char -> Bool
Token [Char] -> Bool
nonNewlineSpace
  where
    nonNewlineSpace :: Char -> Bool
nonNewlineSpace Char
ch = Char -> Bool
isSpace Char
ch Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r'

eval ::
  (P.MonadParsec e String m) => (m () -> m code) -> m (Top code (Leaves ident code) (Tree ident code))
eval :: forall e (m :: * -> *) code ident.
MonadParsec e [Char] m =>
(m () -> m code)
-> m (Top code (Leaves ident code) (Tree ident code))
eval m () -> m code
code =
  code -> Top code (Leaves ident code) (Tree ident code)
forall code leaf a. code -> Top code leaf a
Eval (code -> Top code (Leaves ident code) (Tree ident code))
-> m code -> m (Top code (Leaves ident code) (Tree ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    -- commit after seeing that ``` is on its own line
    [Char]
fence <- m [Char] -> m [Char]
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m [Char] -> m [Char]) -> m [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
      [Char]
fence <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"```" m [Char] -> m [Char] -> m [Char]
forall (f :: * -> *) a.
(Applicative f, Monoid a) =>
f a -> f a -> f a
<+> Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Token [Char] -> Token [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token [Char]
'`')
      Bool
b <- (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace ([Char] -> Bool) -> m [Char] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Char] -> m [Char]
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Token [Char] -> Token [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token [Char]
'\n'))
      [Char]
fence [Char] -> m () -> m [Char]
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
b
    m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space m () -> m code -> m code
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m code
code (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
$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
fence)

exampleBlock :: (P.MonadParsec e String m) => (m () -> m code) -> m (Top code (Leaves ident code) (Tree ident code))
exampleBlock :: forall e (m :: * -> *) code ident.
MonadParsec e [Char] m =>
(m () -> m code)
-> m (Top code (Leaves ident code) (Tree ident code))
exampleBlock m () -> m code
code =
  code -> Top code (Leaves ident code) (Tree ident code)
forall code leaf a. code -> Top code leaf a
ExampleBlock
    (code -> Top code (Leaves ident code) (Tree ident code))
-> m code -> m (Top code (Leaves ident code) (Tree ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      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
$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"@typecheck" m [Char] -> m () -> m [Char]
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space
      [Char]
fence <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"```" m [Char] -> m [Char] -> m [Char]
forall (f :: * -> *) a.
(Applicative f, Monoid a) =>
f a -> f a -> f a
<+> Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Token [Char] -> Token [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token [Char]
'`')
      m () -> m code
code (m () -> m code) -> (m [Char] -> m ()) -> m [Char] -> m code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m [Char] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [Char] -> m code) -> m [Char] -> m code
forall a b. (a -> b) -> a -> b
$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
fence

codeBlock :: (Ord e, P.MonadParsec e String m) => m (Top code (Leaves ident code) (Tree ident code))
codeBlock :: forall e (m :: * -> *) code ident.
(Ord e, MonadParsec e [Char] m) =>
m (Top code (Leaves ident code) (Tree ident code))
codeBlock = do
  Integer
column <- (\Integer
x -> Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (Integer -> Integer) -> (Pos -> Integer) -> Pos -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Pos -> Int) -> Pos -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
P.unPos (Pos -> Integer) -> m Pos -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
LP.indentLevel
  let tabWidth :: Integer
tabWidth = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Pos -> Int) -> Pos -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
P.unPos (Pos -> Integer) -> Pos -> Integer
forall a b. (a -> b) -> a -> b
$ Pos
P.defaultTabWidth
  [Char]
fence <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"```" m [Char] -> m [Char] -> m [Char]
forall (f :: * -> *) a.
(Applicative f, Monoid a) =>
f a -> f a -> f a
<+> Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Token [Char] -> Token [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token [Char]
'`')
  [Char]
name <- m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces m [Char] -> m [Char] -> m [Char]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) m [Char] -> m [Char] -> m [Char]
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces
  ()
_ <- m (Tokens [Char]) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Tokens [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
CP.eol
  [Char]
verbatim <- Integer -> Integer -> ShowS
forall {t}. (Ord t, Num t) => t -> t -> ShowS
uncolumn Integer
column Integer
tabWidth ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trimAroundDelimiters ShowS -> m [Char] -> m [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m [Any] -> m [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.someTill m Char
m (Token [Char])
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
P.anySingle ([] [Any] -> m [Char] -> m [Any]
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
fence)
  pure $ [Char] -> [Char] -> Top code (Leaves ident code) (Tree ident code)
forall code leaf a. [Char] -> [Char] -> Top code leaf a
CodeBlock [Char]
name [Char]
verbatim
  where
    uncolumn :: t -> t -> ShowS
uncolumn t
column t
tabWidth [Char]
s =
      let skip :: t -> ShowS
skip t
col [Char]
r | t
col t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
1 = [Char]
r
          skip t
col s :: [Char]
s@(Char
'\t' : [Char]
_) | t
col t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
tabWidth = [Char]
s
          skip t
col (Char
'\t' : [Char]
r) = t -> ShowS
skip (t
col t -> t -> t
forall a. Num a => a -> a -> a
- t
tabWidth) [Char]
r
          skip t
col (Char
c : [Char]
r)
            | Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isControl Char
c) =
                t -> ShowS
skip (t
col t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [Char]
r
          skip t
_ [Char]
s = [Char]
s
       in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ t -> ShowS
skip t
column ShowS -> [[Char]] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]]
lines [Char]
s

emphasis ::
  (Ord e, P.MonadParsec e String m) =>
  Char ->
  m ident ->
  (m () -> m code) ->
  m () ->
  m (Paragraph (Leaves ident code))
emphasis :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
Char
-> m ident
-> (m () -> m code)
-> m ()
-> m (Paragraph (Leaves ident code))
emphasis Char
delimiter m ident
ident m () -> m code
code m ()
closing = do
  let start :: m [Char]
start = m Char -> m [Char]
forall a. m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Token [Char] -> Bool) -> m (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
delimiter))
  [Char]
end <- m [Char] -> m [Char]
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m [Char] -> m [Char]) -> m [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
    [Char]
end <- m [Char]
start
    m (Token [Char]) -> m (Token [Char])
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead ((Token [Char] -> Bool) -> m (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))
    pure [Char]
end
  NonEmpty (Leaves ident code) -> Paragraph (Leaves ident code)
forall a. NonEmpty a -> Paragraph a
Paragraph
    (NonEmpty (Leaves ident code) -> Paragraph (Leaves ident code))
-> m (NonEmpty (Leaves ident code))
-> m (Paragraph (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Leaves ident code)
-> m [Char] -> m (NonEmpty (Leaves ident code))
forall e s (m :: * -> *) a sep.
MonadParsec e s m =>
m a -> m sep -> m (NonEmpty a)
someTill'
      (m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
leafy m ident
ident m () -> m code
code (m ()
closing m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (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
$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
end)) m (Leaves ident code) -> m () -> m (Leaves ident code)
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m ()
whitespaceWithoutParagraphBreak)
      ([Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
end)
  where
    -- Allows whitespace including up to one newline
    whitespaceWithoutParagraphBreak :: m ()
whitespaceWithoutParagraphBreak = m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void do
      m [Char] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces
      m [Char] -> m (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
newline m (Maybe [Char]) -> (Maybe [Char] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just [Char]
_ -> m [Char] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces
        Maybe [Char]
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

bold ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  m (Leaf ident code (Leaves ident code))
bold :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
bold m ident
ident m () -> m code
code = (Paragraph (Leaves ident code)
 -> Leaf ident code (Leaves ident code))
-> m (Paragraph (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Paragraph (Leaves ident code)
-> Leaf ident code (Leaves ident code)
forall ident code a. Paragraph a -> Leaf ident code a
Bold (m (Paragraph (Leaves ident code))
 -> m (Leaf ident code (Leaves ident code)))
-> (m () -> m (Paragraph (Leaves ident code)))
-> m ()
-> m (Leaf ident code (Leaves ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> m ident
-> (m () -> m code)
-> m ()
-> m (Paragraph (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
Char
-> m ident
-> (m () -> m code)
-> m ()
-> m (Paragraph (Leaves ident code))
emphasis Char
'*' m ident
ident m () -> m code
code

italic ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  m (Leaf ident code (Leaves ident code))
italic :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
italic m ident
ident m () -> m code
code = (Paragraph (Leaves ident code)
 -> Leaf ident code (Leaves ident code))
-> m (Paragraph (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Paragraph (Leaves ident code)
-> Leaf ident code (Leaves ident code)
forall ident code a. Paragraph a -> Leaf ident code a
Italic (m (Paragraph (Leaves ident code))
 -> m (Leaf ident code (Leaves ident code)))
-> (m () -> m (Paragraph (Leaves ident code)))
-> m ()
-> m (Leaf ident code (Leaves ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> m ident
-> (m () -> m code)
-> m ()
-> m (Paragraph (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
Char
-> m ident
-> (m () -> m code)
-> m ()
-> m (Paragraph (Leaves ident code))
emphasis Char
'_' m ident
ident m () -> m code
code

strikethrough ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  m (Leaf ident code (Leaves ident code))
strikethrough :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
strikethrough m ident
ident m () -> m code
code = (Paragraph (Leaves ident code)
 -> Leaf ident code (Leaves ident code))
-> m (Paragraph (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Paragraph (Leaves ident code)
-> Leaf ident code (Leaves ident code)
forall ident code a. Paragraph a -> Leaf ident code a
Strikethrough (m (Paragraph (Leaves ident code))
 -> m (Leaf ident code (Leaves ident code)))
-> (m () -> m (Paragraph (Leaves ident code)))
-> m ()
-> m (Leaf ident code (Leaves ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> m ident
-> (m () -> m code)
-> m ()
-> m (Paragraph (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
Char
-> m ident
-> (m () -> m code)
-> m ()
-> m (Paragraph (Leaves ident code))
emphasis Char
'~' m ident
ident m () -> m code
code

namedLink ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  m (Leaf ident code (Leaves ident code))
namedLink :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> m (Leaf ident code (Leaves ident code))
namedLink m ident
ident m () -> m code
code m ()
docClose =
  [Char]
-> m (Leaf ident code (Leaves ident code))
-> m (Leaf ident code (Leaves ident code))
forall a. [Char] -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
"hyperlink (example: [link name](https://destination.com))" do
    [Char]
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"["
    NonEmpty (Leaves ident code)
p <- m () -> m (Leaves ident code) -> m (NonEmpty (Leaves ident code))
forall e (m :: * -> *) a.
MonadParsec e [Char] m =>
m () -> m a -> m (NonEmpty a)
spaced m ()
docClose (m (Leaves ident code) -> m (NonEmpty (Leaves ident code)))
-> (m Char -> m (Leaves ident code))
-> m Char
-> m (NonEmpty (Leaves ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
leafy m ident
ident m () -> m code
code (m () -> m (Leaves ident code))
-> (m Char -> m ()) -> m Char -> m (Leaves ident code)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Char -> m (NonEmpty (Leaves ident code)))
-> m Char -> m (NonEmpty (Leaves ident code))
forall a b. (a -> b) -> a -> b
$ Token [Char] -> m (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token [Char]
']'
    [Char]
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"]"
    [Char]
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"("
    Group (Leaves ident code)
target <- m (NonEmpty (Leaves ident code)) -> m (Group (Leaves ident code))
forall e s (m :: * -> *) ident code.
MonadParsec e s m =>
m (NonEmpty (Leaves ident code)) -> m (Group (Leaves ident code))
group (m (NonEmpty (Leaves ident code)) -> m (Group (Leaves ident code)))
-> m (NonEmpty (Leaves ident code))
-> m (Group (Leaves ident code))
forall a b. (a -> b) -> a -> b
$ (Leaves ident code -> NonEmpty (Leaves ident code))
-> m (Leaves ident code) -> m (NonEmpty (Leaves ident code))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Leaves ident code -> NonEmpty (Leaves ident code)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code)
forall e s (m :: * -> *) (f :: * -> *).
(Ord e, MonadParsec e s m, TraversableStream s) =>
m (f (Cofree f Ann)) -> m (Cofree f Ann)
wrap (m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code))
-> m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code)
forall a b. (a -> b) -> a -> b
$ m ident -> m (Leaf ident code (Leaves ident code))
forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> m (Leaf ident code a)
link m ident
ident) m (NonEmpty (Leaves ident code))
-> m (NonEmpty (Leaves ident code))
-> m (NonEmpty (Leaves ident code))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Leaves ident code) -> m (NonEmpty (Leaves ident code))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (NonEmpty a)
some' (m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code)
forall e s (m :: * -> *) (f :: * -> *).
(Ord e, MonadParsec e s m, TraversableStream s) =>
m (f (Cofree f Ann)) -> m (Cofree f Ann)
wrap (Transclude code -> Leaf ident code (Leaves ident code)
forall ident code a. Transclude code -> Leaf ident code a
Transclude' (Transclude code -> Leaf ident code (Leaves ident code))
-> m (Transclude code) -> m (Leaf ident code (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m () -> m code) -> m (Transclude code)
forall e (m :: * -> *) code.
MonadParsec e [Char] m =>
(m () -> m code) -> m (Transclude code)
transclude m () -> m code
code) m (Leaves ident code)
-> m (Leaves ident code) -> m (Leaves ident code)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Leaf ident code (Leaves ident code)) -> m (Leaves ident code)
forall e s (m :: * -> *) (f :: * -> *).
(Ord e, MonadParsec e s m, TraversableStream s) =>
m (f (Cofree f Ann)) -> m (Cofree f Ann)
wrap (Word -> Leaf ident code (Leaves ident code)
forall ident code a. Word -> Leaf ident code a
Word' (Word -> Leaf ident code (Leaves ident code))
-> m Word -> m (Leaf ident code (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m () -> m Word
forall e (m :: * -> *) end.
(Ord e, MonadParsec e [Char] m) =>
m end -> m Word
word (m ()
docClose m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token [Char] -> m (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token [Char]
')'))))
    [Char]
_ <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
")"
    pure $ Paragraph (Leaves ident code)
-> Group (Leaves ident code) -> Leaf ident code (Leaves ident code)
forall ident code a. Paragraph a -> Group a -> Leaf ident code a
NamedLink (NonEmpty (Leaves ident code) -> Paragraph (Leaves ident code)
forall a. NonEmpty a -> Paragraph a
Paragraph NonEmpty (Leaves ident code)
p) Group (Leaves ident code)
target

sp :: (P.MonadParsec e String m) => m () -> m String
sp :: forall e (m :: * -> *). MonadParsec e [Char] m => m () -> m [Char]
sp m ()
docClose = m [Char] -> m [Char]
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m [Char] -> m [Char]) -> m [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
  [Char]
spaces <- Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"space") Char -> Bool
Token [Char] -> Bool
isSpace
  Maybe ()
close <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead m ()
docClose)
  case Maybe ()
close of
    Maybe ()
Nothing -> Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
ok [Char]
spaces
    Just ()
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure [Char]
spaces
  where
    ok :: [Char] -> Bool
ok [Char]
s = [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | Char
'\n' <- [Char]
s] Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2

spaced :: (P.MonadParsec e String m) => m () -> m a -> m (NonEmpty a)
spaced :: forall e (m :: * -> *) a.
MonadParsec e [Char] m =>
m () -> m a -> m (NonEmpty a)
spaced m ()
docClose m a
p = m a -> m (NonEmpty a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (NonEmpty a)
some' (m a -> m (NonEmpty a)) -> m a -> m (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ m a
p m a -> m (Maybe [Char]) -> m a
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m [Char] -> m (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (m () -> m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m () -> m [Char]
sp m ()
docClose)

-- | Not an actual node, but this pattern is referenced in multiple places
list ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  R.ReaderT ParsingEnv m (List (Leaves ident code))
list :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
list m ident
ident m () -> m code
code m ()
docClose = m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
bulletedList m ident
ident m () -> m code
code m ()
docClose ReaderT ParsingEnv m (List (Leaves ident code))
-> ReaderT ParsingEnv m (List (Leaves ident code))
-> ReaderT ParsingEnv m (List (Leaves ident code))
forall a.
ReaderT ParsingEnv m a
-> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
numberedList m ident
ident m () -> m code
code m ()
docClose

listSep :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m ()
listSep :: forall e (m :: * -> *).
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m ()
listSep = m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
newline m [Char] -> m [Char] -> m [Char]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces m [Char] -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m ()
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (m (Int, [Any]) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Int, [Any])
forall e (m :: * -> *) a.
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m (Int, [a])
bulletedStart m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Int, Word64) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Int, Word64)
forall e (m :: * -> *).
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m (Int, Word64)
numberedStart)

bulletedStart :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m (Int, [a])
bulletedStart :: forall e (m :: * -> *) a.
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m (Int, [a])
bulletedStart = m (Int, [a]) -> m (Int, [a])
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m (Int, [a]) -> m (Int, [a])) -> m (Int, [a]) -> m (Int, [a])
forall a b. (a -> b) -> a -> b
$ do
  (Int, [a])
r <- m [a] -> m (Int, [a])
forall e (m :: * -> *) a.
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m a -> m (Int, a)
listItemStart (m [a] -> m (Int, [a])) -> m [a] -> m (Int, [a])
forall a b. (a -> b) -> a -> b
$ [] [a] -> m (Token [Char]) -> m [a]
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Token [Char] -> Bool) -> m (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
Token [Char] -> Bool
bulletChar
  m (Token [Char]) -> m (Token [Char])
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead ((Token [Char] -> Bool) -> m (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
Token [Char] -> Bool
isSpace)
  pure (Int, [a])
r
  where
    bulletChar :: Char -> Bool
bulletChar Char
ch = Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'

listItemStart :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m a -> m (Int, a)
listItemStart :: forall e (m :: * -> *) a.
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m a -> m (Int, a)
listItemStart m a
gutter = m (Int, a) -> m (Int, a)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try do
  m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces
  Int
col <- Pos -> Int
column (Pos -> Int) -> m Pos -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Pos
forall e s (m :: * -> *).
(Ord e, TraversableStream s, MonadParsec e s m) =>
m Pos
posP
  Int
parentCol <- (ParsingEnv -> Int) -> m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks ParsingEnv -> Int
parentListColumn
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
parentCol)
  (Int
col,) (a -> (Int, a)) -> m a -> m (Int, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
gutter

numberedStart :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m (Int, Word64)
numberedStart :: forall e (m :: * -> *).
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m (Int, Word64)
numberedStart = m Word64 -> m (Int, Word64)
forall e (m :: * -> *) a.
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m a -> m (Int, a)
listItemStart (m Word64 -> m (Int, Word64))
-> (m Word64 -> m Word64) -> m Word64 -> m (Int, Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Word64 -> m Word64
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m Word64 -> m (Int, Word64)) -> m Word64 -> m (Int, Word64)
forall a b. (a -> b) -> a -> b
$ m Word64
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
LP.decimal m Word64 -> m [Char] -> m Word64
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"."

-- | FIXME: This should take a @`P` a@
numberedList ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  R.ReaderT ParsingEnv m (List (Leaves ident code))
numberedList :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
numberedList m ident
ident m () -> m code
code m ()
docClose = NonEmpty (Word64, Column (Leaves ident code))
-> List (Leaves ident code)
forall a. NonEmpty (Word64, Column a) -> List a
NumberedList (NonEmpty (Word64, Column (Leaves ident code))
 -> List (Leaves ident code))
-> ReaderT
     ParsingEnv m (NonEmpty (Word64, Column (Leaves ident code)))
-> ReaderT ParsingEnv m (List (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParsingEnv m (Word64, Column (Leaves ident code))
-> ReaderT ParsingEnv m ()
-> ReaderT
     ParsingEnv m (NonEmpty (Word64, Column (Leaves ident code)))
forall e s (m :: * -> *) a sep.
MonadParsec e s m =>
m a -> m sep -> m (NonEmpty a)
sepBy1' ReaderT ParsingEnv m (Word64, Column (Leaves ident code))
numberedItem ReaderT ParsingEnv m ()
forall e (m :: * -> *).
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m ()
listSep
  where
    numberedItem :: ReaderT ParsingEnv m (Word64, Column (Leaves ident code))
numberedItem = [Char]
-> ReaderT ParsingEnv m (Word64, Column (Leaves ident code))
-> ReaderT ParsingEnv m (Word64, Column (Leaves ident code))
forall a.
[Char] -> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
"numbered list (examples: 1. item1, 8. start numbering at '8')" do
      (Int
col, Word64
s) <- ReaderT ParsingEnv m (Int, Word64)
forall e (m :: * -> *).
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m (Int, Word64)
numberedStart
      (Word64
s,) (Column (Leaves ident code)
 -> (Word64, Column (Leaves ident code)))
-> ReaderT ParsingEnv m (Column (Leaves ident code))
-> ReaderT ParsingEnv m (Word64, Column (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ident
-> (m () -> m code)
-> m ()
-> Int
-> ReaderT ParsingEnv m (Column (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> Int
-> ReaderT ParsingEnv m (Column (Leaves ident code))
column' m ident
ident m () -> m code
code m ()
docClose Int
col

-- | FIXME: This should take a @`P` a@
bulletedList ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  R.ReaderT ParsingEnv m (List (Leaves ident code))
bulletedList :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
bulletedList m ident
ident m () -> m code
code m ()
docClose = NonEmpty (Column (Leaves ident code)) -> List (Leaves ident code)
forall a. NonEmpty (Column a) -> List a
BulletedList (NonEmpty (Column (Leaves ident code)) -> List (Leaves ident code))
-> ReaderT ParsingEnv m (NonEmpty (Column (Leaves ident code)))
-> ReaderT ParsingEnv m (List (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParsingEnv m (Column (Leaves ident code))
-> ReaderT ParsingEnv m ()
-> ReaderT ParsingEnv m (NonEmpty (Column (Leaves ident code)))
forall e s (m :: * -> *) a sep.
MonadParsec e s m =>
m a -> m sep -> m (NonEmpty a)
sepBy1' ReaderT ParsingEnv m (Column (Leaves ident code))
bullet ReaderT ParsingEnv m ()
forall e (m :: * -> *).
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m ()
listSep
  where
    bullet :: ReaderT ParsingEnv m (Column (Leaves ident code))
bullet = [Char]
-> ReaderT ParsingEnv m (Column (Leaves ident code))
-> ReaderT ParsingEnv m (Column (Leaves ident code))
forall a.
[Char] -> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
"bullet (examples: * item1, - item2)" do
      (Int
col, [Any]
_) <- ReaderT ParsingEnv m (Int, [Any])
forall e (m :: * -> *) a.
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m (Int, [a])
bulletedStart
      m ident
-> (m () -> m code)
-> m ()
-> Int
-> ReaderT ParsingEnv m (Column (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> Int
-> ReaderT ParsingEnv m (Column (Leaves ident code))
column' m ident
ident m () -> m code
code m ()
docClose Int
col

column' ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  Int ->
  R.ReaderT ParsingEnv m (Column (Leaves ident code))
column' :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> Int
-> ReaderT ParsingEnv m (Column (Leaves ident code))
column' m ident
ident m () -> m code
code m ()
docClose Int
col =
  Paragraph (Leaves ident code)
-> Maybe (List (Leaves ident code)) -> Column (Leaves ident code)
forall a. Paragraph a -> Maybe (List a) -> Column a
Column
    (Paragraph (Leaves ident code)
 -> Maybe (List (Leaves ident code)) -> Column (Leaves ident code))
-> ReaderT ParsingEnv m (Paragraph (Leaves ident code))
-> ReaderT
     ParsingEnv
     m
     (Maybe (List (Leaves ident code)) -> Column (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderT ParsingEnv m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces ReaderT ParsingEnv m [Char]
-> ReaderT ParsingEnv m (Paragraph (Leaves ident code))
-> ReaderT ParsingEnv m (Paragraph (Leaves ident code))
forall a b.
ReaderT ParsingEnv m a
-> ReaderT ParsingEnv m b -> ReaderT ParsingEnv m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT ParsingEnv m (Paragraph (Leaves ident code))
listItemParagraph)
    ReaderT
  ParsingEnv
  m
  (Maybe (List (Leaves ident code)) -> Column (Leaves ident code))
-> ReaderT ParsingEnv m (Maybe (List (Leaves ident code)))
-> ReaderT ParsingEnv m (Column (Leaves ident code))
forall a b.
ReaderT ParsingEnv m (a -> b)
-> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsingEnv -> ParsingEnv)
-> ReaderT ParsingEnv m (Maybe (List (Leaves ident code)))
-> ReaderT ParsingEnv m (Maybe (List (Leaves ident code)))
forall a.
(ParsingEnv -> ParsingEnv)
-> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
R.local (\ParsingEnv
e -> ParsingEnv
e {parentListColumn = col}) (ReaderT ParsingEnv m (List (Leaves ident code))
-> ReaderT ParsingEnv m (Maybe (List (Leaves ident code)))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (ReaderT ParsingEnv m (List (Leaves ident code))
 -> ReaderT ParsingEnv m (Maybe (List (Leaves ident code))))
-> ReaderT ParsingEnv m (List (Leaves ident code))
-> ReaderT ParsingEnv m (Maybe (List (Leaves ident code)))
forall a b. (a -> b) -> a -> b
$ ReaderT ParsingEnv m ()
forall e (m :: * -> *).
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m ()
listSep ReaderT ParsingEnv m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
-> ReaderT ParsingEnv m (List (Leaves ident code))
forall a b.
ReaderT ParsingEnv m a
-> ReaderT ParsingEnv m b -> ReaderT ParsingEnv m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT ParsingEnv m (List (Leaves ident code))
list m ident
ident m () -> m code
code m ()
docClose)
  where
    listItemParagraph :: ReaderT ParsingEnv m (Paragraph (Leaves ident code))
listItemParagraph =
      NonEmpty (Leaves ident code) -> Paragraph (Leaves ident code)
forall a. NonEmpty a -> Paragraph a
Paragraph (NonEmpty (Leaves ident code) -> Paragraph (Leaves ident code))
-> ReaderT ParsingEnv m (NonEmpty (Leaves ident code))
-> ReaderT ParsingEnv m (Paragraph (Leaves ident code))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Int
col <- Pos -> Int
column (Pos -> Int)
-> ReaderT ParsingEnv m Pos -> ReaderT ParsingEnv m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParsingEnv m Pos
forall e s (m :: * -> *).
(Ord e, TraversableStream s, MonadParsec e s m) =>
m Pos
posP
        ReaderT ParsingEnv m (Leaves ident code)
-> ReaderT ParsingEnv m (NonEmpty (Leaves ident code))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (NonEmpty a)
some' (m (Leaves ident code) -> ReaderT ParsingEnv m (Leaves ident code)
forall (m :: * -> *) a. Monad m => m a -> ReaderT ParsingEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m () -> m (Leaves ident code)
leafy m ident
ident m () -> m code
code m ()
docClose) ReaderT ParsingEnv m (Leaves ident code)
-> ReaderT ParsingEnv m ()
-> ReaderT ParsingEnv m (Leaves ident code)
forall a b.
ReaderT ParsingEnv m a
-> ReaderT ParsingEnv m b -> ReaderT ParsingEnv m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> ReaderT ParsingEnv m ()
forall {f :: * -> *} {e}.
(MonadReader ParsingEnv f, Ord e, MonadParsec e [Char] f) =>
Int -> f ()
sep Int
col)
      where
        -- Trickiness here to support hard line breaks inside of
        -- a bulleted list, so for instance this parses as expected:
        --
        --   * uno dos
        --     tres quatro
        --   * alice bob
        --     carol dave eve
        sep :: Int -> f ()
sep Int
col = do
          [Char]
_ <- f [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces
          Maybe ()
_ <-
            f () -> f (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (f () -> f (Maybe ())) -> (f () -> f ()) -> f () -> f (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f () -> f ()
forall a. f a -> f a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (f () -> f (Maybe ())) -> f () -> f (Maybe ())
forall a b. (a -> b) -> a -> b
$
              f [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
newline
                f [Char] -> f [Char] -> f [Char]
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
nonNewlineSpaces
                f [Char] -> f () -> f ()
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
                  Int
col2 <- Pos -> Int
column (Pos -> Int) -> f Pos -> f Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Pos
forall e s (m :: * -> *).
(Ord e, TraversableStream s, MonadParsec e s m) =>
m Pos
posP
                  Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> f ()) -> Bool -> f ()
forall a b. (a -> b) -> a -> b
$ Int
col2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
col
                  (f () -> f ()
forall a. f a -> f ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
P.notFollowedBy (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$ f (Int, Word64) -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f (Int, Word64)
forall e (m :: * -> *).
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m (Int, Word64)
numberedStart f () -> f () -> f ()
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f (Int, [Any]) -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f (Int, [Any])
forall e (m :: * -> *) a.
(Ord e, MonadReader ParsingEnv m, MonadParsec e [Char] m) =>
m (Int, [a])
bulletedStart)
          pure ()

newline :: (P.MonadParsec e String m) => m String
newline :: forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
newline = [Char] -> m [Char] -> m [Char]
forall a. [Char] -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
"newline" (m [Char] -> m [Char]) -> m [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"\n" 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] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"\r\n"

-- |
--
-- > ## Section title
-- >
-- > A paragraph under this section.
-- > Part of the same paragraph. Blanklines separate paragraphs.
-- >
-- > ### A subsection title
-- >
-- > A paragraph under this subsection.
-- >
-- > # A section title (not a subsection)
section ::
  (Ord e, P.MonadParsec e String m) =>
  m ident ->
  (m () -> m code) ->
  m () ->
  R.ReaderT ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
section :: forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
section m ident
ident m () -> m code
code m ()
docClose = do
  [Int]
ns <- (ParsingEnv -> [Int]) -> ReaderT ParsingEnv m [Int]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks ParsingEnv -> [Int]
parentSections
  [Char]
hashes <- m [Char] -> ReaderT ParsingEnv m [Char]
forall (m :: * -> *) a. Monad m => m a -> ReaderT ParsingEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Char] -> ReaderT ParsingEnv m [Char])
-> m [Char] -> ReaderT ParsingEnv m [Char]
forall a b. (a -> b) -> a -> b
$ m [Char] -> m [Char]
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m [Char] -> m [Char]) -> m [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int]
ns) Char
'#') m [Char] -> m [Char] -> m [Char]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe [Char] -> (Token [Char] -> Bool) -> m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing (Token [Char] -> Token [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token [Char]
'#') m [Char] -> m [Char] -> m [Char]
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m () -> m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m () -> m [Char]
sp m ()
docClose
  Paragraph (Leaves ident code)
title <- m (Paragraph (Leaves ident code))
-> ReaderT ParsingEnv m (Paragraph (Leaves ident code))
forall (m :: * -> *) a. Monad m => m a -> ReaderT ParsingEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Paragraph (Leaves ident code))
 -> ReaderT ParsingEnv m (Paragraph (Leaves ident code)))
-> m (Paragraph (Leaves ident code))
-> ReaderT ParsingEnv m (Paragraph (Leaves ident code))
forall a b. (a -> b) -> a -> b
$ m ident
-> (m () -> m code) -> m () -> m (Paragraph (Leaves ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code) -> m () -> m (Paragraph (Leaves ident code))
paragraph m ident
ident m () -> m code
code m ()
docClose m (Paragraph (Leaves ident code))
-> m () -> m (Paragraph (Leaves ident code))
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space
  let m :: Int
m = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
hashes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int]
ns
  [Tree ident code]
body <-
    (ParsingEnv -> ParsingEnv)
-> ReaderT ParsingEnv m [Tree ident code]
-> ReaderT ParsingEnv m [Tree ident code]
forall a.
(ParsingEnv -> ParsingEnv)
-> ReaderT ParsingEnv m a -> ReaderT ParsingEnv m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
R.local (\ParsingEnv
env -> ParsingEnv
env {parentSections = m : tail ns}) (ReaderT ParsingEnv m [Tree ident code]
 -> ReaderT ParsingEnv m [Tree ident code])
-> ReaderT ParsingEnv m [Tree ident code]
-> ReaderT ParsingEnv m [Tree ident code]
forall a b. (a -> b) -> a -> b
$
      ReaderT ParsingEnv m (Tree ident code)
-> ReaderT ParsingEnv m [Tree ident code]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (ReaderT
  ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
-> ReaderT ParsingEnv m (Tree ident code)
forall e s (m :: * -> *) (f :: * -> *).
(Ord e, MonadParsec e s m, TraversableStream s) =>
m (f (Cofree f Ann)) -> m (Cofree f Ann)
wrap (m ident
-> (m () -> m code)
-> m ()
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
forall e (m :: * -> *) ident code.
(Ord e, MonadParsec e [Char] m) =>
m ident
-> (m () -> m code)
-> m ()
-> ReaderT
     ParsingEnv m (Top code (Leaves ident code) (Tree ident code))
sectionElem m ident
ident m () -> m code
code m ()
docClose) ReaderT ParsingEnv m (Tree ident code)
-> ReaderT ParsingEnv m ()
-> ReaderT ParsingEnv m (Tree ident code)
forall a b.
ReaderT ParsingEnv m a
-> ReaderT ParsingEnv m b -> ReaderT ParsingEnv m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT ParsingEnv m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space)
  pure $ Paragraph (Leaves ident code)
-> [Tree ident code]
-> Top code (Leaves ident code) (Tree ident code)
forall code leaf a. Paragraph leaf -> [a] -> Top code leaf a
Section Paragraph (Leaves ident code)
title [Tree ident code]
body

-- | FIXME: This should just take a @`P` code@ and @`P` a@.
group :: (P.MonadParsec e s m) => m (NonEmpty (Leaves ident code)) -> m (Group (Leaves ident code))
group :: forall e s (m :: * -> *) ident code.
MonadParsec e s m =>
m (NonEmpty (Leaves ident code)) -> m (Group (Leaves ident code))
group = (Join (Leaves ident code) -> Group (Leaves ident code))
-> m (Join (Leaves ident code)) -> m (Group (Leaves ident code))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Join (Leaves ident code) -> Group (Leaves ident code)
forall a. Join a -> Group a
Group (m (Join (Leaves ident code)) -> m (Group (Leaves ident code)))
-> (m (NonEmpty (Leaves ident code))
    -> m (Join (Leaves ident code)))
-> m (NonEmpty (Leaves ident code))
-> m (Group (Leaves ident code))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (NonEmpty (Leaves ident code)) -> m (Join (Leaves ident code))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m (NonEmpty a) -> m (Join a)
join

-- | FIXME: This should just take a @`P` a@
join :: (P.MonadParsec e s m) => m (NonEmpty a) -> m (Join a)
join :: forall e s (m :: * -> *) a.
MonadParsec e s m =>
m (NonEmpty a) -> m (Join a)
join = (NonEmpty a -> Join a) -> m (NonEmpty a) -> m (Join a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> Join a
forall a. NonEmpty a -> Join a
Join

-- * utility functions

wrap :: (Ord e, P.MonadParsec e s m, P.TraversableStream s) => m (f (Cofree f Ann)) -> m (Cofree f Ann)
wrap :: forall e s (m :: * -> *) (f :: * -> *).
(Ord e, MonadParsec e s m, TraversableStream s) =>
m (f (Cofree f Ann)) -> m (Cofree f Ann)
wrap m (f (Cofree f Ann))
p = do
  Pos
start <- m Pos
forall e s (m :: * -> *).
(Ord e, TraversableStream s, MonadParsec e s m) =>
m Pos
posP
  f (Cofree f Ann)
val <- m (f (Cofree f Ann))
p
  Pos
end <- m Pos
forall e s (m :: * -> *).
(Ord e, TraversableStream s, MonadParsec e s m) =>
m Pos
posP
  pure (Pos -> Pos -> Ann
Ann Pos
start Pos
end Ann -> f (Cofree f Ann) -> Cofree f Ann
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< f (Cofree f Ann)
val)

-- | If it's a multi-line verbatim block we trim any whitespace representing
-- indentation from the pretty-printer.
--
-- E.g.
--
-- @@
-- {{
--   # Heading
--     '''
--     code
--       indented
--     '''
-- }}
-- @@
--
-- Should lex to the text literal "code\n  indented".
--
-- If there's text in the literal that has LESS trailing whitespace than the
-- opening delimiters, we don't trim it at all. E.g.
--
-- @@
-- {{
--   # Heading
--     '''
--   code
--     '''
-- }}
-- @@
--
--  Is parsed as "  code".
--
--  Trim the expected amount of whitespace from a text literal:
--  >>> trimIndentFromVerbatimBlock 2 "  code\n    indented"
-- "code\n  indented"
--
-- If the text literal has less leading whitespace than the opening delimiters,
-- leave it as-is
-- >>> trimIndentFromVerbatimBlock 2 "code\n  indented"
-- "code\n  indented"
trimIndentFromVerbatimBlock :: Int -> String -> String
trimIndentFromVerbatimBlock :: Int -> ShowS
trimIndentFromVerbatimBlock Int
leadingSpaces [Char]
txt = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
txt (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> Maybe [[Char]] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]] -> ([Char] -> Maybe [Char]) -> Maybe [[Char]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([Char] -> [[Char]]
lines [Char]
txt) \[Char]
line -> do
    -- If any 'stripPrefix' fails, we fail and return the unaltered text
    case [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
leadingSpaces Char
' ') [Char]
line of
      Just [Char]
stripped -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
stripped
      Maybe [Char]
Nothing ->
        -- If it was a line with all white-space, just use an empty line,
        -- this can happen easily in editors which trim trailing whitespace.
        if (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
line
          then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
""
          else Maybe [Char]
forall a. Maybe a
Nothing

-- | Trim leading/trailing whitespace from around delimiters, e.g.
--
-- {{
--   '''___ <- whitespace here including newline
--   text block
-- 👇 or here
-- __'''
-- }}
-- >>> trimAroundDelimiters "  \n  text block \n  "
-- "  text block "
--
-- Should leave leading and trailing line untouched if it contains non-whitespace, e.g.:
--
-- '''  leading whitespace
--   text block
-- trailing whitespace:  '''
-- >>> trimAroundDelimiters "  leading whitespace\n  text block \ntrailing whitespace:  "
-- "  leading whitespace\n  text block \ntrailing whitespace:  "
--
-- Should keep trailing newline if it's the only thing on the line, e.g.:
--
-- '''
-- newline below
--
-- '''
-- >>> trimAroundDelimiters "\nnewline below\n\n"
-- "newline below\n\n"
trimAroundDelimiters :: String -> String
trimAroundDelimiters :: ShowS
trimAroundDelimiters [Char]
txt =
  [Char]
txt
    [Char] -> ShowS -> [Char]
forall a b. a -> (a -> b) -> b
& ( \[Char]
s ->
          [Char] -> [Char] -> ([Char], [Char])
forall a. Eq a => [a] -> [a] -> ([a], [a])
List.breakOn [Char]
"\n" [Char]
s
            ([Char], [Char]) -> (([Char], [Char]) -> [Char]) -> [Char]
forall a b. a -> (a -> b) -> b
& \case
              ([Char]
prefix, [Char]
suffix)
                | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
prefix -> Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
suffix
                | Bool
otherwise -> [Char]
prefix [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
suffix
      )
    [Char] -> ShowS -> [Char]
forall a b. a -> (a -> b) -> b
& ( \[Char]
s ->
          [Char] -> [Char] -> ([Char], [Char])
forall a. Eq a => [a] -> [a] -> ([a], [a])
List.breakOnEnd [Char]
"\n" [Char]
s
            ([Char], [Char]) -> (([Char], [Char]) -> [Char]) -> [Char]
forall a b. a -> (a -> b) -> b
& \case
              ([Char]
_prefix, [Char]
"") -> [Char]
s
              ([Char]
prefix, [Char]
suffix)
                | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
suffix -> ShowS
forall {a}. [a] -> [a]
dropTrailingNewline [Char]
prefix
                | Bool
otherwise -> [Char]
prefix [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
suffix
      )
  where
    dropTrailingNewline :: [a] -> [a]
dropTrailingNewline = \case
      [] -> []
      (a
x : [a]
xs) -> NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.init (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [a]
xs)