{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      :  Documentation.Haddock.Parser
-- Copyright   :  (c) Mateusz Kowalczyk 2013-2014,
--                    Simon Hengel      2013
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- Parser used for Haddock comments. For external users of this
-- library, the most commonly used combination of functions is going
-- to be
--
-- @'toRegular' . '_doc' . 'parseParas'@
module Documentation.Haddock.Parser
  ( parseString
  , parseParas
  , overIdentifier
  , toRegular
  , Identifier
  ) where

import Control.Applicative
import Control.Arrow (first)
import Control.Monad
import Data.Char (chr, isAlpha, isSpace, isUpper)
import Data.Functor (($>))
import Data.List (elemIndex, intercalate, intersperse, unfoldr)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Monoid
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Text.Parsec (try)
import qualified Text.Parsec as Parsec
import Prelude hiding (takeWhile)
import qualified Prelude as P

import Documentation.Haddock.Doc
import Documentation.Haddock.Markup (markup, plainMarkup)
import Documentation.Haddock.Parser.Identifier
import Documentation.Haddock.Parser.Monad
import Documentation.Haddock.Parser.Util
import Documentation.Haddock.Types

-- $setup
-- >>> :set -XOverloadedStrings

-- | Drops the quotes/backticks around all identifiers, as if they
-- were valid but still 'String's.
toRegular :: DocH mod Identifier -> DocH mod String
toRegular :: forall mod. DocH mod Identifier -> DocH mod String
toRegular = (Identifier -> String) -> DocH mod Identifier -> DocH mod String
forall a b. (a -> b) -> DocH mod a -> DocH mod b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Identifier Namespace
_ Char
_ String
x Char
_) -> String
x)

-- | Maps over 'DocIdentifier's over 'String' with potentially failing
-- conversion using user-supplied function. If the conversion fails,
-- the identifier is deemed to not be valid and is treated as a
-- regular string.
overIdentifier
  :: (Namespace -> String -> Maybe a)
  -> DocH mod Identifier
  -> DocH mod a
overIdentifier :: forall a mod.
(Namespace -> String -> Maybe a)
-> DocH mod Identifier -> DocH mod a
overIdentifier Namespace -> String -> Maybe a
f DocH mod Identifier
d = DocH mod Identifier -> DocH mod a
forall {mod}. DocH mod Identifier -> DocH mod a
g DocH mod Identifier
d
  where
    g :: DocH mod Identifier -> DocH mod a
g (DocIdentifier (Identifier Namespace
ns Char
o String
x Char
e)) = case Namespace -> String -> Maybe a
f Namespace
ns String
x of
      Maybe a
Nothing -> String -> DocH mod a
forall mod id. String -> DocH mod id
DocString (String -> DocH mod a) -> String -> DocH mod a
forall a b. (a -> b) -> a -> b
$ Namespace -> String
renderNs Namespace
ns String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
o] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
e]
      Just a
x' -> a -> DocH mod a
forall mod id. id -> DocH mod id
DocIdentifier a
x'
    g DocH mod Identifier
DocEmpty = DocH mod a
forall mod id. DocH mod id
DocEmpty
    g (DocAppend DocH mod Identifier
x DocH mod Identifier
x') = DocH mod a -> DocH mod a -> DocH mod a
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
DocAppend (DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x) (DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x')
    g (DocString String
x) = String -> DocH mod a
forall mod id. String -> DocH mod id
DocString String
x
    g (DocParagraph DocH mod Identifier
x) = DocH mod a -> DocH mod a
forall mod id. DocH mod id -> DocH mod id
DocParagraph (DocH mod a -> DocH mod a) -> DocH mod a -> DocH mod a
forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocIdentifierUnchecked mod
x) = mod -> DocH mod a
forall mod id. mod -> DocH mod id
DocIdentifierUnchecked mod
x
    g (DocModule (ModLink String
m Maybe (DocH mod Identifier)
x)) = ModLink (DocH mod a) -> DocH mod a
forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule (String -> Maybe (DocH mod a) -> ModLink (DocH mod a)
forall id. String -> Maybe id -> ModLink id
ModLink String
m ((DocH mod Identifier -> DocH mod a)
-> Maybe (DocH mod Identifier) -> Maybe (DocH mod a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g Maybe (DocH mod Identifier)
x))
    g (DocWarning DocH mod Identifier
x) = DocH mod a -> DocH mod a
forall mod id. DocH mod id -> DocH mod id
DocWarning (DocH mod a -> DocH mod a) -> DocH mod a -> DocH mod a
forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocEmphasis DocH mod Identifier
x) = DocH mod a -> DocH mod a
forall mod id. DocH mod id -> DocH mod id
DocEmphasis (DocH mod a -> DocH mod a) -> DocH mod a -> DocH mod a
forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocMonospaced DocH mod Identifier
x) = DocH mod a -> DocH mod a
forall mod id. DocH mod id -> DocH mod id
DocMonospaced (DocH mod a -> DocH mod a) -> DocH mod a -> DocH mod a
forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocBold DocH mod Identifier
x) = DocH mod a -> DocH mod a
forall mod id. DocH mod id -> DocH mod id
DocBold (DocH mod a -> DocH mod a) -> DocH mod a -> DocH mod a
forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocUnorderedList [DocH mod Identifier]
x) = [DocH mod a] -> DocH mod a
forall mod id. [DocH mod id] -> DocH mod id
DocUnorderedList ([DocH mod a] -> DocH mod a) -> [DocH mod a] -> DocH mod a
forall a b. (a -> b) -> a -> b
$ (DocH mod Identifier -> DocH mod a)
-> [DocH mod Identifier] -> [DocH mod a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g [DocH mod Identifier]
x
    g (DocOrderedList [(Int, DocH mod Identifier)]
x) = [(Int, DocH mod a)] -> DocH mod a
forall mod id. [(Int, DocH mod id)] -> DocH mod id
DocOrderedList ([(Int, DocH mod a)] -> DocH mod a)
-> [(Int, DocH mod a)] -> DocH mod a
forall a b. (a -> b) -> a -> b
$ ((Int, DocH mod Identifier) -> (Int, DocH mod a))
-> [(Int, DocH mod Identifier)] -> [(Int, DocH mod a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
index, DocH mod Identifier
a) -> (Int
index, DocH mod Identifier -> DocH mod a
g DocH mod Identifier
a)) [(Int, DocH mod Identifier)]
x
    g (DocDefList [(DocH mod Identifier, DocH mod Identifier)]
x) = [(DocH mod a, DocH mod a)] -> DocH mod a
forall mod id. [(DocH mod id, DocH mod id)] -> DocH mod id
DocDefList ([(DocH mod a, DocH mod a)] -> DocH mod a)
-> [(DocH mod a, DocH mod a)] -> DocH mod a
forall a b. (a -> b) -> a -> b
$ ((DocH mod Identifier, DocH mod Identifier)
 -> (DocH mod a, DocH mod a))
-> [(DocH mod Identifier, DocH mod Identifier)]
-> [(DocH mod a, DocH mod a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(DocH mod Identifier
y, DocH mod Identifier
z) -> (DocH mod Identifier -> DocH mod a
g DocH mod Identifier
y, DocH mod Identifier -> DocH mod a
g DocH mod Identifier
z)) [(DocH mod Identifier, DocH mod Identifier)]
x
    g (DocCodeBlock DocH mod Identifier
x) = DocH mod a -> DocH mod a
forall mod id. DocH mod id -> DocH mod id
DocCodeBlock (DocH mod a -> DocH mod a) -> DocH mod a -> DocH mod a
forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocHyperlink (Hyperlink String
u Maybe (DocH mod Identifier)
x)) = Hyperlink (DocH mod a) -> DocH mod a
forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink (String -> Maybe (DocH mod a) -> Hyperlink (DocH mod a)
forall id. String -> Maybe id -> Hyperlink id
Hyperlink String
u ((DocH mod Identifier -> DocH mod a)
-> Maybe (DocH mod Identifier) -> Maybe (DocH mod a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g Maybe (DocH mod Identifier)
x))
    g (DocPic Picture
x) = Picture -> DocH mod a
forall mod id. Picture -> DocH mod id
DocPic Picture
x
    g (DocMathInline String
x) = String -> DocH mod a
forall mod id. String -> DocH mod id
DocMathInline String
x
    g (DocMathDisplay String
x) = String -> DocH mod a
forall mod id. String -> DocH mod id
DocMathDisplay String
x
    g (DocAName String
x) = String -> DocH mod a
forall mod id. String -> DocH mod id
DocAName String
x
    g (DocProperty String
x) = String -> DocH mod a
forall mod id. String -> DocH mod id
DocProperty String
x
    g (DocExamples [Example]
x) = [Example] -> DocH mod a
forall mod id. [Example] -> DocH mod id
DocExamples [Example]
x
    g (DocHeader (Header Int
l DocH mod Identifier
x)) = Header (DocH mod a) -> DocH mod a
forall mod id. Header (DocH mod id) -> DocH mod id
DocHeader (Header (DocH mod a) -> DocH mod a)
-> (DocH mod a -> Header (DocH mod a)) -> DocH mod a -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DocH mod a -> Header (DocH mod a)
forall id. Int -> id -> Header id
Header Int
l (DocH mod a -> DocH mod a) -> DocH mod a -> DocH mod a
forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocTable (Table [TableRow (DocH mod Identifier)]
h [TableRow (DocH mod Identifier)]
b)) = Table (DocH mod a) -> DocH mod a
forall mod id. Table (DocH mod id) -> DocH mod id
DocTable ([TableRow (DocH mod a)]
-> [TableRow (DocH mod a)] -> Table (DocH mod a)
forall id. [TableRow id] -> [TableRow id] -> Table id
Table ((TableRow (DocH mod Identifier) -> TableRow (DocH mod a))
-> [TableRow (DocH mod Identifier)] -> [TableRow (DocH mod a)]
forall a b. (a -> b) -> [a] -> [b]
map ((DocH mod Identifier -> DocH mod a)
-> TableRow (DocH mod Identifier) -> TableRow (DocH mod a)
forall a b. (a -> b) -> TableRow a -> TableRow b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g) [TableRow (DocH mod Identifier)]
h) ((TableRow (DocH mod Identifier) -> TableRow (DocH mod a))
-> [TableRow (DocH mod Identifier)] -> [TableRow (DocH mod a)]
forall a b. (a -> b) -> [a] -> [b]
map ((DocH mod Identifier -> DocH mod a)
-> TableRow (DocH mod Identifier) -> TableRow (DocH mod a)
forall a b. (a -> b) -> TableRow a -> TableRow b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g) [TableRow (DocH mod Identifier)]
b))

choice' :: [Parser a] -> Parser a
choice' :: forall a. [Parser a] -> Parser a
choice' [] = Parser a
forall a. ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Alternative f => f a
empty
choice' [Parser a
p] = Parser a
p
choice' (Parser a
p : [Parser a]
ps) = Parser a -> Parser a
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
try Parser a
p Parser a -> Parser a -> Parser a
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> [Parser a] -> Parser a
forall a. [Parser a] -> Parser a
choice' [Parser a]
ps

