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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Plain, regular parser for text. Called as one of the last parsers
-- to ensure that we have already given a chance to more meaningful parsers
-- before capturing their characters.
string' :: Parser (DocH mod a)
string' :: forall mod a. Parser (DocH mod a)
string' = String -> DocH mod a
forall mod id. String -> DocH mod id
DocString (String -> DocH mod a) -> (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
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (Char -> String -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`notElem` String
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 :: forall mod a. Parser (DocH mod a)
skipSpecialChar = String -> DocH mod a
forall mod id. String -> DocH mod id
DocString (String -> DocH mod a) -> (Char -> String) -> Char -> DocH mod a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Char -> DocH mod a)
-> ParsecT Text ParserState Identity Char
-> ParsecT Text ParserState Identity (DocH mod a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Text ParserState Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
String -> ParsecT s u m Char
Parsec.oneOf String
specialChar

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

      -- trailing space
      skipHorizontalSpace
      _ <- Parsec.newline

      return cs

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

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

      -- trailing space
      skipHorizontalSpace
      _ <- Parsec.newline

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

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

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

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

    -- scan right looking for +, then try scan down
    --
    -- do we need to record + saw on the way left and down?
    scanRight :: Int -> Int -> Maybe (Int, Int)
    scanRight :: Int -> Int -> Maybe (Int, Int)
scanRight Int
x Int
y = Int -> Maybe (Int, Int)
go (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        bs :: Text
bs = [Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y
        go :: Int -> Maybe (Int, Int)
go Int
x'
          | Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
width = String -> Maybe (Int, Int)
forall a. String -> Maybe a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"overflow right "
          | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
bs Int
x' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' = Int -> Int -> Int -> Maybe (Int, Int)
scanDown Int
x Int
y Int
x' Maybe (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe (Int, Int)
go (Int
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
bs Int
x' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = Int -> Maybe (Int, Int)
go (Int
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = String -> Maybe (Int, Int)
forall a. String -> Maybe a
forall (m :: Type -> Type) 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 a. String -> Maybe a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"overflow down"
          | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index ([Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y') Int
x2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' = Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanLeft Int
x Int
y Int
x2 Int
y' Maybe (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe (Int, Int)
go (Int
y' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index ([Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y') Int
x2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' = Int -> Maybe (Int, Int)
go (Int
y' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = String -> Maybe (Int, Int)
forall a. String -> Maybe a
forall (m :: Type -> Type) 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) -> [Int] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (\Int
x' -> HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
bs Int
x' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char
'+', Char
'-']) [Int
x .. Int
x2] = Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanUp Int
x Int
y Int
x2 Int
y2
      | Bool
otherwise = String -> Maybe (Int, Int)
forall a. String -> Maybe a
forall (m :: Type -> Type) 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. HasCallStack => [a] -> Int -> a
!! Int
y2

    -- check that at y2 x..x2 characters are '+' or '-'
    scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
    scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanUp Int
x Int
y Int
x2 Int
y2
      | (Int -> Bool) -> [Int] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (\Int
y' -> HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index ([Text]
rs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
y') Int
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char
'+', Char
'|']) [Int
y .. Int
y2] = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int
x2, Int
y2)
      | Bool
otherwise = String -> Maybe (Int, Int)
forall a. String -> Maybe a
forall (m :: Type -> Type) 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
$cshowsPrec :: Int -> TC -> String -> String
showsPrec :: Int -> TC -> String -> String
$cshow :: TC -> String
show :: TC -> String
$cshowList :: [TC] -> String -> String
showList :: [TC] -> String -> String
Show)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            result :: Parser ([Text], [Example])
            result :: Parser ([Text], [Example])
result = ([Text] -> [Text]) -> ([Text], [Example]) -> ([Text], [Example])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (([Text] -> [Text]) -> ([Text], [Example]) -> ([Text], [Example]))
-> (Text -> [Text] -> [Text])
-> Text
-> ([Text], [Example])
-> ([Text], [Example])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (Text -> ([Text], [Example]) -> ([Text], [Example]))
-> ParsecT Text ParserState Identity Text
-> ParsecT
     Text
     ParserState
     Identity
     (([Text], [Example]) -> ([Text], [Example]))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
nonEmptyLine ParsecT
  Text
  ParserState
  Identity
  (([Text], [Example]) -> ([Text], [Example]))
-> Parser ([Text], [Example]) -> Parser ([Text], [Example])
forall a b.
ParsecT Text ParserState Identity (a -> b)
-> ParsecT Text ParserState Identity a
-> ParsecT Text ParserState Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> 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 {a}. (Eq a, IsString a) => a -> a
substituteBlankLine (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tryStripPrefix) [Text]
res

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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