{-# 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, isUpper, isAlpha, isSpace)
import           Data.List (intercalate, unfoldr, elemIndex)
import           Data.Maybe (fromMaybe, mapMaybe)
import           Data.Monoid
import qualified Data.Set as Set
import           Documentation.Haddock.Doc
import           Documentation.Haddock.Markup ( markup, plainMarkup )
import           Documentation.Haddock.Parser.Monad
import           Documentation.Haddock.Parser.Util
import           Documentation.Haddock.Parser.Identifier
import           Documentation.Haddock.Types
import           Prelude hiding (takeWhile)
import qualified Prelude as P

import qualified Text.Parsec as Parsec
import           Text.Parsec (try)

import qualified Data.Text as T
import           Data.Text (Text)


-- $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 :: DocH mod Identifier -> DocH mod String
toRegular = (Identifier -> String) -> DocH mod Identifier -> DocH mod String
forall (f :: * -> *) 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 :: (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 (f :: * -> *) 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g [DocH mod Identifier]
x
    g (DocOrderedList [DocH mod Identifier]
x) = [DocH mod a] -> DocH mod a
forall mod id. [DocH mod id] -> DocH mod id
DocOrderedList ([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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g [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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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' :: [Parser a] -> Parser a
choice' [] = Parser a
forall (f :: * -> *) 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 :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser a
p Parser a -> Parser a -> Parser a
forall (f :: * -> *) 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 :: 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
forall s (m :: * -> *) 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 :: 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) -> MetaDoc :: forall mod id. Meta -> DocH mod id -> MetaDoc mod id
MetaDoc { _meta :: Meta
_meta = Meta :: Maybe Version -> Maybe String -> Meta
Meta { _version :: Maybe Version
_version = ParserState -> Maybe Version
parserStateSince ParserState
state
                                       , _package :: Maybe String
_package = Maybe String
pkg
                                       }
                        , _doc :: DocH mod Identifier
_doc = DocH mod Identifier
a
                        }

parseParasState :: String -> (ParserState, DocH mod Identifier)
parseParasState :: 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 (f :: * -> *) 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 :: 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]
-> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (DocH mod Identifier)
-> ParsecT Text ParserState Identity [DocH mod Identifier]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
paragraph Parser (DocH mod Identifier)
-> ParsecT Text ParserState Identity ()
-> Parser (DocH mod Identifier)
forall (f :: * -> *) 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 :: * -> *) 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 (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\n"))

parseParagraphs :: String -> Parser (DocH mod Identifier)
parseParagraphs :: 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 :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> DocH mod Identifier -> Parser (DocH mod Identifier)
forall (f :: * -> *) 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 :: 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 :: 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 :: 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 :: 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]
-> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (DocH mod Identifier)
-> ParsecT Text ParserState Identity [DocH mod Identifier]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([Parser (DocH mod Identifier)] -> Parser (DocH mod Identifier)
forall a. [Parser a] -> Parser a
choice' [ Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
monospace
                                    , Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
anchor
                                    , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
identifier
                                    , Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
moduleName
                                    , Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
picture
                                    , Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
mathDisplay
                                    , Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
mathInline
                                    , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
markdownImage
                                    , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
markdownLink
                                    , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
hyperlink
                                    , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
bold
                                    , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
emphasis
                                    , Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
encodedChar
                                    , Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
string'
                                    , Parser (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 :: Parser (DocH mod a)
encodedChar = ParsecT Text ParserState Identity Text
"&#" ParsecT Text ParserState Identity Text
-> Parser (DocH mod a) -> Parser (DocH mod a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (DocH mod a)
forall mod a. Parser (DocH mod a)
c Parser (DocH mod a)
-> ParsecT Text ParserState Identity Text -> Parser (DocH mod a)
forall (f :: * -> *) 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 (m :: * -> *) 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 :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 characers.
string' :: Parser (DocH mod a)
string' :: Parser (DocH mod a)
string' = 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
. String -> String
unescape (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> DocH mod a)
-> ParsecT Text ParserState Identity Text -> Parser (DocH mod a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
specialChar)
  where
    unescape :: String -> String
unescape String
"" = String
""
    unescape (Char
'\\':Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescape String
xs
    unescape (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
unescape String
xs

-- | 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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Char -> DocH mod a)
-> ParsecT Text ParserState Identity Char -> Parser (DocH mod a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Text ParserState Identity Char
forall s (m :: * -> *) 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 :: 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
-> Parser (DocH mod Identifier)
forall (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 :: 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
-> Parser (DocH mod Identifier)
forall (f :: * -> *) 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 (f :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: 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 -> Parser (DocH mod a)
forall (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 :: 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
-> Parser (DocH mod Identifier)
forall (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 :: 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 -> Parser (DocH mod a)
forall (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT Text u Identity String
forall s (m :: * -> *) 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT Text u Identity String
forall s (m :: * -> *) 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [a]
pre f (Maybe [a] -> [a]) -> f (Maybe [a]) -> f [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [a] -> f (Maybe [a])
forall (f :: * -> *) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Char
forall s (m :: * -> *) 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity String
forall (f :: * -> *) 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 :: * -> *) 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) 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 :: Parser (DocH mod Identifier)
markdownLink = do
  DocH mod Identifier
lbl <- Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
markdownLinkText
  [Parser (DocH mod Identifier)] -> Parser (DocH mod Identifier)
forall a. [Parser a] -> Parser a
choice' [ DocH mod Identifier -> Parser (DocH mod Identifier)
forall mod id.
DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownModuleName DocH mod Identifier
lbl, DocH mod Identifier -> Parser (DocH mod Identifier)
forall mod id.
DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownURL DocH mod Identifier
lbl ]
  where
    markdownModuleName :: DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownModuleName DocH mod id
lbl = do
      String
mn <- ParsecT Text ParserState Identity Text
"(" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity ()
forall (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
")"
      DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DocH mod id -> ParsecT Text ParserState Identity (DocH mod id))
-> DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
forall a b. (a -> b) -> a -> b
$ ModLink (DocH mod id) -> DocH mod id
forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule (String -> Maybe (DocH mod id) -> ModLink (DocH mod id)
forall id. String -> Maybe id -> ModLink id
ModLink String
mn (DocH mod id -> Maybe (DocH mod id)
forall a. a -> Maybe a
Just DocH mod id
lbl))

    markdownURL :: DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownURL DocH mod id
lbl = do
      String
target <- ParsecT Text ParserState Identity String
markdownLinkTarget
      DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DocH mod id -> ParsecT Text ParserState Identity (DocH mod id))
-> DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
forall a b. (a -> b) -> a -> b
$ Hyperlink (DocH mod id) -> DocH mod id
forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink (Hyperlink (DocH mod id) -> DocH mod id)
-> Hyperlink (DocH mod id) -> DocH mod id
forall a b. (a -> b) -> a -> b
$ String -> Maybe (DocH mod id) -> Hyperlink (DocH mod id)
forall id. String -> Maybe id -> Hyperlink id
Hyperlink String
target (DocH mod id -> Maybe (DocH mod id)
forall a. a -> Maybe a
Just DocH mod id
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 :: 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 -> Parser (DocH mod a)
forall (f :: * -> *) 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 (f :: * -> *) 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 :: 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 -> Parser (DocH mod a)
forall (f :: * -> *) 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 (f :: * -> *) 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 :: 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 -> Parser (DocH mod a)
forall (f :: * -> *) 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 (f :: * -> *) 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 :: Parser (DocH mod Identifier)
markdownImage = do
  String
text <- DocMarkupH Any Identifier String -> DocH Any Identifier -> String
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup DocMarkupH Any Identifier String
forall b. DocMarkupH b Identifier String
stringMarkup (DocH Any Identifier -> String)
-> ParsecT Text ParserState Identity (DocH Any Identifier)
-> ParsecT Text ParserState Identity String
forall (f :: * -> *) 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 Any Identifier)
-> ParsecT Text ParserState Identity (DocH Any Identifier)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity (DocH Any Identifier)
forall mod. Parser (DocH mod Identifier)
markdownLinkText)
  String
url <- ParsecT Text ParserState Identity String
markdownLinkTarget
  DocH mod Identifier -> Parser (DocH mod Identifier)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DocH mod Identifier -> Parser (DocH mod Identifier))
-> DocH mod Identifier -> Parser (DocH mod Identifier)
forall a b. (a -> b) -> a -> b
$ Picture -> DocH mod Identifier
forall mod id. Picture -> DocH mod id
DocPic (String -> Maybe String -> Picture
Picture String
url (String -> Maybe String
forall a. a -> Maybe a
Just String
text))
  where
    stringMarkup :: DocMarkupH b Identifier String
stringMarkup = (b -> String)
-> (Identifier -> String) -> DocMarkupH b Identifier String
forall mod id.
(mod -> String) -> (id -> String) -> DocMarkupH mod id String
plainMarkup (String -> b -> 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 :: 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 Text
indent <- ParsecT Text ParserState Identity Text
takeIndent
                         [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)
since
                                 , Text -> Parser (DocH mod Identifier)
forall mod. Text -> Parser (DocH mod Identifier)
unorderedList Text
indent
                                 , Text -> Parser (DocH mod Identifier)
forall mod. Text -> Parser (DocH mod Identifier)
orderedList Text
indent
                                 , Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
birdtracks
                                 , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
codeblock
                                 , Parser (DocH mod Identifier)
forall mod a. Parser (DocH mod a)
property
                                 , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
header
                                 , Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
textParagraphThatStartsWithMarkdownLink
                                 , Text -> Parser (DocH mod Identifier)
forall mod. Text -> Parser (DocH mod Identifier)
definitionList Text
indent
                                 , DocH mod Identifier -> DocH mod Identifier
forall mod id. DocH mod id -> DocH mod id
docParagraph (DocH mod Identifier -> DocH mod Identifier)
-> Parser (DocH mod Identifier) -> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
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 :: Parser (DocH mod Identifier)
table = do
    -- first we parse the first row, which determines the width of the table
    Text
firstRow <- ParsecT Text ParserState Identity Text
parseFirstRow
    let len :: Int
len = Text -> Int
T.length Text
firstRow

    -- then we parse all consequtive rows starting and ending with + or |,
    -- of the width `len`.
    [Text]
restRows <- ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Int -> ParsecT Text ParserState Identity Text
parseRestRows Int
len))

    -- Now we gathered the table block, the next step is to split the block
    -- into cells.
    Table (DocH mod Identifier) -> DocH mod Identifier
forall mod id. Table (DocH mod id) -> DocH mod id
DocTable (Table (DocH mod Identifier) -> DocH mod Identifier)
-> ParsecT Text ParserState Identity (Table (DocH mod Identifier))
-> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [Text]
-> ParsecT Text ParserState Identity (Table (DocH mod Identifier))
forall mod. Int -> [Text] -> Parser (Table (DocH mod Identifier))
tableStepTwo Int
len (Text
firstRow Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
restRows)
  where
    parseFirstRow :: Parser Text
    parseFirstRow :: ParsecT Text ParserState Identity Text
parseFirstRow = do
        ParsecT Text ParserState Identity ()
skipHorizontalSpace
        Text
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 `+`
        Bool -> ParsecT Text ParserState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int
T.length Text
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&&
               Text -> Char
T.head Text
cs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
&&
               Text -> Char
T.last Text
cs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+')

        -- trailing space
        ParsecT Text ParserState Identity ()
skipHorizontalSpace
        Char
_ <- ParsecT Text ParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.newline

        Text -> ParsecT Text ParserState Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
cs

    parseRestRows :: Int -> Parser Text
    parseRestRows :: Int -> ParsecT Text ParserState Identity Text
parseRestRows Int
l = do
        ParsecT Text ParserState Identity ()
skipHorizontalSpace
        Text
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 `+`
        Bool -> ParsecT Text ParserState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int
T.length Text
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&&
               (Text -> Char
T.head Text
bs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Text -> Char
T.head Text
bs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+') Bool -> Bool -> Bool
&&
               (Text -> Char
T.last Text
bs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Text -> Char
T.last Text
bs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'))

        -- trailing space
        ParsecT Text ParserState Identity ()
skipHorizontalSpace
        Char
_ <- ParsecT Text ParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.newline

        Text -> ParsecT Text ParserState Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
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 :: 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 (t :: * -> *) 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 :: Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
tableStepThree Int
width [Text]
rs Maybe Int
hdrIndex = do
    [TC]
cells <- Set (Int, Int) -> Parser [TC]
loop ((Int, Int) -> Set (Int, Int)
forall a. a -> Set a
Set.singleton (Int
0, Int
0))
    [Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
forall mod.
[Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
tableStepFour [Text]
rs Maybe Int
hdrIndex [TC]
cells
  where
    height :: Int
height = [Text] -> Int
forall (t :: * -> *) 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 (m :: * -> *) 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 (f :: * -> *) 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. [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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"overflow right "
              | 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 (f :: * -> *) 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)
              | 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 (m :: * -> *) a. MonadFail m => 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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"overflow down"
              | Text -> Int -> Char
T.index ([Text]
rs [Text] -> Int -> Text
forall a. [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 (f :: * -> *) 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)
              | Text -> Int -> Char
T.index ([Text]
rs [Text] -> Int -> Text
forall a. [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 (m :: * -> *) a. MonadFail m => 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) -> Version -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
x' -> Text -> Int -> Char
T.index Text
bs Int
x' Char -> String -> Bool
forall (t :: * -> *) 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 (m :: * -> *) a. MonadFail m => 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. [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) -> Version -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
y' -> Text -> Int -> Char
T.index ([Text]
rs [Text] -> Int -> Text
forall a. [a] -> Int -> a
!! Int
y') Int
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'|']) [Int
y..Int
y2] = (Int, Int) -> Maybe (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x2, Int
y2)
        | Bool
otherwise                                                   = String -> Maybe (Int, Int)
forall (m :: * -> *) a. MonadFail m => 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
showList :: [TC] -> String -> String
$cshowList :: [TC] -> String -> String
show :: TC -> String
$cshow :: TC -> String
showsPrec :: Int -> TC -> String -> String
$cshowsPrec :: Int -> TC -> String -> String
Show

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

tcYS :: TC -> [Int]
tcYS :: TC -> Version
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 :: [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 (m :: * -> *) 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 -> Version -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
i Version
yTabStops of
        Maybe Int
Nothing -> Table (DocH mod Identifier) -> Parser (Table (DocH mod Identifier))
forall (m :: * -> *) 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 (m :: * -> *) 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 :: Version
xTabStops = Version -> Version
forall a. Ord a => [a] -> [a]
sortNub (Version -> Version) -> Version -> Version
forall a b. (a -> b) -> a -> b
$ (TC -> Version) -> [TC] -> Version
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TC -> Version
tcXS [TC]
cells
    yTabStops :: Version
yTabStops = Version -> Version
forall a. Ord a => [a] -> [a]
sortNub (Version -> Version) -> Version -> Version
forall a b. (a -> b) -> a -> b
$ (TC -> Version) -> [TC] -> Version
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TC -> Version
tcYS [TC]
cells

    sortNub :: Ord a => [a] -> [a]
    sortNub :: [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' :: [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 (f :: * -> *) 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 (f :: * -> *) 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) -> Version -> [TableRow Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> TableRow Text
makeRow (Version -> Version
forall a. [a] -> [a]
init' Version
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 = Version -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Version -> Int) -> Version -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Version -> Version
forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x2) (Version -> Version) -> Version -> Version
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Version -> Version
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x) Version
xTabStops
            yts :: Int
yts = Version -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Version -> Int) -> Version -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Version -> Version
forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y2) (Version -> Version) -> Version -> Version
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Version -> Version
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y) Version
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. [a] -> Int -> a
!! Int
y'
        | Int
y' <- [Int
y .. Int
y2]
        ]

-- | Parse \@since annotations.
since :: Parser (DocH mod a)
since :: Parser (DocH mod a)
since = (ParsecT Text ParserState Identity Text
"@since " ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Version
-> ParsecT Text ParserState Identity Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Version
version ParsecT Text ParserState Identity Version
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity Version
-> ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
endOfLine) ParsecT Text ParserState Identity Version
-> (Version -> ParsecT Text ParserState Identity ())
-> ParsecT Text ParserState Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Version -> ParsecT Text ParserState Identity ()
setSince ParsecT Text ParserState Identity ()
-> Parser (DocH mod a) -> Parser (DocH mod a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DocH mod a -> Parser (DocH mod a)
forall (m :: * -> *) a. Monad m => a -> m a
return DocH mod a
forall mod id. DocH mod id
DocEmpty
  where
    version :: ParsecT Text ParserState Identity Version
version = 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 Version
forall s (m :: * -> *) 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
"."

-- | 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 :: Parser (DocH mod Identifier)
header = do
  let psers :: [ParsecT Text ParserState Identity Text]
psers = (Int -> ParsecT Text ParserState Identity Text)
-> Version -> [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 :: * -> *) 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
  Int
depth <- Text -> Int
T.length (Text -> Int)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
pser
  DocH mod Identifier
line <- Text -> DocH mod Identifier
forall mod. Text -> DocH mod Identifier
parseText (Text -> DocH mod Identifier)
-> ParsecT Text ParserState Identity Text
-> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
nonEmptyLine)
  DocH mod Identifier
rest <- Parser (DocH mod Identifier) -> Parser (DocH mod Identifier)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
paragraph Parser (DocH mod Identifier)
-> Parser (DocH mod Identifier) -> Parser (DocH mod Identifier)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DocH mod Identifier -> Parser (DocH mod Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return DocH mod Identifier
forall mod id. DocH mod id
DocEmpty
  DocH mod Identifier -> Parser (DocH mod Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocH mod Identifier -> Parser (DocH mod Identifier))
-> DocH mod Identifier -> Parser (DocH mod Identifier)
forall a b. (a -> b) -> a -> b
$ Header (DocH mod Identifier) -> DocH mod Identifier
forall mod id. Header (DocH mod id) -> DocH mod id
DocHeader (Int -> DocH mod Identifier -> Header (DocH mod Identifier)
forall id. Int -> id -> Header id
Header Int
depth DocH mod Identifier
line) 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
rest

textParagraph :: Parser (DocH mod Identifier)
textParagraph :: 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]
-> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text ParserState Identity Text
nonEmptyLine

textParagraphThatStartsWithMarkdownLink :: Parser (DocH mod Identifier)
textParagraphThatStartsWithMarkdownLink :: 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)
-> Parser (DocH mod Identifier) -> Parser (DocH mod Identifier)
forall (f :: * -> *) 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)
-> Parser (DocH mod Identifier)
-> ParsecT
     Text
     ParserState
     Identity
     (DocH mod Identifier -> DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
markdownLink ParsecT
  Text
  ParserState
  Identity
  (DocH mod Identifier -> DocH mod Identifier)
-> Parser (DocH mod Identifier) -> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (DocH mod Identifier)
forall mod. Parser (DocH mod Identifier)
optionalTextParagraph)
  where
    optionalTextParagraph :: Parser (DocH mod Identifier)
    optionalTextParagraph :: 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 :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) a. Applicative f => a -> f a
pure DocH mod Identifier
forall mod id. DocH mod id
DocEmpty ]

    whitespace :: Parser (DocH mod a)
    whitespace :: 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 -> Parser (DocH mod a)
forall (f :: * -> *) 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 :: * -> *) 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (Maybe Text)
forall (f :: * -> *) 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 :: 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]
-> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity [DocH mod Identifier]
forall mod. Parser [DocH mod Identifier]
p
  where
    p :: Parser [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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity Text
"-") ParsecT Text ParserState Identity Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
forall mod.
Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
innerList Text
indent Parser [DocH mod Identifier]
p