parse :: Parser a -> Text -> (ParserState, a)
parse :: forall a. Parser a -> Text -> (ParserState, a)
parse Parser a
p = (String -> (ParserState, a))
-> ((ParserState, a) -> (ParserState, a))
-> Either String (ParserState, a)
-> (ParserState, a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> (ParserState, a)
forall {c}. String -> c
err (ParserState, a) -> (ParserState, a)
forall a. a -> a
id (Either String (ParserState, a) -> (ParserState, a))
-> (Text -> Either String (ParserState, a))
-> Text
-> (ParserState, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Text -> Either String (ParserState, a)
forall a. Parser a -> Text -> Either String (ParserState, a)
parseOnly (Parser a
p Parser a -> ParsecT Text ParserState Identity () -> Parser a
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
forall s (m :: Type -> Type) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof)
  where
    err :: String -> c
err = String -> c
forall a. HasCallStack => String -> a
error (String -> c) -> (String -> String) -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Haddock.Parser.parse: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)

-- | Main entry point to the parser. Appends the newline character
-- to the input string.
parseParas
  :: Maybe Package
  -> String
  -- ^ String to parse
  -> MetaDoc mod Identifier
parseParas :: forall mod. Maybe String -> String -> MetaDoc mod Identifier
parseParas Maybe String
pkg String
input = case String -> (ParserState, DocH mod Identifier)
forall mod. String -> (ParserState, DocH mod Identifier)
parseParasState String
input of
  (ParserState
state, DocH mod Identifier
a) ->
    let defaultPackage :: MetaSince -> MetaSince
defaultPackage MetaSince
s = MetaSince
s{sincePackage = sincePackage s <|> pkg}
     in MetaDoc
          { _meta :: Meta
_meta = Meta{_metaSince :: Maybe MetaSince
_metaSince = MetaSince -> MetaSince
defaultPackage (MetaSince -> MetaSince) -> Maybe MetaSince -> Maybe MetaSince
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserState -> Maybe MetaSince
parserStateSince ParserState
state}
          , _doc :: DocH mod Identifier
_doc = DocH mod Identifier
a
          }

parseParasState :: String -> (ParserState, DocH mod Identifier)
parseParasState :: forall mod. String -> (ParserState, DocH mod Identifier)
parseParasState = Parser (DocH mod Identifier)
-> Text -> (ParserState, DocH mod Identifier)
forall a. Parser a -> Text -> (ParserState, a)
parse (ParsecT Text ParserState Identity ()
emptyLines ParsecT Text ParserState Identity ()
-> Parser (DocH mod Identifier) -> Parser (DocH mod Identifier)
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
p) (Text -> (ParserState, DocH mod Identifier))
-> (String -> Text) -> String -> (ParserState, DocH mod Identifier)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')
  where
    p :: Parser (DocH mod Identifier)
    p :: forall mod. Parser (DocH mod Identifier)
p = [DocH mod Identifier] -> DocH mod Identifier
forall mod id. [DocH mod id] -> DocH mod id
docConcat ([DocH mod Identifier] -> DocH mod Identifier)
-> ParsecT Text ParserState Identity [DocH mod Identifier]
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT Text ParserState Identity [DocH mod Identifier]
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many (ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
paragraph ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
emptyLines)

    emptyLines :: Parser ()
    emptyLines :: ParsecT Text ParserState Identity ()
emptyLines = ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (ParsecT Text ParserState Identity [Text]
 -> ParsecT Text ParserState Identity ())
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many (ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\n"))

parseParagraphs :: String -> Parser (DocH mod Identifier)
parseParagraphs :: forall mod. String -> Parser (DocH mod Identifier)
parseParagraphs String
input = case String -> (ParserState, DocH mod Identifier)
forall mod. String -> (ParserState, DocH mod Identifier)
parseParasState String
input of
  (ParserState
state, DocH mod Identifier
a) -> ParserState -> ParsecT Text ParserState Identity ()
forall (m :: Type -> Type) u s. Monad m => u -> ParsecT s u m ()
Parsec.putState ParserState
state ParsecT Text ParserState Identity ()
-> Parser (DocH mod Identifier) -> Parser (DocH mod Identifier)
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> DocH mod Identifier -> Parser (DocH mod Identifier)
forall a. a -> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DocH mod Identifier
a

-- | Variant of 'parseText' for 'String' instead of 'Text'
parseString :: String -> DocH mod Identifier
parseString :: forall mod. String -> DocH mod Identifier
parseString = Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseText (Text -> DocH mod Identifier)
-> (String -> Text) -> String -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Parse a text paragraph. Actually just a wrapper over 'parseParagraph' which
-- drops leading whitespace.
parseText :: Text -> DocH mod Identifier
parseText :: forall mod. Text -> DocH mod Identifier
parseText = Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseParagraph (Text -> DocH mod Identifier)
-> (Text -> Text) -> Text -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')

parseParagraph :: Text -> DocH mod Identifier
parseParagraph :: forall mod. Text -> DocH mod Identifier
parseParagraph = (ParserState, DocH mod Identifier) -> DocH mod Identifier
forall a b. (a, b) -> b
snd ((ParserState, DocH mod Identifier) -> DocH mod Identifier)
-> (Text -> (ParserState, DocH mod Identifier))
-> Text
-> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (DocH mod Identifier)
-> Text -> (ParserState, DocH mod Identifier)
forall a. Parser a -> Text -> (ParserState, a)
parse Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
p
  where
    p :: Parser (DocH mod Identifier)
    p :: forall mod. Parser (DocH mod Identifier)
p =
      [DocH mod Identifier] -> DocH mod Identifier
forall mod id. [DocH mod id] -> DocH mod id
docConcat
        ([DocH mod Identifier] -> DocH mod Identifier)
-> ParsecT Text ParserState Identity [DocH mod Identifier]
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT Text ParserState Identity [DocH mod Identifier]
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many
          ( [ParsecT Text ParserState Identity (DocH mod Identifier)]
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall a. [Parser a] -> Parser a
choice'
              [ ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
monospace
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
anchor
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
identifier
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
moduleName
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
picture
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
mathDisplay
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
mathInline
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
markdownImage
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
markdownLink
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
hyperlink
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
bold
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
emphasis
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
encodedChar
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
string'
              , ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
skipSpecialChar
              ]
          )

-- | Parses and processes
-- <https://en.wikipedia.org/wiki/Numeric_character_reference Numeric character references>
--
-- >>> parseString "&#65;"
-- DocString "A"
encodedChar :: Parser (DocH mod a)
encodedChar :: forall mod a. Parser (DocH mod a)
encodedChar = ParsecT Text ParserState Identity Text
"&#" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod a)
-> ParsecT Text ParserState Identity (DocH mod a)
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity (DocH mod a)
forall mod a. Parser (DocH mod a)
c ParsecT Text ParserState Identity (DocH mod a)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod a)
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
";"
  where
    c :: ParsecT Text ParserState Identity (DocH mod id)
c = String -> DocH mod id
forall mod id. String -> DocH mod id
DocString (String -> DocH mod id) -> (Int -> String) -> Int -> DocH mod id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr (Int -> DocH mod id)
-> ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity (DocH mod id)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Int
num
    num :: ParsecT Text ParserState Identity Int
num = ParsecT Text ParserState Identity Int
hex ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Int
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity Int
forall a. Integral a => Parser a
decimal
    hex :: ParsecT Text ParserState Identity Int
hex = (ParsecT Text ParserState Identity Text
"x" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity Text
"X") ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Int
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Int
forall a. (Integral a, Bits a) => Parser a
hexadecimal

-- | List of characters that we use to delimit any special markup.
-- Once we have checked for any of these and tried to parse the
-- relevant markup, we can assume they are used as regular text.
specialChar :: [Char]
specialChar :: String
specialChar = String
"_/<@\"&'`#[ "

-- | Plain, regular parser for text. Called as one of the last parsers
-- to ensure that we have already given a chance to more meaningful parsers
-- before capturing their characters.
string' :: Parser (DocH mod a)
string' :: forall mod a. Parser (DocH mod a)
string' =
  String -> DocH mod a
forall mod id. String -> DocH mod id
DocString
    (String -> DocH mod a)
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> String -> String)
-> ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity (String -> String)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Text ParserState Identity Char
rawOrEscChar String
"" ParsecT Text ParserState Identity (String -> String)
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity String
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many (String -> ParsecT Text ParserState Identity Char
rawOrEscChar String
"(["))
    -- After the first character, stop for @\(@ or @\[@ math starters. (The
    -- first character won't start a valid math string because this parser
    -- should follow math parsers. But this parser is expected to accept at
    -- least one character from all inputs that don't start with special
    -- characters, so the first character parser can't have the @"(["@
    -- restriction.)
  where
    -- | Parse a single logical character, either raw or escaped. Don't accept
    -- escaped characters from the argument string.
    rawOrEscChar :: [Char] -> Parser Char
    rawOrEscChar :: String -> ParsecT Text ParserState Identity Char
rawOrEscChar String
restrictedEscapes = ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity Char
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState Identity Char
 -> ParsecT Text ParserState Identity Char)
-> ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity Char
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text ParserState Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
String -> ParsecT s u m Char
Parsec.noneOf String
specialChar ParsecT Text ParserState Identity Char
-> (Char -> ParsecT Text ParserState Identity Char)
-> ParsecT Text ParserState Identity Char
forall a b.
ParsecT Text ParserState Identity a
-> (a -> ParsecT Text ParserState Identity b)
-> ParsecT Text ParserState Identity b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      -- Handle backslashes:
      --   - Fail on forbidden escape characters.
      --   - Non-forbidden characters: simply unescape, e.g. parse "\b" as 'b',
      --   - Trailing backslash: treat it as a raw backslash, not an escape
      --     sequence. (This is the logic that this parser followed when this
      --     comment was written; it is not necessarily intentional but now I
      --     don't want to break anything relying on it.)
      Char
'\\' -> String -> ParsecT Text ParserState Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
String -> ParsecT s u m Char
Parsec.noneOf String
restrictedEscapes ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity Char
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity ()
forall s (m :: Type -> Type) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof ParsecT Text ParserState Identity ()
-> Char -> ParsecT Text ParserState Identity Char
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Char
'\\'
      Char
c -> Char -> ParsecT Text ParserState Identity Char
forall a. a -> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Char
c

-- | Skips a single special character and treats it as a plain string.
-- This is done to skip over any special characters belonging to other
-- elements but which were not deemed meaningful at their positions.
skipSpecialChar :: Parser (DocH mod a)
skipSpecialChar :: forall mod a. Parser (DocH mod a)
skipSpecialChar = String -> DocH mod a
forall mod id. String -> DocH mod id
DocString (String -> DocH mod a) -> (Char -> String) -> Char -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Char -> DocH mod a)
-> ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Text ParserState Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
String -> ParsecT s u m Char
Parsec.oneOf String
specialChar

-- | Emphasis parser.
--
-- >>> parseString "/Hello world/"
-- DocEmphasis (DocString "Hello world")
emphasis :: Parser (DocH mod Identifier)
emphasis :: forall mod. Parser (DocH mod Identifier)
emphasis =
  DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id
DocEmphasis (DocH mod Identifier -> DocH mod Identifier)
-> (Text -> DocH mod Identifier) -> Text -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseParagraph
    (Text -> DocH mod Identifier)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"/" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"/")

