{-# 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 :: forall mod. DocH mod Identifier -> DocH mod String
toRegular = 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 :: forall a mod.
(Namespace -> String -> Maybe a)
-> DocH mod Identifier -> DocH mod a
overIdentifier Namespace -> String -> Maybe a
f DocH mod Identifier
d = 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 -> forall mod id. String -> DocH mod id
DocString forall a b. (a -> b) -> a -> b
$ Namespace -> String
renderNs Namespace
ns forall a. [a] -> [a] -> [a]
++ [Char
o] forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ [Char
e]
      Just a
x' -> forall mod id. id -> DocH mod id
DocIdentifier a
x'
    g DocH mod Identifier
DocEmpty = forall mod id. DocH mod id
DocEmpty
    g (DocAppend DocH mod Identifier
x DocH mod Identifier
x') = 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) = forall mod id. String -> DocH mod id
DocString String
x
    g (DocParagraph DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocParagraph forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocIdentifierUnchecked mod
x) = forall mod id. mod -> DocH mod id
DocIdentifierUnchecked mod
x
    g (DocModule (ModLink String
m Maybe (DocH mod Identifier)
x)) = forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule (forall id. String -> Maybe id -> ModLink id
ModLink String
m (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) = forall mod id. DocH mod id -> DocH mod id
DocWarning forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocEmphasis DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocEmphasis forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocMonospaced DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocMonospaced forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocBold DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocBold forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
    g (DocUnorderedList [DocH mod Identifier]
x) = forall mod id. [DocH mod id] -> DocH mod id
DocUnorderedList forall a b. (a -> b) -> a -> b
$ 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 [(Int, DocH mod Identifier)]
x) = forall mod id. [(Int, DocH mod id)] -> DocH mod id
DocOrderedList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
index, DocH mod Identifier
a) -> (Int
index, DocH mod Identifier -> DocH mod a
g DocH mod Identifier
a)) [(Int, DocH mod Identifier)]
x
    g (DocDefList [(DocH mod Identifier, DocH mod Identifier)]
x) = forall mod id. [(DocH mod id, DocH mod id)] -> DocH mod id
DocDefList forall a b. (a -> b) -> a -> b
$ 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) = forall mod id. DocH mod id -> DocH mod id
DocCodeBlock 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)) = forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink (forall id. String -> Maybe id -> Hyperlink id
Hyperlink String
u (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) = forall mod id. Picture -> DocH mod id
DocPic Picture
x
    g (DocMathInline String
x) = forall mod id. String -> DocH mod id
DocMathInline String
x
    g (DocMathDisplay String
x) = forall mod id. String -> DocH mod id
DocMathDisplay String
x
    g (DocAName String
x) = forall mod id. String -> DocH mod id
DocAName String
x
    g (DocProperty String
x) = forall mod id. String -> DocH mod id
DocProperty String
x
    g (DocExamples [Example]
x) = forall mod id. [Example] -> DocH mod id
DocExamples [Example]
x
    g (DocHeader (Header Int
l DocH mod Identifier
x)) = forall mod id. Header (DocH mod id) -> DocH mod id
DocHeader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id. Int -> id -> Header id
Header Int
l 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)) = forall mod id. Table (DocH mod id) -> DocH mod id
DocTable (forall id. [TableRow id] -> [TableRow id] -> Table id
Table (forall a b. (a -> b) -> [a] -> [b]
map (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) (forall a b. (a -> b) -> [a] -> [b]
map (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' :: forall a. [Parser a] -> Parser a
choice' [] = forall (f :: * -> *) a. Alternative f => f a
empty
choice' [Parser a
p] = Parser a
p
choice' (Parser a
p : [Parser a]
ps) = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. [Parser a] -> Parser a
choice' [Parser a]
ps

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

-- | Main entry point to the parser. Appends the newline character
-- to the input string.
parseParas :: Maybe Package
           -> String -- ^ String to parse
           -> MetaDoc mod Identifier
parseParas :: forall mod. Maybe String -> String -> MetaDoc mod Identifier
parseParas Maybe String
pkg String
input = case forall mod. String -> (ParserState, DocH mod Identifier)
parseParasState String
input of
  (ParserState
state, DocH mod Identifier
a) -> MetaDoc { _meta :: Meta
_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 :: forall mod. String -> (ParserState, DocH mod Identifier)
parseParasState = forall a. Parser a -> Text -> (ParserState, a)
parse (Parser ()
emptyLines forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall mod. Parser (DocH mod Identifier)
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r')
  where
    p :: Parser (DocH mod Identifier)
    p :: forall mod. Parser (DocH mod Identifier)
p = forall mod id. [DocH mod id] -> DocH mod id
docConcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall mod. Parser (DocH mod Identifier)
paragraph forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
emptyLines)

    emptyLines :: Parser ()
    emptyLines :: Parser ()
emptyLines = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser ()
skipHorizontalSpace 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 :: forall mod. String -> Parser (DocH mod Identifier)
parseParagraphs String
input = case forall mod. String -> (ParserState, DocH mod Identifier)
parseParasState String
input of
  (ParserState
state, DocH mod Identifier
a) -> forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
Parsec.putState ParserState
state forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 :: forall mod. String -> DocH mod Identifier
parseString = forall mod. Text -> DocH mod Identifier
parseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

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

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

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

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

-- | Plain, regular parser for text. Called as one of the last parsers
-- to ensure that we have already given a chance to more meaningful parsers
-- before capturing their characters.
string' :: Parser (DocH mod a)
string' :: forall mod a. Parser (DocH mod a)
string' = forall mod id. String -> DocH mod id
DocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
unescape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (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 forall a. a -> [a] -> [a]
: String -> String
unescape String
xs
    unescape (Char
x:String
xs) = Char
x 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 :: forall mod a. Parser (DocH mod a)
skipSpecialChar = forall mod id. String -> DocH mod id
DocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall mod. Parser (DocH mod Identifier)
emphasis = forall mod id. DocH mod id -> DocH mod id
DocEmphasis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseParagraph 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
"/" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (forall a. Eq a => a -> a -> Bool
/= Char
'/') 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 :: forall mod. Parser (DocH mod Identifier)
bold = forall mod id. DocH mod id -> DocH mod id
DocBold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseParagraph 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
"__" 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 = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter ((Char -> Bool) -> Text -> Bool
T.all (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 = 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 = forall a. a -> Maybe a
Just Bool
False
      | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
p Char
c = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just (Char
c 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_ = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile_

-- | Text anchors to allow for jumping around the generated documentation.
--
-- >>> parseString "#Hello world#"
-- DocAName "Hello world"
anchor :: Parser (DocH mod a)
anchor :: forall mod a. Parser (DocH mod a)
anchor = forall mod id. String -> DocH mod id
DocAName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         (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 forall a. Eq a => a -> a -> Bool
/= Char
'#' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
x)) 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 :: forall mod. Parser (DocH mod Identifier)
monospace = forall mod id. DocH mod id -> DocH mod id
DocMonospaced forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseParagraph
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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_ (forall a. Eq a => a -> a -> Bool
/= Char
'@') 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 :: forall mod a. Parser (DocH mod a)
moduleName = forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall id. String -> Maybe id -> ModLink id
ModLink forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"\"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity String
moduleNameString 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 forall {f :: * -> *} {a}. Alternative f => f [a] -> f [a] -> f [a]
`maybeFollowedBy` forall {u}. ParsecT Text u Identity String
anchor_
  where
    modid :: ParsecT Text ParserState Identity String
modid = forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity String
conid 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_ = forall a. [a] -> [a] -> [a]
(++)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"#" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"\\#")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy (\Char
c -> Char
c 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 -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
x ([a]
x forall a. [a] -> [a] -> [a]
++)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [a]
pre forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional f [a]
suf
    conid :: Parser String
    conid :: ParsecT Text ParserState Identity String
conid = (:)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall {u}. ParsecT Text u Identity Char
conChar

    conChar :: ParsecT Text u Identity Char
conChar = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.alphaNum forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 :: forall mod. Parser (DocH mod Identifier)
markdownLink = do
  DocH mod Identifier
lbl <- forall mod. Parser (DocH mod Identifier)
markdownLinkText
  forall a. [Parser a] -> Parser a
choice' [ forall {mod} {id}.
DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownModuleName DocH mod Identifier
lbl, 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
"(" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            ParsecT Text ParserState Identity Text
"\"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity String
moduleNameString forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"\""
            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
")"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule (forall id. String -> Maybe id -> ModLink id
ModLink String
mn (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
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink forall a b. (a -> b) -> a -> b
$ forall id. String -> Maybe id -> Hyperlink id
Hyperlink String
target (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 :: forall mod a. Parser (DocH mod a)
picture = forall mod id. Picture -> DocH mod id
DocPic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (String -> Maybe String -> a) -> Text -> a
makeLabeled String -> Maybe String -> Picture
Picture
          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
"<<" 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 :: forall mod a. Parser (DocH mod a)
mathInline = forall mod id. String -> DocH mod id
DocMathInline forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
             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
"\\(" 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 :: forall mod a. Parser (DocH mod a)
mathDisplay = forall mod id. String -> DocH mod id
DocMathDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: forall mod. Parser (DocH mod Identifier)
markdownImage = do
  String
text <- forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup forall {mod}. DocMarkupH mod Identifier String
stringMarkup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"!" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall mod. Parser (DocH mod Identifier)
markdownLinkText)
  String
url <- ParsecT Text ParserState Identity String
markdownLinkTarget
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall mod id. Picture -> DocH mod id
DocPic (String -> Maybe String -> Picture
Picture String
url (forall a. a -> Maybe a
Just String
text))
  where
    stringMarkup :: DocMarkupH mod Identifier String
stringMarkup = forall mod id.
(mod -> String) -> (id -> String) -> DocMarkupH mod id String
plainMarkup (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 forall a. Semigroup a => a -> a -> a
<> [Char
l] forall a. Semigroup a => a -> a -> a
<> String
c forall a. Semigroup a => a -> a -> a
<> [Char
r]

-- | Paragraph parser, called by 'parseParas'.
paragraph :: Parser (DocH mod Identifier)
paragraph :: forall mod. Parser (DocH mod Identifier)
paragraph = forall a. [Parser a] -> Parser a
choice' [ forall mod a. Parser (DocH mod a)
examples
                    , forall mod. Parser (DocH mod Identifier)
table
                    , do Text
indent <- ParsecT Text ParserState Identity Text
takeIndent
                         forall a. [Parser a] -> Parser a
choice' [ forall mod a. Parser (DocH mod a)
since
                                 , forall mod. Text -> Parser (DocH mod Identifier)
unorderedList Text
indent
                                 , forall mod. Text -> Parser (DocH mod Identifier)
orderedList Text
indent
                                 , forall mod a. Parser (DocH mod a)
birdtracks
                                 , forall mod. Parser (DocH mod Identifier)
codeblock
                                 , forall mod a. Parser (DocH mod a)
property
                                 , forall mod. Parser (DocH mod Identifier)
header
                                 , forall mod. Parser (DocH mod Identifier)
textParagraphThatStartsWithMarkdownLink
                                 , forall mod. Text -> Parser (DocH mod Identifier)
definitionList Text
indent
                                 , forall mod id. DocH mod id -> DocH mod id
docParagraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall mod. 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 consecutive rows starting and ending with + or |,
    -- of the width `len`.
    [Text]
restRows <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (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.
    forall mod id. Table (DocH mod id) -> DocH mod id
DocTable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall mod. Int -> [Text] -> Parser (Table (DocH mod Identifier))
tableStepTwo Int
len (Text
firstRow forall a. a -> [a] -> [a]
: [Text]
restRows)
  where
    parseFirstRow :: Parser Text
    parseFirstRow :: ParsecT Text ParserState Identity Text
parseFirstRow = do
        Parser ()
skipHorizontalSpace
        Text
cs <- (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'+')

        -- upper-left and upper-right corners are `+`
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int
T.length Text
cs forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&&
               Text -> Char
T.head Text
cs forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
&&
               Text -> Char
T.last Text
cs forall a. Eq a => a -> a -> Bool
== Char
'+')

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

        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
        Parser ()
skipHorizontalSpace
        Text
bs <- forall s.
(s -> Char -> Maybe s)
-> s -> ParsecT Text ParserState Identity Text
scan forall {a}. (Ord a, Num a) => a -> Char -> Maybe a
predicate Int
l

        -- Left and right edges are `|` or `+`
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int
T.length Text
bs forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&&
               (Text -> Char
T.head Text
bs forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Text -> Char
T.head Text
bs forall a. Eq a => a -> a -> Bool
== Char
'+') Bool -> Bool -> Bool
&&
               (Text -> Char
T.last Text
bs forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Text -> Char
T.last Text
bs forall a. Eq a => a -> a -> Bool
== Char
'+'))

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

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

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

-- Third step recognises cells in the table area, returning a list of TC, cells.
tableStepThree
    :: Int              -- ^ width
    -> [Text]           -- ^ rows
    -> Maybe Int        -- ^ index of header separator
    -> Parser (Table (DocH mod Identifier))
tableStepThree :: forall mod.
Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
tableStepThree Int
width [Text]
rs Maybe Int
hdrIndex = do
    [TC]
cells <- Set (Int, Int) -> Parser [TC]
loop (forall a. a -> Set a
Set.singleton (Int
0, Int
0))
    forall mod.
[Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
tableStepFour [Text]
rs Maybe Int
hdrIndex [TC]
cells
  where
    height :: Int
height = 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 forall a. Set a -> Maybe (a, Set a)
Set.minView Set (Int, Int)
queue of
        Maybe ((Int, Int), Set (Int, Int))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just ((Int
y, Int
x), Set (Int, Int)
queue')
            | Int
y forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
>= Int
height Bool -> Bool -> Bool
|| Int
x forall a. Num a => a -> a -> a
+ Int
1 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
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TC
tc forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ Set (Int, Int) -> Parser [TC]
loop forall a b. (a -> b) -> a -> b
$ Set (Int, Int)
queue' forall a. Ord a => Set a -> Set a -> Set a
`Set.union` 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 forall a. Num a => a -> a -> a
+ Int
1) where
        bs :: Text
bs = [Text]
rs forall a. [a] -> Int -> a
!! Int
y
        go :: Int -> Maybe (Int, Int)
go Int
x' | Int
x' forall a. Ord a => a -> a -> Bool
>= Int
width          = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"overflow right "
              | Text -> Int -> Char
T.index Text
bs Int
x' forall a. Eq a => a -> a -> Bool
== Char
'+' = Int -> Int -> Int -> Maybe (Int, Int)
scanDown Int
x Int
y Int
x' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe (Int, Int)
go (Int
x' forall a. Num a => a -> a -> a
+ Int
1)
              | Text -> Int -> Char
T.index Text
bs Int
x' forall a. Eq a => a -> a -> Bool
== Char
'-' = Int -> Maybe (Int, Int)
go (Int
x' forall a. Num a => a -> a -> a
+ Int
1)
              | Bool
otherwise            = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"not a border (right) " forall a. [a] -> [a] -> [a]
++ 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 forall a. Num a => a -> a -> a
+ Int
1) where
        go :: Int -> Maybe (Int, Int)
go Int
y' | Int
y' forall a. Ord a => a -> a -> Bool
>= Int
height                 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"overflow down"
              | Text -> Int -> Char
T.index ([Text]
rs forall a. [a] -> Int -> a
!! Int
y') Int
x2 forall a. Eq a => a -> a -> Bool
== Char
'+' = Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanLeft Int
x Int
y Int
x2 Int
y' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe (Int, Int)
go (Int
y' forall a. Num a => a -> a -> a
+ Int
1)
              | Text -> Int -> Char
T.index ([Text]
rs forall a. [a] -> Int -> a
!! Int
y') Int
x2 forall a. Eq a => a -> a -> Bool
== Char
'|' = Int -> Maybe (Int, Int)
go (Int
y' forall a. Num a => a -> a -> a
+ Int
1)
              | Bool
otherwise                    = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"not a border (down) " forall a. [a] -> [a] -> [a]
++ 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
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
x' -> Text -> Int -> Char
T.index Text
bs Int
x' 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                                            = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"not a border (left) " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
x,Int
y,Int
x2,Int
y2)
      where
        bs :: Text
bs = [Text]
rs 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
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
y' -> Text -> Int -> Char
T.index ([Text]
rs forall a. [a] -> Int -> a
!! Int
y') Int
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'|']) [Int
y..Int
y2] = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x2, Int
y2)
        | Bool
otherwise                                                   = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"not a border (up) " forall a. [a] -> [a] -> [a]
++ 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
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 :: forall mod.
[Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
tableStepFour [Text]
rs Maybe Int
hdrIndex [TC]
cells =  case Maybe Int
hdrIndex of
    Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall id. [TableRow id] -> [TableRow id] -> Table id
Table [] forall {mod}. [TableRow (DocH mod Identifier)]
rowsDoc
    Just Int
i  -> case forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
i Version
yTabStops of
        Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall id. [TableRow id] -> [TableRow id] -> Table id
Table [] forall {mod}. [TableRow (DocH mod Identifier)]
rowsDoc
        Just Int
i' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall id. [TableRow id] -> [TableRow id] -> Table id
Table forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> ([a], [a])
splitAt Int
i' forall {mod}. [TableRow (DocH mod Identifier)]
rowsDoc
  where
    xTabStops :: Version
xTabStops = forall a. Ord a => [a] -> [a]
sortNub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TC -> Version
tcXS [TC]
cells
    yTabStops :: Version
yTabStops = forall a. Ord a => [a] -> [a]
sortNub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TC -> Version
tcYS [TC]
cells

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

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

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

    rows :: [TableRow Text]
rows = forall a b. (a -> b) -> [a] -> [b]
map Int -> TableRow Text
makeRow (forall a. [a] -> [a]
init' Version
yTabStops)
      where
        makeRow :: Int -> TableRow Text
makeRow Int
y = forall id. [TableCell id] -> TableRow id
TableRow forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
/= Int
y' = forall a. Maybe a
Nothing
            | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall id. Int -> Int -> id -> TableCell id
TableCell Int
xts Int
yts (Int -> Int -> Int -> Int -> Text
extract (Int
x forall a. Num a => a -> a -> a
+ Int
1) (Int
y forall a. Num a => a -> a -> a
+ Int
1) (Int
x2 forall a. Num a => a -> a -> a
- Int
1) (Int
y2 forall a. Num a => a -> a -> a
- Int
1))
          where
            xts :: Int
xts = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (forall a. Ord a => a -> a -> Bool
< Int
x2) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
< Int
x) Version
xTabStops
            yts :: Int
yts = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (forall a. Ord a => a -> a -> Bool
< Int
y2) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (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 forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripStart forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int
x2 forall a. Num a => a -> a -> a
- Int
x forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
x forall a b. (a -> b) -> a -> b
$ [Text]
rs forall a. [a] -> Int -> a
!! Int
y'
        | Int
y' <- [Int
y .. Int
y2]
        ]

-- | Parse \@since annotations.
since :: Parser (DocH mod a)
since :: forall mod a. Parser (DocH mod a)
since = (ParsecT Text ParserState Identity Text
"@since " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Version
version forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Version -> Parser ()
setSince forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall mod id. DocH mod id
DocEmpty
  where
    version :: ParsecT Text ParserState Identity Version
version = forall a. Integral a => Parser a
decimal 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 :: forall mod. Parser (DocH mod Identifier)
header = do
  let psers :: [ParsecT Text ParserState Identity Text]
psers = forall a b. (a -> b) -> [a] -> [b]
map (Text -> ParsecT Text ParserState Identity Text
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
pser
  DocH mod Identifier
line <- forall mod. Text -> DocH mod Identifier
parseText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
nonEmptyLine)
  DocH mod Identifier
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall mod. Parser (DocH mod Identifier)
paragraph forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall mod id. DocH mod id
DocEmpty
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall mod id. Header (DocH mod id) -> DocH mod id
DocHeader (forall id. Int -> id -> Header id
Header Int
depth DocH mod Identifier
line) forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` DocH mod Identifier
rest

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

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

    whitespace :: Parser (DocH mod a)
    whitespace :: forall mod a. Parser (DocH mod a)
whitespace = forall mod id. String -> DocH mod id
DocString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text -> String
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
takeHorizontalSpace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 (forall a. a -> Maybe a -> a
fromMaybe Text
"" -> Text
x)
          | Text -> Bool
T.null (Text
xs forall a. Semigroup a => a -> a -> a
<> Text
x) = String
""
          | Bool
otherwise = String
" "

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

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

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

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

-- | Parses definition lists.
definitionList :: Text -> Parser (DocH mod Identifier)
definitionList :: forall mod. Text -> Parser (DocH mod Identifier)
definitionList Text
indent = forall mod id. [(DocH mod id, DocH mod id)] -> DocH mod id
DocDefList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
"[" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall mod. Text -> DocH mod Identifier
parseParagraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"]\n" :: String))) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (ParsecT Text ParserState Identity Text
"]" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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) <- 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 = forall mod. Text -> DocH mod Identifier
parseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropNLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ Text
c forall a. a -> [a] -> [a]
: [Text]
cs
      forall (m :: * -> *) a. Monad m => a -> m a
return 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, forall {mod}. DocH mod Identifier
contents 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, forall {mod}. DocH mod Identifier
contents) 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 (forall a. Eq a => a -> a -> Bool
== Char
'\n')

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

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

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

-- | Parses an indented paragraph.
-- The indentation is 4 spaces.
indentedParagraphs :: Text -> Parser (DocH mod Identifier)
indentedParagraphs :: forall mod. Text -> Parser (DocH mod Identifier)
indentedParagraphs Text
indent =
    (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text -> Parser [Text]
dropFrontOfPara ParsecT Text ParserState Identity Text
indent') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall mod. String -> Parser (DocH mod Identifier)
parseParagraphs
  where
    indent' :: ParsecT Text ParserState Identity Text
indent' = Text -> ParsecT Text ParserState Identity Text
string forall a b. (a -> b) -> a -> b
$ Text
indent 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 -> Parser [Text]
dropFrontOfPara ParsecT Text ParserState Identity Text
sp = do
  [Text]
currentParagraph <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState Identity Text
sp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
takeNonEmptyLine))
  [Text]
followingParagraphs <-
    forall a. [Parser a] -> Parser a
choice' [ Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Text]
nextPar -- we have more paragraphs to take
            , Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Text]
nlList -- end of the ride, remember the newline
            , forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return []       -- nothing more to take at all
            ]
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
currentParagraph forall a. [a] -> [a] -> [a]
++ [Text]
followingParagraphs)
  where
    nextPar :: Parser [Text]
nextPar = forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Text]
nlList forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState Identity Text -> Parser [Text]
dropFrontOfPara ParsecT Text ParserState Identity Text
sp
    nlList :: Parser [Text]
nlList = ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty line"
  | Bool
otherwise = 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 (forall a. Eq a => a -> a -> Bool
/= Char
'\n') 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"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
l 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
  forall a. [Parser a] -> Parser a
choice' [ ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
takeIndent
          , 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 :: forall mod a. Parser (DocH mod a)
birdtracks = forall mod id. DocH mod id -> DocH mod id
DocCodeBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod id. String -> DocH mod id
DocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
stripSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text ParserState Identity Text
line
  where
    line :: ParsecT Text ParserState Identity Text
line = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 = forall a. a -> Maybe a -> a
fromMaybe forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 -> forall a. a -> Maybe a
Just Text
""
                 Just (Char
' ',Text
t') -> forall a. a -> Maybe a
Just Text
t'
                 Maybe (Char, Text)
_ -> forall a. Maybe a
Nothing

-- | Parses examples. Examples are a paragraph level entity (separated by an empty line).
-- Consecutive examples are accepted.
examples :: Parser (DocH mod a)
examples :: forall mod a. Parser (DocH mod a)
examples = forall mod id. [Example] -> DocH mod id
DocExamples forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\n")) 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 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
      forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> [Text] -> Example
makeExample Text
prefix Text
expr [Text]
rs forall a. a -> [a] -> [a]
: [Example]
es)
      where
        resultAndMoreExamples :: Parser ([Text], [Example])
        resultAndMoreExamples :: Parser ([Text], [Example])
resultAndMoreExamples = forall a. [Parser a] -> Parser a
choice' [ Parser ([Text], [Example])
moreExamples, Parser ([Text], [Example])
result, forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], []) ]
          where
            moreExamples :: Parser ([Text], [Example])
            moreExamples :: Parser ([Text], [Example])
moreExamples = (,) [] 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 = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
nonEmptyLine 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 = forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Eq a, IsString a) => a -> a
substituteBlankLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tryStripPrefix) [Text]
res

        tryStripPrefix :: Text -> Text
tryStripPrefix Text
xs = forall a. a -> Maybe a -> a
fromMaybe Text
xs (Text -> Text -> Maybe Text
T.stripPrefix Text
prefix Text
xs)

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

nonEmptyLine :: Parser Text
nonEmptyLine :: ParsecT Text ParserState Identity Text
nonEmptyLine = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter ((Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not 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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine)

endOfLine :: Parser ()
endOfLine :: Parser ()
endOfLine = forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 :: forall mod a. Parser (DocH mod a)
property = forall mod id. String -> DocH mod id
DocProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"prop>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
'\n'))

-- |
-- Paragraph level codeblock. Anything between the two delimiting \@ is parsed
-- for markup.
codeblock :: Parser (DocH mod Identifier)
codeblock :: forall mod. Parser (DocH mod Identifier)
codeblock =
  forall mod id. DocH mod id -> DocH mod id
DocCodeBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseParagraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropSpaces
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
block' 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 (forall a. [a] -> a
last [Text]
ys) of
          Just (Char
' ',Text
_) -> case 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 = 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') -> forall a. a -> Maybe a
Just ((Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
x')
                                 Maybe (Char, Text)
_ -> forall a. Maybe a
Nothing)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"\n" 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 -> forall a. a -> Maybe a
Just Text
""
                    Just (Char
' ',Text
t') -> forall a. a -> Maybe a
Just Text
t'
                    Maybe (Char, Text)
_ -> forall a. Maybe a
Nothing

    block' :: ParsecT Text ParserState Identity Text
block' = 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 forall a. Eq a => a -> a -> Bool
== Char
'@' = forall a. Maybe a
Nothing
          | Bool
isNewline Bool -> Bool -> Bool
&& Char -> Bool
isSpace Char
c = forall a. a -> Maybe a
Just Bool
isNewline
          | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n'

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

angleBracketLink :: Parser (DocH mod a)
angleBracketLink :: forall mod a. Parser (DocH mod a)
angleBracketLink =
    forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (String -> Maybe String -> a) -> Text -> a
makeLabeled (\String
s -> forall id. String -> Maybe id -> Hyperlink id
Hyperlink String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall mod id. String -> DocH mod id
DocString)
    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
"<" 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 :: forall mod. Parser (DocH mod Identifier)
markdownLinkText = forall mod. Text -> DocH mod Identifier
parseParagraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 = Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity String
url
  where
    whitespace :: Parser ()
    whitespace :: Parser ()
whitespace = Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipHorizontalSpace)

    url :: Parser String
    url :: ParsecT Text ParserState Identity String
url = forall (m :: * -> *). MonadPlus m => m String -> m String
rejectWhitespace (Text -> String
decode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: forall (m :: * -> *). MonadPlus m => m String -> m String
rejectWhitespace = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))

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

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

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

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


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