-- | Parses ordered lists (numbered or dashed).
orderedList :: Text -> Parser (DocH mod Identifier)
orderedList :: Text -> Parser (DocH mod Identifier)
orderedList Text
indent = [DocH mod Identifier] -> DocH mod Identifier
forall mod id. [DocH mod id] -> DocH mod id
DocOrderedList ([DocH mod Identifier] -> DocH mod Identifier)
-> ParsecT Text ParserState Identity [DocH mod Identifier]
-> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity [DocH mod Identifier]
forall mod. Parser [DocH mod Identifier]
p
  where
    p :: Parser [DocH mod Identifier]
p = (ParsecT Text ParserState Identity Int
paren ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Int
-> ParsecT Text ParserState Identity Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity Int
dot) ParsecT Text ParserState Identity Int
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
forall mod.
Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
innerList Text
indent Parser [DocH mod Identifier]
p
    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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
")"

-- | 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 :: Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
innerList Text
indent Parser [DocH mod Identifier]
item = do
  Text
c <- ParsecT Text ParserState Identity Text
takeLine
  ([Text]
cs, Either (DocH mod Identifier) [DocH mod Identifier]
items) <- Text
-> Parser [DocH mod Identifier]
-> Parser
     ([Text], Either (DocH mod Identifier) [DocH mod Identifier])
forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
more Text
indent Parser [DocH mod Identifier]
item
  let contents :: DocH mod Identifier
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
  [DocH mod Identifier] -> Parser [DocH mod Identifier]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DocH mod Identifier] -> Parser [DocH mod Identifier])
-> [DocH mod Identifier] -> Parser [DocH mod Identifier]
forall a b. (a -> b) -> a -> b
$ case Either (DocH mod Identifier) [DocH mod Identifier]
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 :: 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)]
-> Parser (DocH mod Identifier)
forall (f :: * -> *) 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
      DocH mod Identifier
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 (f :: * -> *) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (Char -> String -> Bool
forall (t :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text ParserState Identity Text
":")
      Text
c <- ParsecT Text ParserState Identity Text
takeLine
      ([Text]
cs, Either
  (DocH mod Identifier) [(DocH mod Identifier, DocH mod Identifier)]
items) <- Text
-> ParsecT
     Text
     ParserState
     Identity
     [(DocH mod Identifier, DocH mod Identifier)]
-> Parser
     ([Text],
      Either
        (DocH mod Identifier) [(DocH mod Identifier, DocH mod Identifier)])
forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
more Text
indent ParsecT
  Text
  ParserState
  Identity
  [(DocH mod Identifier, DocH mod Identifier)]
p
      let contents :: DocH mod Identifier
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
      [(DocH mod Identifier, DocH mod Identifier)]
-> ParsecT
     Text
     ParserState
     Identity
     [(DocH mod Identifier, DocH mod Identifier)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(DocH mod Identifier, DocH mod Identifier)]
 -> ParsecT
      Text
      ParserState
      Identity
      [(DocH mod Identifier, DocH mod Identifier)])