-- | Bold parser.
--
-- >>> parseString "__Hello world__"
-- DocBold (DocString "Hello world")
bold :: Parser (DocH mod Identifier)
bold :: forall mod. Parser (DocH mod Identifier)
bold = DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id
DocBold (DocH mod Identifier -> DocH mod Identifier)
-> (Text -> DocH mod Identifier) -> Text -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseParagraph (Text -> DocH mod Identifier)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"__" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
"__")

disallowNewline :: Parser Text -> Parser Text
disallowNewline :: ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline = (Text -> Bool)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall (m :: Type -> Type) a.
MonadPlus m =>
(a -> Bool) -> m a -> m a
mfilter ((Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'))

-- | Like `takeWhile`, but unconditionally take escaped characters.
takeWhile_ :: (Char -> Bool) -> Parser Text
takeWhile_ :: (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile_ Char -> Bool
p = (Bool -> Char -> Maybe Bool)
-> Bool -> ParsecT Text ParserState Identity Text
forall s.
(s -> Char -> Maybe s)
-> s -> ParsecT Text ParserState Identity Text
scan Bool -> Char -> Maybe Bool
p_ Bool
False
  where
    p_ :: Bool -> Char -> Maybe Bool
p_ Bool
escaped Char
c
      | Bool
escaped = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
p Char
c = Maybe Bool
forall a. Maybe a
Nothing
      | Bool
otherwise = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')

-- | Like 'takeWhile1', but unconditionally take escaped characters.
takeWhile1_ :: (Char -> Bool) -> Parser Text
takeWhile1_ :: (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ = (Text -> Bool)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall (m :: Type -> Type) a.
MonadPlus m =>
(a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (ParsecT Text ParserState Identity Text
 -> ParsecT Text ParserState Identity Text)
-> ((Char -> Bool) -> ParsecT Text ParserState Identity Text)
-> (Char -> Bool)
-> ParsecT Text ParserState Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile_

-- | Text anchors to allow for jumping around the generated documentation.
--
-- >>> parseString "#Hello world#"
-- DocAName "Hello world"
anchor :: Parser (DocH mod a)
anchor :: forall mod a. Parser (DocH mod a)
anchor =
  String -> DocH mod a
forall mod id. String -> DocH mod id
DocAName (String -> DocH mod a) -> (Text -> String) -> Text -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    (Text -> DocH mod a)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"#" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
x)) ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"#")

-- | Monospaced strings.
--
-- >>> parseString "@cruel@"
-- DocMonospaced (DocString "cruel")
monospace :: Parser (DocH mod Identifier)
monospace :: forall mod. Parser (DocH mod Identifier)
monospace =
  DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id
DocMonospaced (DocH mod Identifier -> DocH mod Identifier)
-> (Text -> DocH mod Identifier) -> Text -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseParagraph
    (Text -> DocH mod Identifier)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"@" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@') ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"@")

-- | Module names.
--
-- Note that we allow '#' and '\' to support anchors (old style anchors are of
-- the form "SomeModule\#anchor").
moduleName :: Parser (DocH mod a)
moduleName :: forall mod a. Parser (DocH mod a)
moduleName = ModLink (DocH mod a) -> DocH mod a
forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule (ModLink (DocH mod a) -> DocH mod a)
-> (String -> ModLink (DocH mod a)) -> String -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe (DocH mod a) -> ModLink (DocH mod a))
-> Maybe (DocH mod a) -> String -> ModLink (DocH mod a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Maybe (DocH mod a) -> ModLink (DocH mod a)
forall id. String -> Maybe id -> ModLink id
ModLink Maybe (DocH mod a)
forall a. Maybe a
Nothing (String -> DocH mod a)
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"\"" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity String
moduleNameString ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"\"")

-- | A module name, optionally with an anchor
moduleNameString :: Parser String
moduleNameString :: ParsecT Text ParserState Identity String
moduleNameString = ParsecT Text ParserState Identity String
modid ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
forall {f :: Type -> Type} {a}.
Alternative f =>
f [a] -> f [a] -> f [a]
`maybeFollowedBy` ParsecT Text ParserState Identity String
forall {u}. ParsecT Text u Identity String
anchor_
  where
    modid :: ParsecT Text ParserState Identity String
modid = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> ParsecT Text ParserState Identity [String]
-> ParsecT Text ParserState Identity String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity String
conid ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [String]
forall s (m :: Type -> Type) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`Parsec.sepBy1` ParsecT Text ParserState Identity Text
"."
    anchor_ :: ParsecT Text u Identity String
anchor_ =
      String -> String -> String
forall a. [a] -> [a] -> [a]
(++)
        (String -> String -> String)
-> ParsecT Text u Identity String
-> ParsecT Text u Identity (String -> String)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT Text u Identity String
forall s (m :: Type -> Type) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"#" ParsecT Text u Identity String
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a.
ParsecT Text u Identity a
-> ParsecT Text u Identity a -> ParsecT Text u Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT Text u Identity String
forall s (m :: Type -> Type) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"\\#")
        ParsecT Text u Identity (String -> String)
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall a. ParsecT Text u Identity a -> ParsecT Text u Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)))

    maybeFollowedBy :: f [a] -> f [a] -> f [a]
maybeFollowedBy f [a]
pre f [a]
suf = (\[a]
x -> [a] -> ([a] -> [a]) -> Maybe [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
x ([a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++)) ([a] -> Maybe [a] -> [a]) -> f [a] -> f (Maybe [a] -> [a])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f [a]
pre f (Maybe [a] -> [a]) -> f (Maybe [a]) -> f [a]
forall a b. f (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f [a] -> f (Maybe [a])
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
optional f [a]
suf
    conid :: Parser String
    conid :: ParsecT Text ParserState Identity String
conid =
      (:)
        (Char -> String -> String)
-> ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity (String -> String)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy (\Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
c)
        ParsecT Text ParserState Identity (String -> String)
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity String
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many ParsecT Text ParserState Identity Char
forall {u}. ParsecT Text u Identity Char
conChar

    conChar :: ParsecT Text u Identity Char
conChar = ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
ParsecT s u m Char
Parsec.alphaNum ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall a.
ParsecT Text u Identity a
-> ParsecT Text u Identity a -> ParsecT Text u Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'_'

-- | A labeled link to an indentifier, module or url using markdown
-- syntax.
markdownLink :: Parser (DocH mod Identifier)
markdownLink :: forall mod. Parser (DocH mod Identifier)
markdownLink = do
  lbl <- Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
markdownLinkText
  choice' [markdownModuleName lbl, markdownURL lbl]
  where
    markdownModuleName :: DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownModuleName DocH mod id
lbl = do
      mn <-
        ParsecT Text ParserState Identity Text
"("
          ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity ()
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity ()
skipHorizontalSpace
          ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\""
          ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity String
moduleNameString
          ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"\""
          ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
skipHorizontalSpace
          ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
")"
      pure $ DocModule (ModLink mn (Just lbl))

    markdownURL :: DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownURL DocH mod id
lbl = do
      target <- ParsecT Text ParserState Identity String
markdownLinkTarget
      pure $ DocHyperlink $ Hyperlink target (Just lbl)

-- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify
-- a title for the picture.
--
-- >>> parseString "<<hello.png>>"
-- DocPic (Picture {pictureUri = "hello.png", pictureTitle = Nothing})
-- >>> parseString "<<hello.png world>>"
-- DocPic (Picture {pictureUri = "hello.png", pictureTitle = Just "world"})
picture :: Parser (DocH mod a)
picture :: forall mod a. Parser (DocH mod a)
picture =
  Picture -> DocH mod a
forall mod id. Picture -> DocH mod id
DocPic (Picture -> DocH mod a) -> (Text -> Picture) -> Text -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String -> Picture) -> Text -> Picture
forall a. (String -> Maybe String -> a) -> Text -> a
makeLabeled String -> Maybe String -> Picture
Picture
    (Text -> DocH mod a)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"<<" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
">>")

-- | Inline math parser, surrounded by \\( and \\).
--
-- >>> parseString "\\(\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\)"
-- DocMathInline "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}"
mathInline :: Parser (DocH mod a)
mathInline :: forall mod a. Parser (DocH mod a)
mathInline =
  String -> DocH mod a
forall mod id. String -> DocH mod id
DocMathInline (String -> DocH mod a) -> (Text -> String) -> Text -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    (Text -> DocH mod a)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"\\(" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
"\\)")

-- | Display math parser, surrounded by \\[ and \\].
--
-- >>> parseString "\\[\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\]"
-- DocMathDisplay "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}"
mathDisplay :: Parser (DocH mod a)
mathDisplay :: forall mod a. Parser (DocH mod a)
mathDisplay =
  String -> DocH mod a
forall mod id. String -> DocH mod id
DocMathDisplay (String -> DocH mod a) -> (Text -> String) -> Text -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    (Text -> DocH mod a)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"\\[" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
"\\]")

-- | Markdown image parser. As per the commonmark reference recommendation, the
-- description text for an image converted to its a plain string representation.
--
-- >>> parseString "![some /emphasis/ in a description](www.site.com)"
-- DocPic (Picture "www.site.com" (Just "some emphasis in a description"))
markdownImage :: Parser (DocH mod Identifier)
markdownImage :: forall mod. Parser (DocH mod Identifier)
markdownImage = do
  text <- DocMarkupH (ZonkAny 0) Identifier String
-> DocH (ZonkAny 0) Identifier -> String
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup DocMarkupH (ZonkAny 0) Identifier String
forall {mod}. DocMarkupH mod Identifier String
stringMarkup (DocH (ZonkAny 0) Identifier -> String)
-> ParsecT Text ParserState Identity (DocH (ZonkAny 0) Identifier)
-> ParsecT Text ParserState Identity String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"!" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH (ZonkAny 0) Identifier)
-> ParsecT Text ParserState Identity (DocH (ZonkAny 0) Identifier)
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity (DocH (ZonkAny 0) Identifier)
forall mod. Parser (DocH mod Identifier)
markdownLinkText)
  url <- markdownLinkTarget
  pure $ DocPic (Picture url (Just text))
  where
    stringMarkup :: DocMarkupH mod Identifier String
stringMarkup = (mod -> String)
-> (Identifier -> String) -> DocMarkupH mod Identifier String
forall mod id.
(mod -> String) -> (id -> String) -> DocMarkupH mod id String
plainMarkup (String -> mod -> String
forall a b. a -> b -> a
const String
"") Identifier -> String
renderIdent
    renderIdent :: Identifier -> String
renderIdent (Identifier Namespace
ns Char
l String
c Char
r) = Namespace -> String
renderNs Namespace
ns String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
l] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
r]

-- | Paragraph parser, called by 'parseParas'.
paragraph :: Parser (DocH mod Identifier)
paragraph :: forall mod. Parser (DocH mod Identifier)
paragraph =
  [Parser (DocH mod Identifier)] -> Parser (DocH mod Identifier)
forall a. [Parser a] -> Parser a
choice'
    [ Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
examples
    , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
table
    , do
        indent <- ParsecT Text ParserState Identity Text
takeIndent
        choice'
          [ since
          , unorderedList indent
          , orderedList indent
          , birdtracks
          , codeblock
          , property
          , header
          , textParagraphThatStartsWithMarkdownLink
          , definitionList indent
          , docParagraph <$> textParagraph
          ]
    ]

