-- | 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,
    keyedInline,
    group,
    word,

    -- * other components
    column',
    embedLink,
    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 ((:|)), nonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Text.Megaparsec qualified as P
import Text.Megaparsec.Char (char, letterChar)
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)
keyedInline 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
<|> (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

-- | A syntactic pattern of “@keyword{…}”, where we process the contents differently depending on the keyword provided.
keyedInline :: (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m (Leaf ident code a)
keyedInline :: forall e (m :: * -> *) ident code a.
(Ord e, MonadParsec e [Char] m) =>
m ident -> (m () -> m code) -> m (Leaf ident code a)
keyedInline m ident
ident m () -> m code
code = m (Leaf ident code a) -> m (Leaf ident code a)
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try do
  [Char]
keyword <- [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [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
*> m Char -> m [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many m Char
m (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar 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
<* ([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]
"{")
  case [Char]
keyword of
    [Char]
"source" -> NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
forall ident code a.
NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
Source (NonEmpty (SourceElement ident (Transclude code))
 -> Leaf ident code a)
-> m (NonEmpty (SourceElement ident (Transclude code)))
-> m (Leaf ident code a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 m (Leaf ident code a) -> m [Char] -> m (Leaf ident code a)
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]
"}"
    [Char]
"foldedSource" -> NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
forall ident code a.
NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
FoldedSource (NonEmpty (SourceElement ident (Transclude code))
 -> Leaf ident code a)
-> m (NonEmpty (SourceElement ident (Transclude code)))
-> m (Leaf ident code a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 m (Leaf ident code a) -> m [Char] -> m (Leaf ident code a)
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]
"}"
    [Char]
"eval" -> (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 [Char] -> m code) -> m [Char] -> m (Leaf ident code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (Leaf ident code a))
-> m [Char] -> m (Leaf ident code a)
forall a b. (a -> b) -> a -> b
$ [Char] -> m [Char]
forall e (m :: * -> *).
MonadParsec e [Char] m =>
[Char] -> m [Char]
lit [Char]
"}"
    [Char]
"signature" -> NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a
forall ident code a.
NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a
Signature (NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a)
-> m (NonEmpty (EmbedSignatureLink ident)) -> m (Leaf ident code a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 {s} {f :: * -> *} {e} {a}.
(Token s ~ Char, MonadParsec e s f) =>
f a -> f (EmbedSignatureLink a)
embedSignatureLink m ident
ident) m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
comma m (Leaf ident code a) -> m [Char] -> m (Leaf ident code a)
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]
"}"
    [Char]
"signatures" -> NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a
forall ident code a.
NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a
Signature (NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a)
-> m (NonEmpty (EmbedSignatureLink ident)) -> m (Leaf ident code a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 {s} {f :: * -> *} {e} {a}.
(Token s ~ Char, MonadParsec e s f) =>
f a -> f (EmbedSignatureLink a)
embedSignatureLink m ident
ident) m [Char]
forall e (m :: * -> *). MonadParsec e [Char] m => m [Char]
comma m (Leaf ident code a) -> m [Char] -> m (Leaf ident code a)
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]
"}"
    [Char]
"inlineSignature" -> EmbedSignatureLink ident -> Leaf ident code a
forall ident code a. EmbedSignatureLink ident -> Leaf ident code a
SignatureInline (EmbedSignatureLink ident -> Leaf ident code a)
-> m (EmbedSignatureLink ident) -> m (Leaf ident code a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ident -> m (EmbedSignatureLink ident)
forall {s} {f :: * -> *} {e} {a}.
(Token s ~ Char, MonadParsec e s f) =>
f a -> f (EmbedSignatureLink a)
embedSignatureLink m ident
ident m (Leaf ident code a) -> m [Char] -> m (Leaf ident code a)
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]
"}"
    [Char]
keyword -> ErrorItem Char -> m (Leaf ident code a)
ErrorItem (Token [Char]) -> m (Leaf ident code a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
P.unexpected (ErrorItem Char -> m (Leaf ident code a))
-> (Maybe (NonEmpty Char) -> ErrorItem Char)
-> Maybe (NonEmpty Char)
-> m (Leaf ident code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorItem Char
-> (NonEmpty Char -> ErrorItem Char)
-> Maybe (NonEmpty Char)
-> ErrorItem Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
P.Label (NonEmpty Char -> ErrorItem Char)
-> NonEmpty Char -> ErrorItem Char
forall a b. (a -> b) -> a -> b
$ Char
'@' Char -> [Char] -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| [Char]
"keyword{...}") NonEmpty Char -> ErrorItem Char
forall t. NonEmpty t -> ErrorItem t
P.Tokens (Maybe (NonEmpty Char) -> m (Leaf ident code a))
-> Maybe (NonEmpty Char) -> m (Leaf ident code a)
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Char]
keyword
  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)
    embedSignatureLink :: f a -> f (EmbedSignatureLink a)
embedSignatureLink f a
ident = a -> EmbedSignatureLink a
forall a. a -> EmbedSignatureLink a
EmbedSignatureLink (a -> EmbedSignatureLink a) -> f a -> f (EmbedSignatureLink a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
ident f (EmbedSignatureLink a) -> f () -> f (EmbedSignatureLink a)
forall a b. f a -> f b -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
CP.space

-- | 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

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)