-> [(DocH mod Identifier, DocH mod Identifier)]
-> ParsecT
     Text
     ParserState
     Identity
     [(DocH mod Identifier, DocH mod Identifier)]
forall a b. (a -> b) -> a -> b
$ case Either
  (DocH mod Identifier) [(DocH mod Identifier, DocH mod Identifier)]
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 :: 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 (f :: * -> *) 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 :: 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)
-> Parser ([Text], Either (DocH mod Identifier) a)
forall (f :: * -> *) 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 (f :: * -> *) 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 :: 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 -> Parser ([Text], Either (DocH mod Identifier) a)
forall (f :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces ParsecT Text ParserState Identity () -> Parser a -> Parser a
forall (f :: * -> *) 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 :: 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 (a :: * -> * -> *) 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 :: * -> *) 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))
-> Parser ([Text], Either (DocH mod Identifier) a)
-> Parser ([Text], Either (DocH mod Identifier) a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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)
more Text
indent Parser a
item

-- | Parses an indented paragraph.
-- The indentation is 4 spaces.
indentedParagraphs :: Text -> Parser (DocH mod Identifier)
indentedParagraphs :: 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 :: * -> *) 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 -> Parser (DocH mod Identifier))
-> Parser (DocH mod Identifier)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser (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
  [Text]
currentParagraph <- ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
takeNonEmptyLine))
  [Text]