-- | Provides support for grid tables.
--
-- Tables are composed by an optional header and body. The header is composed by
-- a single row. The body is composed by a non-empty list of rows.
--
-- Example table with header:
--
-- > +----------+----------+
-- > | /32bit/  |   64bit  |
-- > +==========+==========+
-- > |  0x0000  | @0x0000@ |
-- > +----------+----------+
--
-- Algorithms loosely follows ideas in
-- http://docutils.sourceforge.net/docutils/parsers/rst/tableparser.py
table :: Parser (DocH mod Identifier)
table :: forall mod. Parser (DocH mod Identifier)
table = do
  -- first we parse the first row, which determines the width of the table
  firstRow <- ParsecT Text ParserState Identity Text
parseFirstRow
  let len = Text -> Int
T.length Text
firstRow

  -- then we parse all consecutive rows starting and ending with + or |,
  -- of the width `len`.
  restRows <- many (try (parseRestRows len))

  -- Now we gathered the table block, the next step is to split the block
  -- into cells.
  DocTable <$> tableStepTwo len (firstRow : restRows)
  where
    parseFirstRow :: Parser Text
    parseFirstRow :: ParsecT Text ParserState Identity Text
parseFirstRow = do
      ParsecT Text ParserState Identity ()
skipHorizontalSpace
      cs <- (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+')

      -- upper-left and upper-right corners are `+`
      guard
        ( T.length cs >= 2
            && T.head cs == '+'
            && T.last cs == '+'
        )

      -- trailing space
      skipHorizontalSpace
      _ <- Parsec.newline

      return cs

    parseRestRows :: Int -> Parser Text
    parseRestRows :: Int -> ParsecT Text ParserState Identity Text
parseRestRows Int
l = do
      ParsecT Text ParserState Identity ()
skipHorizontalSpace
      bs <- (Int -> Char -> Maybe Int)
-> Int -> ParsecT Text ParserState Identity Text
forall s.
(s -> Char -> Maybe s)
-> s -> ParsecT Text ParserState Identity Text
scan Int -> Char -> Maybe Int
forall {a}. (Ord a, Num a) => a -> Char -> Maybe a
predicate Int
l

      -- Left and right edges are `|` or `+`
      guard
        ( T.length bs >= 2
            && (T.head bs == '|' || T.head bs == '+')
            && (T.last bs == '|' || T.last bs == '+')
        )

      -- trailing space
      skipHorizontalSpace
      _ <- Parsec.newline

      return bs
      where
        predicate :: a -> Char -> Maybe a
predicate a
n Char
c
          | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 = Maybe a
forall a. Maybe a
Nothing
          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = Maybe a
forall a. Maybe a
Nothing
          | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)

-- Second step searchs for row of '+' and '=' characters, records it's index
-- and changes to '=' to '-'.
tableStepTwo
  :: Int
  -- ^ width
  -> [Text]
  -- ^ rows
  -> Parser (Table (DocH mod Identifier))
tableStepTwo :: forall mod. Int -> [Text] -> Parser (Table (DocH mod Identifier))
tableStepTwo Int
width = Int -> [Text] -> [Text] -> Parser (Table (DocH mod Identifier))
forall {mod}.
Int -> [Text] -> [Text] -> Parser (Table (DocH mod Identifier))
go Int
0 []
  where
    go :: Int -> [Text] -> [Text] -> Parser (Table (DocH mod Identifier))
go Int
_ [Text]
left [] = Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
forall mod.
Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
tableStepThree Int
width ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
left) Maybe Int
forall a. Maybe a
Nothing
    go Int
n [Text]
left (Text
r : [Text]
rs)
      | (Char -> Bool) -> Text -> Bool
T.all (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char
'+', Char
'=']) Text
r =
          Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
forall mod.
Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
tableStepThree Int
width ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
left [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text
r' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
rs) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
      | Bool
otherwise =
          Int -> [Text] -> [Text] -> Parser (Table (DocH mod Identifier))
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Text
r Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
left) [Text]
rs
      where
        r' :: Text
r' = (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=' then Char
'-' else Char
c) Text
r

-- Third step recognises cells in the table area, returning a list of TC, cells.
tableStepThree
  :: Int
  -- ^ width
  -> [Text]
  -- ^ rows
  -> Maybe Int
  -- ^ index of header separator
  -> Parser (Table (DocH mod Identifier))
tableStepThree :: forall mod.
Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
tableStepThree Int
width [Text]
rs Maybe Int
hdrIndex = do
  cells <- Set (Int, Int) -> Parser [TC]
loop ((Int, Int) -> Set (Int, Int)
forall a. a -> Set a
Set.singleton (Int
0, Int
0))
  tableStepFour rs hdrIndex cells
  where
    height :: Int
height = [Text] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Text]
rs

    loop :: Set.Set (Int, Int) -> Parser [TC]
    loop :: Set (Int, Int) -> Parser [TC]
loop Set (Int, Int)
queue = case Set (Int, Int) -> Maybe ((Int, Int), Set (Int, Int))
forall a. Set a -> Maybe (a, Set a)
Set.minView Set (Int, Int)
queue of
      Maybe ((Int, Int), Set (Int, Int))
Nothing -> [TC] -> Parser [TC]
forall a. a -> ParsecT Text ParserState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
      Just ((Int
y, Int
x), Set (Int, Int)
queue')
        | Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
height Bool -> Bool -> Bool
|| Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
width -> Set (Int, Int) -> Parser [TC]
loop Set (Int, Int)
queue'
        | Bool
otherwise -> case Int -> Int -> Maybe (Int, Int)
scanRight Int
x Int
y of
            Maybe (Int, Int)
Nothing -> Set (Int, Int) -> Parser [TC]
loop Set (Int, Int)
queue'
            Just (Int
x2, Int
y2) -> do
              let tc :: TC
tc = Int -> Int -> Int -> Int -> TC
TC Int
y Int
x Int
y2 Int
x2
              ([TC] -> [TC]) -> Parser [TC] -> Parser [TC]
forall a b.
(a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (TC
tc TC -> [TC] -> [TC]
forall a. a -> [a] -> [a]
:) (Parser [TC] -> Parser [TC]) -> Parser [TC] -> Parser [TC]
forall a b. (a -> b) -> a -> b
$
                Set (Int, Int) -> Parser [TC]
loop (Set (Int, Int) -> Parser [TC]) -> Set (Int, Int) -> Parser [TC]
forall a b. (a -> b) -> a -> b
$
                  Set (Int, Int)
queue'
                    Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` [(Int, Int)] -> Set (Int, Int)
forall a. Ord a => [a] -> Set a
Set.fromList
                      [(Int
y, Int
x2), (Int
y2, Int
x), (Int
y2, Int
x2)]

    -- scan right looking for +, then try scan down
    --
    -- do we need to record + saw on the way left and down?
    scanRight :: Int -> Int -> Maybe (Int, Int)
    scanRight :: Int -> Int -> Maybe (Int, Int)
scanRight Int
x Int
y = Int -> Maybe (Int, Int)
go (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        bs :: Text
bs = [Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y
        go :: Int -> Maybe (Int, Int)
go Int
x'
          | Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
width = String -> Maybe (Int, Int)
forall a. HasCallStack => String -> Maybe a
forall (m :: Type -> Type) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"overflow right "
          | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
bs Int
x' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' = Int -> Int -> Int -> Maybe (Int, Int)
scanDown Int
x Int
y Int
x' Maybe (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe (Int, Int)
go (Int
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
bs Int
x' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = Int -> Maybe (Int, Int)
go (Int
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = String -> Maybe (Int, Int)
forall a. HasCallStack => String -> Maybe a
forall (m :: Type -> Type) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Maybe (Int, Int)) -> String -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ String
"not a border (right) " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int) -> String
forall a. Show a => a -> String
show (Int
x, Int
y, Int
x')

    -- scan down looking for +
    scanDown :: Int -> Int -> Int -> Maybe (Int, Int)
    scanDown :: Int -> Int -> Int -> Maybe (Int, Int)
scanDown Int
x Int
y Int
x2 = Int -> Maybe (Int, Int)
go (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        go :: Int -> Maybe (Int, Int)
go Int
y'
          | Int
y' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
height = String -> Maybe (Int, Int)
forall a. HasCallStack => String -> Maybe a
forall (m :: Type -> Type) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"overflow down"
          | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index ([Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y') Int
x2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' = Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanLeft Int
x Int
y Int
x2 Int
y' Maybe (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe (Int, Int)
go (Int
y' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index ([Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y') Int
x2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' = Int -> Maybe (Int, Int)
go (Int
y' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = String -> Maybe (Int, Int)
forall a. HasCallStack => String -> Maybe a
forall (m :: Type -> Type) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Maybe (Int, Int)) -> String -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ String
"not a border (down) " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int, Int) -> String
forall a. Show a => a -> String
show (Int
x, Int
y, Int
x2, Int
y')

    -- check that at y2 x..x2 characters are '+' or '-'
    scanLeft :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
    scanLeft :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanLeft Int
x Int
y Int
x2 Int
y2
      | (Int -> Bool) -> [Int] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (\Int
x' -> HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
bs Int
x' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char
'+', Char
'-']) [Int
x .. Int
x2] = Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanUp Int
x Int
y Int
x2 Int
y2
      | Bool
otherwise = String -> Maybe (Int, Int)
forall a. HasCallStack => String -> Maybe a
forall (m :: Type -> Type) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Maybe (Int, Int)) -> String -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ String
"not a border (left) " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int, Int) -> String
forall a. Show a => a -> String
show (Int
x, Int
y, Int
x2, Int
y2)
      where
        bs :: Text
bs = [Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y2

    -- check that at y2 x..x2 characters are '+' or '-'
    scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
    scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanUp Int
x Int
y Int
x2 Int
y2
      | (Int -> Bool) -> [Int] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (\Int
y' -> HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index ([Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y') Int
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char
'+', Char
'|']) [Int
y .. Int
y2] = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int
x2, Int
y2)
      | Bool
otherwise = String -> Maybe (Int, Int)
forall a. HasCallStack => String -> Maybe a
forall (m :: Type -> Type) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Maybe (Int, Int)) -> String -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ String
"not a border (up) " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int, Int) -> String
forall a. Show a => a -> String
show (Int
x, Int
y, Int
x2, Int
y2)

-- | table cell: top left bottom right
data TC = TC !Int !Int !Int !Int
  deriving (Int -> TC -> String -> String
[TC] -> String -> String
TC -> String
(Int -> TC -> String -> String)
-> (TC -> String) -> ([TC] -> String -> String) -> Show TC
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TC -> String -> String
showsPrec :: Int -> TC -> String -> String
$cshow :: TC -> String
show :: TC -> String
$cshowList :: [TC] -> String -> String
showList :: [TC] -> String -> String
Show)

tcXS :: TC -> [Int]
tcXS :: TC -> [Int]
tcXS (TC Int
_ Int
x Int
_ Int
x2) = [Int
x, Int
x2]

tcYS :: TC -> [Int]
tcYS :: TC -> [Int]
tcYS (TC Int
y Int
_ Int
y2 Int
_) = [Int
y, Int
y2]

-- | Fourth step. Given the locations of cells, forms 'Table' structure.
tableStepFour :: [Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
tableStepFour :: forall mod.
[Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
tableStepFour [Text]
rs Maybe Int
hdrIndex [TC]
cells = case Maybe Int
hdrIndex of
  Maybe Int
Nothing -> Table (DocH mod Identifier) -> Parser (Table (DocH mod Identifier))
forall a. a -> ParsecT Text ParserState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Table (DocH mod Identifier)
 -> Parser (Table (DocH mod Identifier)))
-> Table (DocH mod Identifier)
-> Parser (Table (DocH mod Identifier))
forall a b. (a -> b) -> a -> b
$ [TableRow (DocH mod Identifier)]
-> [TableRow (DocH mod Identifier)] -> Table (DocH mod Identifier)
forall id. [TableRow id] -> [TableRow id] -> Table id
Table [] [TableRow (DocH mod Identifier)]
forall {mod}. [TableRow (DocH mod Identifier)]
rowsDoc
  Just Int
i -> case Int -> [Int] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
i [Int]
yTabStops of
    Maybe Int
Nothing -> Table (DocH mod Identifier) -> Parser (Table (DocH mod Identifier))
forall a. a -> ParsecT Text ParserState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Table (DocH mod Identifier)
 -> Parser (Table (DocH mod Identifier)))
-> Table (DocH mod Identifier)
-> Parser (Table (DocH mod Identifier))
forall a b. (a -> b) -> a -> b
$ [TableRow (DocH mod Identifier)]
-> [TableRow (DocH mod Identifier)] -> Table (DocH mod Identifier)
forall id. [TableRow id] -> [TableRow id] -> Table id
Table [] [TableRow (DocH mod Identifier)]
forall {mod}. [TableRow (DocH mod Identifier)]
rowsDoc
    Just Int
i' -> Table (DocH mod Identifier) -> Parser (Table (DocH mod Identifier))
forall a. a -> ParsecT Text ParserState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Table (DocH mod Identifier)
 -> Parser (Table (DocH mod Identifier)))
-> Table (DocH mod Identifier)
-> Parser (Table (DocH mod Identifier))
forall a b. (a -> b) -> a -> b
$ ([TableRow (DocH mod Identifier)]
 -> [TableRow (DocH mod Identifier)] -> Table (DocH mod Identifier))
-> ([TableRow (DocH mod Identifier)],
    [TableRow (DocH mod Identifier)])
-> Table (DocH mod Identifier)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [TableRow (DocH mod Identifier)]
-> [TableRow (DocH mod Identifier)] -> Table (DocH mod Identifier)
forall id. [TableRow id] -> [TableRow id] -> Table id
Table (([TableRow (DocH mod Identifier)],
  [TableRow (DocH mod Identifier)])
 -> Table (DocH mod Identifier))
-> ([TableRow (DocH mod Identifier)],
    [TableRow (DocH mod Identifier)])
-> Table (DocH mod Identifier)
forall a b. (a -> b) -> a -> b
$ Int
-> [TableRow (DocH mod Identifier)]
-> ([TableRow (DocH mod Identifier)],
    [TableRow (DocH mod Identifier)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i' [TableRow (DocH mod Identifier)]
forall {mod}. [TableRow (DocH mod Identifier)]
rowsDoc
  where
    xTabStops :: [Int]
xTabStops = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (TC -> [Int]) -> [TC] -> [Int]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap TC -> [Int]
tcXS [TC]
cells
    yTabStops :: [Int]
yTabStops = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (TC -> [Int]) -> [TC] -> [Int]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap TC -> [Int]
tcYS [TC]
cells

    sortNub :: Ord a => [a] -> [a]
    sortNub :: forall a. Ord a => [a] -> [a]
sortNub = Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList

    init' :: [a] -> [a]
    init' :: forall a. [a] -> [a]
init' [] = []
    init' [a
_] = []
    init' (a
x : [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. [a] -> [a]
init' [a]
xs

    rowsDoc :: [TableRow (DocH mod Identifier)]
rowsDoc = ((TableRow Text -> TableRow (DocH mod Identifier))
-> [TableRow Text] -> [TableRow (DocH mod Identifier)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TableRow Text -> TableRow (DocH mod Identifier))
 -> [TableRow Text] -> [TableRow (DocH mod Identifier)])
-> ((Text -> DocH mod Identifier)
    -> TableRow Text -> TableRow (DocH mod Identifier))
-> (Text -> DocH mod Identifier)
-> [TableRow Text]
-> [TableRow (DocH mod Identifier)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> DocH mod Identifier)
-> TableRow Text -> TableRow (DocH mod Identifier)
forall a b. (a -> b) -> TableRow a -> TableRow b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap) Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseParagraph [TableRow Text]
rows

    rows :: [TableRow Text]
rows = (Int -> TableRow Text) -> [Int] -> [TableRow Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> TableRow Text
makeRow ([Int] -> [Int]
forall a. [a] -> [a]
init' [Int]
yTabStops)
      where
        makeRow :: Int -> TableRow Text
makeRow Int
y = [TableCell Text] -> TableRow Text
forall id. [TableCell id] -> TableRow id
TableRow ([TableCell Text] -> TableRow Text)
-> [TableCell Text] -> TableRow Text
forall a b. (a -> b) -> a -> b
$ (TC -> Maybe (TableCell Text)) -> [TC] -> [TableCell Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> TC -> Maybe (TableCell Text)
makeCell Int
y) [TC]
cells
        makeCell :: Int -> TC -> Maybe (TableCell Text)
makeCell Int
y (TC Int
y' Int
x Int
y2 Int
x2)
          | Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y' = Maybe (TableCell Text)
forall a. Maybe a
Nothing
          | Bool
otherwise = TableCell Text -> Maybe (TableCell Text)
forall a. a -> Maybe a
Just (TableCell Text -> Maybe (TableCell Text))
-> TableCell Text -> Maybe (TableCell Text)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> TableCell Text
forall id. Int -> Int -> id -> TableCell id
TableCell Int
xts Int
yts (Int -> Int -> Int -> Int -> Text
extract (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
y2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
          where
            xts :: Int
xts = [Int] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x) [Int]
xTabStops
            yts :: Int
yts = [Int] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y2) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y) [Int]
yTabStops

    -- extract cell contents given boundaries
    extract :: Int -> Int -> Int -> Int -> Text
    extract :: Int -> Int -> Int -> Int -> Text
extract Int
x Int
y Int
x2 Int
y2 =
      Text -> [Text] -> Text
T.intercalate
        Text
"\n"
        [ Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripStart (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
x (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y'
        | Int
y' <- [Int
y .. Int
y2]
        ]

-- | Parse \@since annotations.
since :: Parser (DocH mod a)
since :: forall mod a. Parser (DocH mod a)
since = do
  (ParsecT Text ParserState Identity Text
"@since " ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity MetaSince
-> ParsecT Text ParserState Identity MetaSince
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity MetaSince
version ParsecT Text ParserState Identity MetaSince
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity MetaSince
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity MetaSince
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity MetaSince
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
endOfLine) ParsecT Text ParserState Identity MetaSince
-> (MetaSince -> ParsecT Text ParserState Identity ())
-> ParsecT Text ParserState Identity ()
forall a b.
ParsecT Text ParserState Identity a
-> (a -> ParsecT Text ParserState Identity b)
-> ParsecT Text ParserState Identity b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaSince -> ParsecT Text ParserState Identity ()
setSince
  DocH mod a -> ParsecT Text ParserState Identity (DocH mod a)
forall a. a -> ParsecT Text ParserState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return DocH mod a
forall mod id. DocH mod id
DocEmpty
  where
    version :: ParsecT Text ParserState Identity MetaSince
version = do
      pkg <- ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity (Maybe String)
forall s (m :: Type -> Type) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
Parsec.optionMaybe (ParsecT Text ParserState Identity String
 -> ParsecT Text ParserState Identity (Maybe String))
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity (Maybe String)
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
Parsec.try (ParsecT Text ParserState Identity String
 -> ParsecT Text ParserState Identity String)
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Text ParserState Identity String
forall {u}. ParsecT Text u Identity String
package
      ver <- decimal `Parsec.sepBy1` "."
      return (MetaSince pkg ver)

    package :: ParsecT Text u Identity String
package = [String] -> String
combine ([String] -> String)
-> ParsecT Text u Identity [String]
-> ParsecT Text u Identity String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m [a]
Parsec.many1 (ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
ParsecT s u m Char
Parsec.letter ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall a.
ParsecT Text u Identity a
-> ParsecT Text u Identity a -> ParsecT Text u Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'_')) ParsecT Text u Identity String
-> ParsecT Text u Identity Char -> ParsecT Text u Identity [String]
forall s (m :: Type -> Type) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`Parsec.endBy1` (Char -> ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'-')
    combine :: [String] -> String
combine = [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"-"

-- | Headers inside the comment denoted with @=@ signs, up to 6 levels
-- deep.
--
-- >>> snd <$> parseOnly header "= Hello"
-- Right (DocHeader (Header {headerLevel = 1, headerTitle = DocString "Hello"}))
-- >>> snd <$> parseOnly header "== World"
-- Right (DocHeader (Header {headerLevel = 2, headerTitle = DocString "World"}))
header :: Parser (DocH mod Identifier)
header :: forall mod. Parser (DocH mod Identifier)
header = do
  let psers :: [ParsecT Text ParserState Identity Text]
psers = (Int -> ParsecT Text ParserState Identity Text)
-> [Int] -> [ParsecT Text ParserState Identity Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ParsecT Text ParserState Identity Text
string (Text -> ParsecT Text ParserState Identity Text)
-> (Int -> Text) -> Int -> ParsecT Text ParserState Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text -> Text) -> Text -> Int -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> Text
T.replicate Text
"=") [Int
6, Int
5 .. Int
1]
      pser :: ParsecT Text ParserState Identity Text
pser = [ParsecT Text ParserState Identity Text]
-> ParsecT Text ParserState Identity Text
forall s (m :: Type -> Type) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
Parsec.choice [ParsecT Text ParserState Identity Text]
psers
  depth <- Text -> Int
T.length (Text -> Int)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
pser
  line <- parseText <$> (skipHorizontalSpace *> nonEmptyLine)
  rest <- try paragraph <|> return DocEmpty
  return $ DocHeader (Header depth line) `docAppend` rest

textParagraph :: Parser (DocH mod Identifier)
textParagraph :: forall mod. Parser (DocH mod Identifier)
textParagraph = Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseText (Text -> DocH mod Identifier)
-> ([Text] -> Text) -> [Text] -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> DocH mod Identifier)
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
some ParsecT Text ParserState Identity Text
nonEmptyLine

textParagraphThatStartsWithMarkdownLink :: Parser (DocH mod Identifier)
textParagraphThatStartsWithMarkdownLink :: forall mod. Parser (DocH mod Identifier)
textParagraphThatStartsWithMarkdownLink = DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id
docParagraph (DocH mod Identifier -> DocH mod Identifier)
-> ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (DocH mod Identifier -> DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
docAppend (DocH mod Identifier -> DocH mod Identifier -> DocH mod Identifier)
-> ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT
     Text
     ParserState
     Identity
     (DocH mod Identifier -> DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
markdownLink ParsecT
  Text
  ParserState
  Identity
  (DocH mod Identifier -> DocH mod Identifier)
-> ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
optionalTextParagraph)
  where
    optionalTextParagraph :: Parser (DocH mod Identifier)
    optionalTextParagraph :: forall mod. Parser (DocH mod Identifier)
optionalTextParagraph =
      [Parser (DocH mod Identifier)] -> Parser (DocH mod Identifier)
forall a. [Parser a] -> Parser a
choice'
        [ DocH mod Identifier -> DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
docAppend (DocH mod Identifier -> DocH mod Identifier -> DocH mod Identifier)
-> Parser (DocH mod Identifier)
-> ParsecT
     Text
     ParserState
     Identity
     (DocH mod Identifier -> DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
whitespace ParsecT
  Text
  ParserState
  Identity
  (DocH mod Identifier -> DocH mod Identifier)
-> Parser (DocH mod Identifier) -> Parser (DocH mod Identifier)
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
textParagraph
        , DocH mod Identifier -> Parser (DocH mod Identifier)
forall a. a -> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DocH mod Identifier
forall mod id. DocH mod id
DocEmpty
        ]

    whitespace :: Parser (DocH mod a)
    whitespace :: forall mod a. Parser (DocH mod a)
whitespace = String -> DocH mod a
forall mod id. String -> DocH mod id
DocString (String -> DocH mod a)
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text -> String
f (Text -> Maybe Text -> String)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (Maybe Text -> String)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
takeHorizontalSpace ParsecT Text ParserState Identity (Maybe Text -> String)
-> ParsecT Text ParserState Identity (Maybe Text)
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (Maybe Text)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text ParserState Identity Text
"\n")
      where
        f :: Text -> Maybe Text -> String
        f :: Text -> Maybe Text -> String
f Text
xs (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" -> Text
x)
          | Text -> Bool
T.null (Text
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) = String
""
          | Bool
otherwise = String
" "

-- | Parses unordered (bullet) lists.
unorderedList :: Text -> Parser (DocH mod Identifier)
unorderedList :: forall mod. Text -> Parser (DocH mod Identifier)
unorderedList Text
indent = [DocH mod Identifier] -> DocH mod Identifier
forall mod id. [DocH mod id] -> DocH mod id
DocUnorderedList ([DocH mod Identifier] -> DocH mod Identifier)
-> ParsecT Text ParserState Identity [DocH mod Identifier]
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity [DocH mod Identifier]
forall {mod}.
ParsecT Text ParserState Identity [DocH mod Identifier]
p
  where
    p :: ParsecT Text ParserState Identity [DocH mod Identifier]
p = (ParsecT Text ParserState Identity Text
"*" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity Text
"-") ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [DocH mod Identifier]
-> ParsecT Text ParserState Identity [DocH mod Identifier]
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Text
-> ParsecT Text ParserState Identity [DocH mod Identifier]
-> ParsecT Text ParserState Identity [DocH mod Identifier]
forall mod.
Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
innerList Text
indent ParsecT Text ParserState Identity [DocH mod Identifier]
p

-- | Parses ordered lists (numbered or dashed).
orderedList :: Text -> Parser (DocH mod Identifier)
orderedList :: forall mod. Text -> Parser (DocH mod Identifier)
orderedList Text
indent = [(Int, DocH mod Identifier)] -> DocH mod Identifier
forall mod id. [(Int, DocH mod id)] -> DocH mod id
DocOrderedList ([(Int, DocH mod Identifier)] -> DocH mod Identifier)
-> ParsecT Text ParserState Identity [(Int, DocH mod Identifier)]
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity [(Int, DocH mod Identifier)]
forall {mod}.
ParsecT Text ParserState Identity [(Int, DocH mod Identifier)]
p
  where
    p :: ParsecT Text ParserState Identity [(Int, DocH mod Identifier)]
p = do
      index <- ParsecT Text ParserState Identity Int
paren ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Int
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity Int
dot
      innerList' indent p index
    dot :: ParsecT Text ParserState Identity Int
dot = (ParsecT Text ParserState Identity Int
forall a. Integral a => Parser a
decimal :: Parser Int) ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Int
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"."
    paren :: ParsecT Text ParserState Identity Int
paren = ParsecT Text ParserState Identity Text
"(" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Int
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Int
forall a. Integral a => Parser a
decimal ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Int
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
")"

-- | Like 'innerList' but takes the parsed index of the list item
innerList'
  :: Text
  -> Parser [(Int, DocH mod Identifier)]
  -> Int
  -> Parser [(Int, DocH mod Identifier)]
innerList' :: forall mod.
Text
-> Parser [(Int, DocH mod Identifier)]
-> Int
-> Parser [(Int, DocH mod Identifier)]
innerList' Text
indent Parser [(Int, DocH mod Identifier)]
item Int
index = do
  c <- ParsecT Text ParserState Identity Text
takeLine
  (cs, items) <- more indent item
  let contents = DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id
docParagraph (DocH mod Identifier -> DocH mod Identifier)
-> ([Text] -> DocH mod Identifier) -> [Text] -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseText (Text -> DocH mod Identifier)
-> ([Text] -> Text) -> [Text] -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropNLs (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> DocH mod Identifier) -> [Text] -> DocH mod Identifier
forall a b. (a -> b) -> a -> b
$ Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs
  return $ case items of
    Left DocH mod Identifier
p -> [(Int
index, DocH mod Identifier
forall {mod}. DocH mod Identifier
contents DocH mod Identifier -> DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` DocH mod Identifier
p)]
    Right [(Int, DocH mod Identifier)]