followingParagraphs <-
    [ParsecT Text ParserState Identity [Text]]
-> ParsecT Text ParserState Identity [Text]
forall a. [Parser a] -> Parser a
choice' [ ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity [Text]
nextPar -- we have more paragraphs to take
            , ParsecT Text ParserState Identity ()
skipHorizontalSpace ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity [Text]
nlList -- end of the ride, remember the newline
            , ParsecT Text ParserState Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity [Text]
-> ParsecT Text ParserState Identity [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Text] -> ParsecT Text ParserState Identity [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []       -- nothing more to take at all
            ]
  [Text] -> ParsecT Text ParserState Identity [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
currentParagraph [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
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 :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Text] -> ParsecT Text ParserState Identity [Text]
forall (m :: * -> *) 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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty line"
  | Bool
otherwise = Text -> ParsecT Text ParserState Identity Text
forall (m :: * -> *) 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
    Text
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParsecT Text ParserState Identity Text
nonSpace
    Text
_ <- ParsecT Text ParserState Identity Text
"\n"
    Text -> ParsecT Text ParserState Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\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
  Text
indent <- ParsecT Text ParserState Identity Text
takeHorizontalSpace
  [ParsecT Text ParserState Identity Text]
-> ParsecT Text ParserState Identity Text
forall a. [Parser a] -> Parser a
choice' [ ParsecT Text ParserState Identity Text
"\n" ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
takeIndent
          , Text -> ParsecT Text ParserState Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
indent
          ]