i -> (Int
index, DocH mod Identifier
forall {mod}. DocH mod Identifier
contents) (Int, DocH mod Identifier)
-> [(Int, DocH mod Identifier)] -> [(Int, DocH mod Identifier)]
forall a. a -> [a] -> [a]
: [(Int, DocH mod Identifier)]
i

-- | Generic function collecting any further lines belonging to the
-- list entry and recursively collecting any further lists in the
-- same paragraph. Usually used as
--
-- > someListFunction = listBeginning *> innerList someListFunction
innerList
  :: Text
  -> Parser [DocH mod Identifier]
  -> Parser [DocH mod Identifier]
innerList :: forall mod.
Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
innerList Text
indent Parser [DocH mod Identifier]
item = do
  c <- ParsecT Text ParserState Identity Text
takeLine
  (cs, items) <- more indent item
  let contents = DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id
docParagraph (DocH mod Identifier -> DocH mod Identifier)
-> ([Text] -> DocH mod Identifier) -> [Text] -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseText (Text -> DocH mod Identifier)
-> ([Text] -> Text) -> [Text] -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropNLs (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> DocH mod Identifier) -> [Text] -> DocH mod Identifier
forall a b. (a -> b) -> a -> b
$ Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs
  return $ case items of
    Left DocH mod Identifier
p -> [DocH mod Identifier
forall {mod}. DocH mod Identifier
contents DocH mod Identifier -> DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` DocH mod Identifier
p]
    Right [DocH mod Identifier]
i -> DocH mod Identifier
forall {mod}. DocH mod Identifier
contents DocH mod Identifier
-> [DocH mod Identifier] -> [DocH mod Identifier]
forall a. a -> [a] -> [a]
: [DocH mod Identifier]
i

-- | Parses definition lists.
definitionList :: Text -> Parser (DocH mod Identifier)
definitionList :: forall mod. Text -> Parser (DocH mod Identifier)
definitionList Text
indent = [(DocH mod Identifier, DocH mod Identifier)] -> DocH mod Identifier
forall mod id. [(DocH mod id, DocH mod id)] -> DocH mod id
DocDefList ([(DocH mod Identifier, DocH mod Identifier)]
 -> DocH mod Identifier)
-> ParsecT
     Text
     ParserState
     Identity
     [(DocH mod Identifier, DocH mod Identifier)]
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  Text
  ParserState
  Identity
  [(DocH mod Identifier, DocH mod Identifier)]
forall {mod} {mod}.
ParsecT
  Text
  ParserState
  Identity
  [(DocH mod Identifier, DocH mod Identifier)]
p
  where
    p :: ParsecT
  Text
  ParserState
  Identity
  [(DocH mod Identifier, DocH mod Identifier)]
p = do
      label <- ParsecT Text ParserState Identity Text
"[" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> (Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseParagraph (Text -> DocH mod Identifier)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (Char -> String -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`notElem` (String
"]\n" :: String))) ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* (ParsecT Text ParserState Identity Text
"]" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (Maybe Text)
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (Maybe Text)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text ParserState Identity Text
":")
      c <- takeLine
      (cs, items) <- more indent p
      let contents = Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseText (Text -> DocH mod Identifier)
-> ([Text] -> Text) -> [Text] -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropNLs (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> DocH mod Identifier) -> [Text] -> DocH mod Identifier
forall a b. (a -> b) -> a -> b
$ Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs
      return $ case items of
        Left DocH mod Identifier
x -> [(DocH mod Identifier
label, DocH mod Identifier
forall {mod}. DocH mod Identifier
contents DocH mod Identifier -> DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` DocH mod Identifier
x)]
        Right [(DocH mod Identifier, DocH mod Identifier)]
i -> (DocH mod Identifier
label, DocH mod Identifier
forall {mod}. DocH mod Identifier
contents) (DocH mod Identifier, DocH mod Identifier)
-> [(DocH mod Identifier, DocH mod Identifier)]
-> [(DocH mod Identifier, DocH mod Identifier)]
forall a. a -> [a] -> [a]
: [(DocH mod Identifier, DocH mod Identifier)]
i

-- | Drops all trailing newlines.
dropNLs :: Text -> Text
dropNLs :: Text -> Text
dropNLs = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

-- | Main worker for 'innerList' and 'definitionList'.
-- We need the 'Either' here to be able to tell in the respective functions
-- whether we're dealing with the next list or a nested paragraph.
more
  :: Monoid a
  => Text
  -> Parser a
  -> Parser ([Text], Either (DocH mod Identifier) a)
more :: forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
more Text
indent Parser a
item =
  [Parser ([Text], Either (DocH mod Identifier) a)]
-> Parser ([Text], Either (DocH mod Identifier) a)
forall a. [Parser a] -> Parser a
choice'
    [ Text -> Parser ([Text], Either (DocH mod Identifier) a)
forall mod a.
Text -> Parser ([Text], Either (DocH mod Identifier) a)
innerParagraphs Text
indent
    , Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
forall a mod.
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
moreListItems Text
indent Parser a
item
    , Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
moreContent Text
indent Parser a
item
    , ([Text], Either (DocH mod Identifier) a)
-> Parser ([Text], Either (DocH mod Identifier) a)
forall a. a -> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([], a -> Either (DocH mod Identifier) a
forall a b. b -> Either a b
Right a
forall a. Monoid a => a
mempty)
    ]

-- | Used by 'innerList' and 'definitionList' to parse any nested paragraphs.
innerParagraphs
  :: Text
  -> Parser ([Text], Either (DocH mod Identifier) a)
innerParagraphs :: forall mod a.
Text -> Parser ([Text], Either (DocH mod Identifier) a)
innerParagraphs Text
indent = (,) [] (Either (DocH mod Identifier) a
 -> ([Text], Either (DocH mod Identifier) a))