-- | Blocks of text of the form:
--
-- >> foo
-- >> bar
-- >> baz
--
birdtracks :: Parser (DocH mod a)
birdtracks :: 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] -> Parser (DocH mod a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall (f :: * -> *) 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 :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Maybe Text) -> [Text] -> Maybe [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 entitity (separated by an empty line).
-- Consecutive examples are accepted.
examples :: Parser (DocH mod a)
examples :: 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]
-> Parser (DocH mod a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall s u (m :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity [Example]
go)
  where
    go :: Parser [Example]
    go :: ParsecT Text ParserState Identity [Example]
go = do
      Text
prefix <- ParsecT Text ParserState Identity Text
takeHorizontalSpace ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
">>>"
      Text
expr <- ParsecT Text ParserState Identity Text
takeLine
      ([Text]
rs, [Example]
es) <- Parser ([Text], [Example])
resultAndMoreExamples
      [Example] -> ParsecT Text ParserState Identity [Example]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> [Text] -> Example
makeExample Text
prefix Text
expr [Text]
rs Example -> [Example] -> [Example]
forall a. a -> [a] -> [a]
: [Example]
es)
      where
        resultAndMoreExamples :: Parser ([Text], [Example])
        resultAndMoreExamples :: Parser ([Text], [Example])
resultAndMoreExamples = [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 (f :: * -> *) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity [Example]
go

            result :: Parser ([Text], [Example])
            result :: Parser ([Text], [Example])
result = ([Text] -> [Text]) -> ([Text], [Example]) -> ([Text], [Example])
forall (a :: * -> * -> *) 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 :: * -> *) 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ([Text], [Example])
resultAndMoreExamples

    makeExample :: Text -> Text -> [Text] -> Example
    makeExample :: Text -> Text -> [Text] -> Example
makeExample Text
prefix Text
expression [Text]
res =
      String -> [String] -> Example
Example (Text -> String
T.unpack (Text -> Text
T.strip 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 p. (Eq p, IsString p) => p -> p
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)

        substituteBlankLine :: p -> p
substituteBlankLine p
"<BLANKLINE>" = p
""
        substituteBlankLine p
xs = p
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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 (f :: * -> *) 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 :: * -> *) 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity ()
forall s (m :: * -> *) 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 :: 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 -> Parser (DocH mod a)
forall (f :: * -> *) 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 (f :: * -> *) 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 :: 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
-> Parser (DocH mod Identifier)
forall (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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. [a] -> a
last [Text]
ys) of
          Just (Char
' ',Text
_) -> case (Text -> Maybe Text) -> [Text] -> Maybe [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 :: 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 :: 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 (f :: * -> *) 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 -> Parser (DocH mod a)
forall (f :: * -> *) 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 (f :: * -> *) 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 :: 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
-> Parser (DocH mod Identifier)
forall (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity ()
-> ParsecT Text ParserState Identity (Maybe ())
forall (f :: * -> *) 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 (f :: * -> *) 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 :: * -> *). MonadPlus m => m String -> m String
rejectWhitespace (Text -> String
decode (Text -> String)
-> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity String
forall (f :: * -> *) 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 (f :: * -> *) 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 :: m String -> m String
rejectWhitespace = (String -> Bool) -> m String -> m String
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) 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 :: 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 -> Parser (DocH mod a)
forall (f :: * -> *) 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 :: * -> *) 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 (f :: * -> *) 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 :: 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 (t :: * -> *) 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 :: 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 :: 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
-> Parser (DocH mod Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Identifier
parseValid