-> (DocH mod Identifier -> Either (DocH mod Identifier) a)
-> DocH mod Identifier
-> ([Text], Either (DocH mod Identifier) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocH mod Identifier -> Either (DocH mod Identifier) a
forall a b. a -> Either a b
Left (DocH mod Identifier -> ([Text], Either (DocH mod Identifier) a))
-> ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT
     Text ParserState Identity ([Text], Either (DocH mod Identifier) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"\n" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod Identifier)
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. Text -> Parser (DocH mod Identifier)
indentedParagraphs Text
indent)

-- | Attempts to fetch the next list if possibly. Used by 'innerList' and
-- 'definitionList' to recursively grab lists that aren't separated by a whole
-- paragraph.
moreListItems
  :: Text
  -> Parser a
  -> Parser ([Text], Either (DocH mod Identifier) a)
moreListItems :: forall a mod.
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
moreListItems Text
indent Parser a
item = (,) [] (Either (DocH mod Identifier) a
 -> ([Text], Either (DocH mod Identifier) a))
-> (a -> Either (DocH mod Identifier) a)
-> a
-> ([Text], Either (DocH mod Identifier) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (DocH mod Identifier) a
forall a b. b -> Either a b
Right (a -> ([Text], Either (DocH mod Identifier) a))
-> Parser a
-> ParsecT
     Text ParserState Identity ([Text], Either (DocH mod Identifier) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
indentedItem
  where
    indentedItem :: Parser a
indentedItem = Text -> ParsecT Text ParserState Identity Text
string Text
indent ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity ()
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity ()
forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces ParsecT Text ParserState Identity () -> Parser a -> Parser a
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Parser a
item

-- | Helper for 'innerList' and 'definitionList' which simply takes
-- a line of text and attempts to parse more list content with 'more'.
moreContent
  :: Monoid a
  => Text
  -> Parser a
  -> Parser ([Text], Either (DocH mod Identifier) a)
moreContent :: forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
moreContent Text
indent Parser a
item = ([Text] -> [Text])
-> ([Text], Either (DocH mod Identifier) a)
-> ([Text], Either (DocH mod Identifier) a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (([Text] -> [Text])
 -> ([Text], Either (DocH mod Identifier) a)
 -> ([Text], Either (DocH mod Identifier) a))
-> (Text -> [Text] -> [Text])
-> Text
-> ([Text], Either (DocH mod Identifier) a)
-> ([Text], Either (DocH mod Identifier) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (Text
 -> ([Text], Either (DocH mod Identifier) a)
 -> ([Text], Either (DocH mod Identifier) a))
-> ParsecT Text ParserState Identity Text
-> ParsecT
     Text
     ParserState
     Identity
     (([Text], Either (DocH mod Identifier) a)
      -> ([Text], Either (DocH mod Identifier) a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
nonEmptyLine ParsecT
  Text
  ParserState
  Identity
  (([Text], Either (DocH mod Identifier) a)
   -> ([Text], Either (DocH mod Identifier) a))
-> ParsecT
     Text ParserState Identity ([Text], Either (DocH mod Identifier) a)
-> ParsecT
     Text ParserState Identity ([Text], Either (DocH mod Identifier) a)
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Text
-> Parser a
-> ParsecT
     Text ParserState Identity ([Text], Either (DocH mod Identifier) a)
forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
more Text
indent Parser a
item

-- | Parses an indented paragraph.
-- The indentation is 4 spaces.
indentedParagraphs :: Text -> Parser (DocH mod Identifier)
indentedParagraphs :: forall mod. Text -> Parser (DocH mod Identifier)
indentedParagraphs Text
indent =
  (Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> String)
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
dropFrontOfPara ParsecT Text ParserState Identity Text
indent') ParsecT Text ParserState Identity String
-> (String
    -> ParsecT Text ParserState Identity (DocH mod Identifier))
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall a b.
ParsecT Text ParserState Identity a
-> (a -> ParsecT Text ParserState Identity b)
-> ParsecT Text ParserState Identity b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT Text ParserState Identity (DocH mod Identifier)
forall mod. String -> Parser (DocH mod Identifier)
parseParagraphs
  where
    indent' :: ParsecT Text ParserState Identity Text
indent' = Text -> ParsecT Text ParserState Identity Text
string (Text -> ParsecT Text ParserState Identity Text)
-> Text -> ParsecT Text ParserState Identity Text
forall a b. (a -> b) -> a -> b
$ Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    "

-- | Grab as many fully indented paragraphs as we can.
dropFrontOfPara :: Parser Text -> Parser [Text]
dropFrontOfPara :: ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
dropFrontOfPara ParsecT Text ParserState Identity Text
sp = do
  currentParagraph <- ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
some (ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState Identity Text
sp ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
takeNonEmptyLine))
  followingParagraphs <-
    choice'
      [ skipHorizontalSpace *> nextPar -- we have more paragraphs to take
      , skipHorizontalSpace *> nlList -- end of the ride, remember the newline
      , Parsec.eof *> return [] -- nothing more to take at all
      ]
  return (currentParagraph ++ followingParagraphs)
  where
    nextPar :: ParsecT Text ParserState Identity [Text]
nextPar = [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
(++) ([Text] -> [Text] -> [Text])
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity ([Text] -> [Text])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity [Text]
nlList ParsecT Text ParserState Identity ([Text] -> [Text])
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity [Text]
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
dropFrontOfPara ParsecT Text ParserState Identity Text
sp
    nlList :: ParsecT Text ParserState Identity [Text]
nlList = ParsecT Text ParserState Identity Text
"\n" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity [Text]
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> [Text] -> ParsecT Text ParserState Identity [Text]
forall a. a -> ParsecT Text ParserState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Text
"\n"]

nonSpace :: Text -> Parser Text
nonSpace :: Text -> ParsecT Text ParserState Identity Text
nonSpace Text
xs
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
xs = String -> ParsecT Text ParserState Identity Text
forall a.
HasCallStack =>
String -> ParsecT Text ParserState Identity a
forall (m :: Type -> Type) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"empty line"
  | Bool
otherwise = Text -> ParsecT Text ParserState Identity Text
forall a. a -> ParsecT Text ParserState Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
xs

-- | Takes a non-empty, not fully whitespace line.
--
--  Doesn't discard the trailing newline.
takeNonEmptyLine :: Parser Text
takeNonEmptyLine :: ParsecT Text ParserState Identity Text
takeNonEmptyLine = do
  l <- (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') ParsecT Text ParserState Identity Text
-> (Text -> ParsecT Text ParserState Identity Text)
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> (a -> ParsecT Text ParserState Identity b)
-> ParsecT Text ParserState Identity b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParsecT Text ParserState Identity Text
nonSpace
  _ <- "\n"
  pure (l <> "\n")

-- | Takes indentation of first non-empty line.
--
-- More precisely: skips all whitespace-only lines and returns indentation
-- (horizontal space, might be empty) of that non-empty line.
takeIndent :: Parser Text
takeIndent :: ParsecT Text ParserState Identity Text
takeIndent = do
  indent <- ParsecT Text ParserState Identity Text
takeHorizontalSpace
  choice'
    [ "\n" *> takeIndent
    , return indent
    ]

-- | Blocks of text of the form:
--
-- >> foo
-- >> bar
-- >> baz
birdtracks :: Parser (DocH mod a)
birdtracks :: forall mod a. Parser (DocH mod a)
birdtracks = DocH mod a -> DocH mod a
forall mod id. DocH mod id -> DocH mod id
DocCodeBlock (DocH mod a -> DocH mod a)
-> ([Text] -> DocH mod a) -> [Text] -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DocH mod a
forall mod id. String -> DocH mod id
DocString (String -> DocH mod a)
-> ([Text] -> String) -> [Text] -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
stripSpace ([Text] -> DocH mod a)
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
some ParsecT Text ParserState Identity Text
line
  where
    line :: ParsecT Text ParserState Identity Text
line = ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
">" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
takeLine)

stripSpace :: [Text] -> [Text]
stripSpace :: [Text] -> [Text]
stripSpace = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe ([Text] -> Maybe [Text] -> [Text])
-> ([Text] -> Maybe [Text]) -> [Text] -> [Text]
forall a b. ([Text] -> a -> b) -> ([Text] -> a) -> [Text] -> b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Text -> Maybe Text) -> [Text] -> Maybe [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Text -> Maybe Text
strip'
  where
    strip' :: Text -> Maybe Text
strip' Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Maybe (Char, Text)
Nothing -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
      Just (Char
' ', Text
t') -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t'
      Maybe (Char, Text)
_ -> Maybe Text
forall a. Maybe a
Nothing

-- | Parses examples. Examples are a paragraph level entity (separated by an empty line).
-- Consecutive examples are accepted.
examples :: Parser (DocH mod a)
examples :: forall mod a. Parser (DocH mod a)
examples = [Example] -> DocH mod a
forall mod id. [Example] -> DocH mod id
DocExamples ([Example] -> DocH mod a)
-> ParsecT Text ParserState Identity [Example]
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many (ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\n")) ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity [Example]
-> ParsecT Text ParserState Identity [Example]
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Maybe Text -> ParsecT Text ParserState Identity [Example]
go Maybe Text
forall a. Maybe a
Nothing)
  where
    go :: Maybe Text -> Parser [Example]
    go :: Maybe Text -> ParsecT Text ParserState Identity [Example]
go Maybe Text
mbInitialIndent = do
      prefix <- ParsecT Text ParserState Identity Text
takeHorizontalSpace ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
">>>"
      initialIndent <- maybe takeHorizontalSpace pure mbInitialIndent
      expr <- takeLine
      (rs, es) <- resultAndMoreExamples (Just initialIndent)
      return (makeExample prefix initialIndent expr rs : es)

    resultAndMoreExamples :: Maybe Text -> Parser ([Text], [Example])
    resultAndMoreExamples :: Maybe Text -> Parser ([Text], [Example])
resultAndMoreExamples Maybe Text
mbInitialIndent = [Parser ([Text], [Example])] -> Parser ([Text], [Example])
forall a. [Parser a] -> Parser a
choice' [Parser ([Text], [Example])
moreExamples, Parser ([Text], [Example])
result, ([Text], [Example]) -> Parser ([Text], [Example])
forall a. a -> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([], [])]
      where
        moreExamples :: Parser ([Text], [Example])
        moreExamples :: Parser ([Text], [Example])
moreExamples = (,) [] ([Example] -> ([Text], [Example]))
-> ParsecT Text ParserState Identity [Example]
-> Parser ([Text], [Example])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> ParsecT Text ParserState Identity [Example]
go Maybe Text
mbInitialIndent

        result :: Parser ([Text], [Example])
        result :: Parser ([Text], [Example])
result = ([Text] -> [Text]) -> ([Text], [Example]) -> ([Text], [Example])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (([Text] -> [Text]) -> ([Text], [Example]) -> ([Text], [Example]))
-> (Text -> [Text] -> [Text])
-> Text
-> ([Text], [Example])
-> ([Text], [Example])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (Text -> ([Text], [Example]) -> ([Text], [Example]))
-> ParsecT Text ParserState Identity Text
-> ParsecT
     Text
     ParserState
     Identity
     (([Text], [Example]) -> ([Text], [Example]))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
nonEmptyLine ParsecT
  Text
  ParserState
  Identity
  (([Text], [Example]) -> ([Text], [Example]))
-> Parser ([Text], [Example]) -> Parser ([Text], [Example])
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser ([Text], [Example])
resultAndMoreExamples Maybe Text
forall a. Maybe a
Nothing

    makeExample :: Text -> Text -> Text -> [Text] -> Example
    makeExample :: Text -> Text -> Text -> [Text] -> Example
makeExample Text
prefix Text
indent Text
expression [Text]
res =
      String -> [String] -> Example
Example (Text -> String
T.unpack (Text -> Text
tryStripIndent (Text -> Text
T.stripEnd Text
expression))) [String]
result
      where
        result :: [String]
result = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall {a}. (Eq a, IsString a) => a -> a
substituteBlankLine (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tryStripPrefix) [Text]
res

        tryStripPrefix :: Text -> Text
tryStripPrefix Text
xs = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
xs (Text -> Text -> Maybe Text
T.stripPrefix Text
prefix Text
xs)
        tryStripIndent :: Text -> Text
tryStripIndent = (Text -> Maybe Text -> Text)
-> (Text -> Text) -> (Text -> Maybe Text) -> Text -> Text
forall a b c.
(a -> b -> c) -> (Text -> a) -> (Text -> b) -> Text -> c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text -> Text
T.stripStart (Text -> Text -> Maybe Text
T.stripPrefix Text
indent)

        substituteBlankLine :: a -> a
substituteBlankLine a
"<BLANKLINE>" = a
""
        substituteBlankLine a
xs = a
xs

nonEmptyLine :: Parser Text
nonEmptyLine :: ParsecT Text ParserState Identity Text
nonEmptyLine = ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
try ((Text -> Bool)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall (m :: Type -> Type) a.
MonadPlus m =>
(a -> Bool) -> m a -> m a
mfilter ((Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) ParsecT Text ParserState Identity Text
takeLine)

takeLine :: Parser Text
takeLine :: ParsecT Text ParserState Identity Text
takeLine = ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
try ((Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
endOfLine)

endOfLine :: Parser ()
endOfLine :: ParsecT Text ParserState Identity ()
endOfLine = ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void ParsecT Text ParserState Identity Text
"\n" ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity ()
forall a.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity ()
forall s (m :: Type -> Type) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof

-- | Property parser.
--
-- >>> snd <$> parseOnly property "prop> hello world"
-- Right (DocProperty "hello world")
property :: Parser (DocH mod a)
property :: forall mod a. Parser (DocH mod a)
property = String -> DocH mod a
forall mod id. String -> DocH mod id
DocProperty (String -> DocH mod a) -> (Text -> String) -> Text -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> DocH mod a)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"prop>" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'))

-- |
-- Paragraph level codeblock. Anything between the two delimiting \@ is parsed
-- for markup.
codeblock :: Parser (DocH mod Identifier)
codeblock :: forall mod. Parser (DocH mod Identifier)
codeblock =
  DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id
DocCodeBlock (DocH mod Identifier -> DocH mod Identifier)
-> (Text -> DocH mod Identifier) -> Text -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseParagraph (Text -> DocH mod Identifier)
-> (Text -> Text) -> Text -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropSpaces
    (Text -> DocH mod Identifier)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"@" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity ()
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\n" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
block' ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"@")
  where
    dropSpaces :: Text -> Text
dropSpaces Text
xs =
      case Text -> [Text]
splitByNl Text
xs of
        [] -> Text
xs
        [Text]
ys -> case Text -> Maybe (Char, Text)
T.uncons ([Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
ys) of
          Just (Char
' ', Text
_) -> case (Text -> Maybe Text) -> [Text] -> Maybe [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Text -> Maybe Text
dropSpace [Text]
ys of
            Maybe [Text]
Nothing -> Text
xs
            Just [Text]
zs -> Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
zs
          Maybe (Char, Text)
_ -> Text
xs

    -- This is necessary because ‘lines’ swallows up a trailing newline
    -- and we lose information about whether the last line belongs to @ or to
    -- text which we need to decide whether we actually want to be dropping
    -- anything at all.
    splitByNl :: Text -> [Text]
splitByNl =
      (Text -> Maybe (Text, Text)) -> Text -> [Text]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
        ( \Text
x -> case Text -> Maybe (Char, Text)
T.uncons Text
x of
            Just (Char
'\n', Text
x') -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just ((Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
x')
            Maybe (Char, Text)
_ -> Maybe (Text, Text)
forall a. Maybe a
Nothing
        )
        (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

    dropSpace :: Text -> Maybe Text
dropSpace Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Maybe (Char, Text)
Nothing -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
      Just (Char
' ', Text
t') -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t'
      Maybe (Char, Text)
_ -> Maybe Text
forall a. Maybe a
Nothing

    block' :: ParsecT Text ParserState Identity Text
block' = (Bool -> Char -> Maybe Bool)
-> Bool -> ParsecT Text ParserState Identity Text
forall s.
(s -> Char -> Maybe s)
-> s -> ParsecT Text ParserState Identity Text
scan Bool -> Char -> Maybe Bool
p Bool
False
      where
        p :: Bool -> Char -> Maybe Bool
p Bool
isNewline Char
c
          | Bool
isNewline Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' = Maybe Bool
forall a. Maybe a
Nothing
          | Bool
isNewline Bool -> Bool -> Bool
&& Char -> Bool
isSpace Char
c = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
isNewline
          | Bool
otherwise = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'

hyperlink :: Parser (DocH mod Identifier)
hyperlink :: forall mod. Parser (DocH mod Identifier)
hyperlink = [Parser (DocH mod Identifier)] -> Parser (DocH mod Identifier)
forall a. [Parser a] -> Parser a
choice' [Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
angleBracketLink, Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
autoUrl]

angleBracketLink :: Parser (DocH mod a)
angleBracketLink :: forall mod a. Parser (DocH mod a)
angleBracketLink =
  Hyperlink (DocH mod a) -> DocH mod a
forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink (Hyperlink (DocH mod a) -> DocH mod a)
-> (Text -> Hyperlink (DocH mod a)) -> Text -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String -> Hyperlink (DocH mod a))
-> Text -> Hyperlink (DocH mod a)
forall a. (String -> Maybe String -> a) -> Text -> a
makeLabeled (\String
s -> String -> Maybe (DocH mod a) -> Hyperlink (DocH mod a)
forall id. String -> Maybe id -> Hyperlink id
Hyperlink String
s (Maybe (DocH mod a) -> Hyperlink (DocH mod a))
-> (Maybe String -> Maybe (DocH mod a))
-> Maybe String
-> Hyperlink (DocH mod a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> DocH mod a) -> Maybe String -> Maybe (DocH mod a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> DocH mod a
forall mod id. String -> DocH mod id
DocString)
    (Text -> DocH mod a)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"<" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
">")

-- | The text for a markdown link, enclosed in square brackets.
markdownLinkText :: Parser (DocH mod Identifier)
markdownLinkText :: forall mod. Parser (DocH mod Identifier)
markdownLinkText = Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseParagraph (Text -> DocH mod Identifier)
-> (Text -> Text) -> Text -> DocH mod Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> DocH mod Identifier)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"[" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
"]")

-- | The target for a markdown link, enclosed in parenthesis.
markdownLinkTarget :: Parser String
markdownLinkTarget :: ParsecT Text ParserState Identity String
markdownLinkTarget = ParsecT Text ParserState Identity ()
whitespace ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity String
url
  where
    whitespace :: Parser ()
    whitespace :: ParsecT Text ParserState Identity ()
whitespace = ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity (Maybe ())
-> ParsecT Text ParserState Identity ()
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity (Maybe ())
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Text ParserState Identity Text
"\n" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity ()
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity ()
skipHorizontalSpace)

    url :: Parser String
    url :: ParsecT Text ParserState Identity String
url = ParsecT Text ParserState Identity String
-> ParsecT Text ParserState Identity String
forall (m :: Type -> Type). MonadPlus m => m String -> m String
rejectWhitespace (Text -> String
decode (Text -> String)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"(" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
")"))

    rejectWhitespace :: MonadPlus m => m String -> m String
    rejectWhitespace :: forall (m :: Type -> Type). MonadPlus m => m String -> m String
rejectWhitespace = (String -> Bool) -> m String -> m String
forall (m :: Type -> Type) a.
MonadPlus m =>
(a -> Bool) -> m a -> m a
mfilter ((Char -> Bool) -> String -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))

    decode :: Text -> String
    decode :: Text -> String
decode = Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
removeEscapes

-- | Looks for URL-like things to automatically hyperlink even if they
-- weren't marked as links.
autoUrl :: Parser (DocH mod a)
autoUrl :: forall mod a. Parser (DocH mod a)
autoUrl = Text -> DocH mod a
forall mod a. Text -> DocH mod a
mkLink (Text -> DocH mod a)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
url
  where
    url :: ParsecT Text ParserState Identity Text
url = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend (Text -> Text -> Text)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (Text -> Text)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Text ParserState Identity Text]
-> ParsecT Text ParserState Identity Text
forall a. [Parser a] -> Parser a
choice' [ParsecT Text ParserState Identity Text
"http://", ParsecT Text ParserState Identity Text
"https://", ParsecT Text ParserState Identity Text
"ftp://"] ParsecT Text ParserState Identity (Text -> Text)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)

    mkLink :: Text -> DocH mod a
    mkLink :: forall mod a. Text -> DocH mod a
mkLink Text
s = case Text -> Maybe (Text, Char)
T.unsnoc Text
s of
      Just (Text
xs, Char
x) | Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` (String
",.!?" :: String) -> Hyperlink (DocH mod a) -> DocH mod a
forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink (Text -> Hyperlink (DocH mod a)
forall mod a. Text -> Hyperlink (DocH mod a)
mkHyperlink Text
xs) DocH mod a -> DocH mod a -> DocH mod a
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` String -> DocH mod a
forall mod id. String -> DocH mod id
DocString [Char
x]
      Maybe (Text, Char)
_ -> Hyperlink (DocH mod a) -> DocH mod a
forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink (Text -> Hyperlink (DocH mod a)
forall mod a. Text -> Hyperlink (DocH mod a)
mkHyperlink Text
s)

    mkHyperlink :: Text -> Hyperlink (DocH mod a)
    mkHyperlink :: forall mod a. Text -> Hyperlink (DocH mod a)
mkHyperlink Text
lnk = String -> Maybe (DocH mod a) -> Hyperlink (DocH mod a)
forall id. String -> Maybe id -> Hyperlink id
Hyperlink (Text -> String
T.unpack Text
lnk) Maybe (DocH mod a)
forall a. Maybe a
Nothing

-- | Parses identifiers with help of 'parseValid'.
identifier :: Parser (DocH mod Identifier)
identifier :: forall mod. Parser (DocH mod Identifier)
identifier = Identifier -> DocH mod Identifier
forall mod id. id -> DocH mod id
DocIdentifier (Identifier -> DocH mod Identifier)
-> ParsecT Text ParserState Identity Identifier
-> ParsecT Text ParserState Identity (DocH mod Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Identifier
parseValid