{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Documentation.Haddock.Parser (
parseString,
parseParas,
overIdentifier,
toRegular,
Identifier
) where
import Control.Applicative
import Control.Arrow (first)
import Control.Monad
import Data.Char (chr, isUpper, isAlpha, isSpace)
import Data.List (intercalate, unfoldr, elemIndex)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Monoid
import qualified Data.Set as Set
import Documentation.Haddock.Doc
import Documentation.Haddock.Markup ( markup, plainMarkup )
import Documentation.Haddock.Parser.Monad
import Documentation.Haddock.Parser.Util
import Documentation.Haddock.Parser.Identifier
import Documentation.Haddock.Types
import Prelude hiding (takeWhile)
import qualified Prelude as P
import qualified Text.Parsec as Parsec
import Text.Parsec (try)
import qualified Data.Text as T
import Data.Text (Text)
toRegular :: DocH mod Identifier -> DocH mod String
toRegular :: forall mod. DocH mod Identifier -> DocH mod String
toRegular = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Identifier Namespace
_ Char
_ String
x Char
_) -> String
x)
overIdentifier :: (Namespace -> String -> Maybe a)
-> DocH mod Identifier
-> DocH mod a
overIdentifier :: forall a mod.
(Namespace -> String -> Maybe a)
-> DocH mod Identifier -> DocH mod a
overIdentifier Namespace -> String -> Maybe a
f DocH mod Identifier
d = forall {mod}. DocH mod Identifier -> DocH mod a
g DocH mod Identifier
d
where
g :: DocH mod Identifier -> DocH mod a
g (DocIdentifier (Identifier Namespace
ns Char
o String
x Char
e)) = case Namespace -> String -> Maybe a
f Namespace
ns String
x of
Maybe a
Nothing -> forall mod id. String -> DocH mod id
DocString forall a b. (a -> b) -> a -> b
$ Namespace -> String
renderNs Namespace
ns forall a. [a] -> [a] -> [a]
++ [Char
o] forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ [Char
e]
Just a
x' -> forall mod id. id -> DocH mod id
DocIdentifier a
x'
g DocH mod Identifier
DocEmpty = forall mod id. DocH mod id
DocEmpty
g (DocAppend DocH mod Identifier
x DocH mod Identifier
x') = forall mod id. DocH mod id -> DocH mod id -> DocH mod id
DocAppend (DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x) (DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x')
g (DocString String
x) = forall mod id. String -> DocH mod id
DocString String
x
g (DocParagraph DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocParagraph forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
g (DocIdentifierUnchecked mod
x) = forall mod id. mod -> DocH mod id
DocIdentifierUnchecked mod
x
g (DocModule (ModLink String
m Maybe (DocH mod Identifier)
x)) = forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule (forall id. String -> Maybe id -> ModLink id
ModLink String
m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g Maybe (DocH mod Identifier)
x))
g (DocWarning DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocWarning forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
g (DocEmphasis DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocEmphasis forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
g (DocMonospaced DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocMonospaced forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
g (DocBold DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocBold forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
g (DocUnorderedList [DocH mod Identifier]
x) = forall mod id. [DocH mod id] -> DocH mod id
DocUnorderedList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g [DocH mod Identifier]
x
g (DocOrderedList [(Int, DocH mod Identifier)]
x) = forall mod id. [(Int, DocH mod id)] -> DocH mod id
DocOrderedList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
index, DocH mod Identifier
a) -> (Int
index, DocH mod Identifier -> DocH mod a
g DocH mod Identifier
a)) [(Int, DocH mod Identifier)]
x
g (DocDefList [(DocH mod Identifier, DocH mod Identifier)]
x) = forall mod id. [(DocH mod id, DocH mod id)] -> DocH mod id
DocDefList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(DocH mod Identifier
y, DocH mod Identifier
z) -> (DocH mod Identifier -> DocH mod a
g DocH mod Identifier
y, DocH mod Identifier -> DocH mod a
g DocH mod Identifier
z)) [(DocH mod Identifier, DocH mod Identifier)]
x
g (DocCodeBlock DocH mod Identifier
x) = forall mod id. DocH mod id -> DocH mod id
DocCodeBlock forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
g (DocHyperlink (Hyperlink String
u Maybe (DocH mod Identifier)
x)) = forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink (forall id. String -> Maybe id -> Hyperlink id
Hyperlink String
u (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g Maybe (DocH mod Identifier)
x))
g (DocPic Picture
x) = forall mod id. Picture -> DocH mod id
DocPic Picture
x
g (DocMathInline String
x) = forall mod id. String -> DocH mod id
DocMathInline String
x
g (DocMathDisplay String
x) = forall mod id. String -> DocH mod id
DocMathDisplay String
x
g (DocAName String
x) = forall mod id. String -> DocH mod id
DocAName String
x
g (DocProperty String
x) = forall mod id. String -> DocH mod id
DocProperty String
x
g (DocExamples [Example]
x) = forall mod id. [Example] -> DocH mod id
DocExamples [Example]
x
g (DocHeader (Header Int
l DocH mod Identifier
x)) = forall mod id. Header (DocH mod id) -> DocH mod id
DocHeader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id. Int -> id -> Header id
Header Int
l forall a b. (a -> b) -> a -> b
$ DocH mod Identifier -> DocH mod a
g DocH mod Identifier
x
g (DocTable (Table [TableRow (DocH mod Identifier)]
h [TableRow (DocH mod Identifier)]
b)) = forall mod id. Table (DocH mod id) -> DocH mod id
DocTable (forall id. [TableRow id] -> [TableRow id] -> Table id
Table (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g) [TableRow (DocH mod Identifier)]
h) (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocH mod Identifier -> DocH mod a
g) [TableRow (DocH mod Identifier)]
b))
choice' :: [Parser a] -> Parser a
choice' :: forall a. [Parser a] -> Parser a
choice' [] = forall (f :: * -> *) a. Alternative f => f a
empty
choice' [Parser a
p] = Parser a
p
choice' (Parser a
p : [Parser a]
ps) = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. [Parser a] -> Parser a
choice' [Parser a]
ps
parse :: Parser a -> Text -> (ParserState, a)
parse :: forall a. Parser a -> Text -> (ParserState, a)
parse Parser a
p = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {c}. String -> c
err forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String (ParserState, a)
parseOnly (Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof)
where
err :: String -> c
err = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Haddock.Parser.parse: " forall a. [a] -> [a] -> [a]
++)
parseParas :: Maybe Package
-> String
-> MetaDoc mod Identifier
parseParas :: forall mod. Maybe String -> String -> MetaDoc mod Identifier
parseParas Maybe String
pkg String
input = case forall mod. String -> (ParserState, DocH mod Identifier)
parseParasState String
input of
(ParserState
state, DocH mod Identifier
a) -> MetaDoc { _meta :: Meta
_meta = Meta { _version :: Maybe Version
_version = ParserState -> Maybe Version
parserStateSince ParserState
state
, _package :: Maybe String
_package = Maybe String
pkg
}
, _doc :: DocH mod Identifier
_doc = DocH mod Identifier
a
}
parseParasState :: String -> (ParserState, DocH mod Identifier)
parseParasState :: forall mod. String -> (ParserState, DocH mod Identifier)
parseParasState = forall a. Parser a -> Text -> (ParserState, a)
parse (Parser ()
emptyLines forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall mod. Parser (DocH mod Identifier)
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r')
where
p :: Parser (DocH mod Identifier)
p :: forall mod. Parser (DocH mod Identifier)
p = forall mod id. [DocH mod id] -> DocH mod id
docConcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall mod. Parser (DocH mod Identifier)
paragraph forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
emptyLines)
emptyLines :: Parser ()
emptyLines :: Parser ()
emptyLines = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\n"))
parseParagraphs :: String -> Parser (DocH mod Identifier)
parseParagraphs :: forall mod. String -> Parser (DocH mod Identifier)
parseParagraphs String
input = case forall mod. String -> (ParserState, DocH mod Identifier)
parseParasState String
input of
(ParserState
state, DocH mod Identifier
a) -> forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
Parsec.putState ParserState
state forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure DocH mod Identifier
a
parseString :: String -> DocH mod Identifier
parseString :: forall mod. String -> DocH mod Identifier
parseString = forall mod. Text -> DocH mod Identifier
parseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
parseText :: Text -> DocH mod Identifier
parseText :: forall mod. Text -> DocH mod Identifier
parseText = forall mod. Text -> DocH mod Identifier
parseParagraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r')
parseParagraph :: Text -> DocH mod Identifier
parseParagraph :: forall mod. Text -> DocH mod Identifier
parseParagraph = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> (ParserState, a)
parse forall mod. Parser (DocH mod Identifier)
p
where
p :: Parser (DocH mod Identifier)
p :: forall mod. Parser (DocH mod Identifier)
p = forall mod id. [DocH mod id] -> DocH mod id
docConcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. [Parser a] -> Parser a
choice' [ forall mod. Parser (DocH mod Identifier)
monospace
, forall mod a. Parser (DocH mod a)
anchor
, forall mod. Parser (DocH mod Identifier)
identifier
, forall mod a. Parser (DocH mod a)
moduleName
, forall mod a. Parser (DocH mod a)
picture
, forall mod a. Parser (DocH mod a)
mathDisplay
, forall mod a. Parser (DocH mod a)
mathInline
, forall mod. Parser (DocH mod Identifier)
markdownImage
, forall mod. Parser (DocH mod Identifier)
markdownLink
, forall mod. Parser (DocH mod Identifier)
hyperlink
, forall mod. Parser (DocH mod Identifier)
bold
, forall mod. Parser (DocH mod Identifier)
emphasis
, forall mod a. Parser (DocH mod a)
encodedChar
, forall mod a. Parser (DocH mod a)
string'
, forall mod a. Parser (DocH mod a)
skipSpecialChar
])
encodedChar :: Parser (DocH mod a)
encodedChar :: forall mod a. Parser (DocH mod a)
encodedChar = ParsecT Text ParserState Identity Text
"&#" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall mod a. Parser (DocH mod a)
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
";"
where
c :: ParsecT Text ParserState Identity (DocH mod id)
c = forall mod id. String -> DocH mod id
DocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Int
num
num :: ParsecT Text ParserState Identity Int
num = ParsecT Text ParserState Identity Int
hex forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Integral a => Parser a
decimal
hex :: ParsecT Text ParserState Identity Int
hex = (ParsecT Text ParserState Identity Text
"x" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity Text
"X") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. (Integral a, Bits a) => Parser a
hexadecimal
specialChar :: [Char]
specialChar :: String
specialChar = String
"_/<@\"&'`#[ "
string' :: Parser (DocH mod a)
string' :: forall mod a. Parser (DocH mod a)
string' = forall mod id. String -> DocH mod id
DocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
unescape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
specialChar)
where
unescape :: String -> String
unescape String
"" = String
""
unescape (Char
'\\':Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: String -> String
unescape String
xs
unescape (Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: String -> String
unescape String
xs
skipSpecialChar :: Parser (DocH mod a)
skipSpecialChar :: forall mod a. Parser (DocH mod a)
skipSpecialChar = forall mod id. String -> DocH mod id
DocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
Parsec.oneOf String
specialChar
emphasis :: Parser (DocH mod Identifier)
emphasis :: forall mod. Parser (DocH mod Identifier)
emphasis = forall mod id. DocH mod id -> DocH mod id
DocEmphasis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseParagraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"/" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (forall a. Eq a => a -> a -> Bool
/= Char
'/') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"/")
bold :: Parser (DocH mod Identifier)
bold :: forall mod. Parser (DocH mod Identifier)
bold = forall mod id. DocH mod id -> DocH mod id
DocBold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseParagraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"__" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
"__")
disallowNewline :: Parser Text -> Parser Text
disallowNewline :: ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter ((Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
/= Char
'\n'))
takeWhile_ :: (Char -> Bool) -> Parser Text
takeWhile_ :: (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile_ Char -> Bool
p = forall s.
(s -> Char -> Maybe s)
-> s -> ParsecT Text ParserState Identity Text
scan Bool -> Char -> Maybe Bool
p_ Bool
False
where
p_ :: Bool -> Char -> Maybe Bool
p_ Bool
escaped Char
c
| Bool
escaped = forall a. a -> Maybe a
Just Bool
False
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
p Char
c = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (Char
c forall a. Eq a => a -> a -> Bool
== Char
'\\')
takeWhile1_ :: (Char -> Bool) -> Parser Text
takeWhile1_ :: (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile_
anchor :: Parser (DocH mod a)
anchor :: forall mod a. Parser (DocH mod a)
anchor = forall mod id. String -> DocH mod id
DocAName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(ParsecT Text ParserState Identity Text
"#" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'#' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
x)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"#")
monospace :: Parser (DocH mod Identifier)
monospace :: forall mod. Parser (DocH mod Identifier)
monospace = forall mod id. DocH mod id -> DocH mod id
DocMonospaced forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseParagraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (forall a. Eq a => a -> a -> Bool
/= Char
'@') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"@")
moduleName :: Parser (DocH mod a)
moduleName :: forall mod a. Parser (DocH mod a)
moduleName = forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall id. String -> Maybe id -> ModLink id
ModLink forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"\"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity String
moduleNameString forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"\"")
moduleNameString :: Parser String
moduleNameString :: ParsecT Text ParserState Identity String
moduleNameString = ParsecT Text ParserState Identity String
modid forall {f :: * -> *} {a}. Alternative f => f [a] -> f [a] -> f [a]
`maybeFollowedBy` forall {u}. ParsecT Text u Identity String
anchor_
where
modid :: ParsecT Text ParserState Identity String
modid = forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity String
conid forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`Parsec.sepBy1` ParsecT Text ParserState Identity Text
"."
anchor_ :: ParsecT Text u Identity String
anchor_ = forall a. [a] -> [a] -> [a]
(++)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"#" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"\\#")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)))
maybeFollowedBy :: f [a] -> f [a] -> f [a]
maybeFollowedBy f [a]
pre f [a]
suf = (\[a]
x -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
x ([a]
x forall a. [a] -> [a] -> [a]
++)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [a]
pre forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional f [a]
suf
conid :: Parser String
conid :: ParsecT Text ParserState Identity String
conid = (:)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy (\Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall {u}. ParsecT Text u Identity Char
conChar
conChar :: ParsecT Text u Identity Char
conChar = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.alphaNum forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'_'
markdownLink :: Parser (DocH mod Identifier)
markdownLink :: forall mod. Parser (DocH mod Identifier)
markdownLink = do
DocH mod Identifier
lbl <- forall mod. Parser (DocH mod Identifier)
markdownLinkText
forall a. [Parser a] -> Parser a
choice' [ forall {mod} {id}.
DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownModuleName DocH mod Identifier
lbl, forall {mod} {id}.
DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownURL DocH mod Identifier
lbl ]
where
markdownModuleName :: DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownModuleName DocH mod id
lbl = do
String
mn <- ParsecT Text ParserState Identity Text
"(" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
ParsecT Text ParserState Identity Text
"\"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity String
moduleNameString forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"\""
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
")"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule (forall id. String -> Maybe id -> ModLink id
ModLink String
mn (forall a. a -> Maybe a
Just DocH mod id
lbl))
markdownURL :: DocH mod id -> ParsecT Text ParserState Identity (DocH mod id)
markdownURL DocH mod id
lbl = do
String
target <- ParsecT Text ParserState Identity String
markdownLinkTarget
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink forall a b. (a -> b) -> a -> b
$ forall id. String -> Maybe id -> Hyperlink id
Hyperlink String
target (forall a. a -> Maybe a
Just DocH mod id
lbl)
picture :: Parser (DocH mod a)
picture :: forall mod a. Parser (DocH mod a)
picture = forall mod id. Picture -> DocH mod id
DocPic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (String -> Maybe String -> a) -> Text -> a
makeLabeled String -> Maybe String -> Picture
Picture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"<<" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
">>")
mathInline :: Parser (DocH mod a)
mathInline :: forall mod a. Parser (DocH mod a)
mathInline = forall mod id. String -> DocH mod id
DocMathInline forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"\\(" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
"\\)")
mathDisplay :: Parser (DocH mod a)
mathDisplay :: forall mod a. Parser (DocH mod a)
mathDisplay = forall mod id. String -> DocH mod id
DocMathDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"\\[" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
"\\]")
markdownImage :: Parser (DocH mod Identifier)
markdownImage :: forall mod. Parser (DocH mod Identifier)
markdownImage = do
String
text <- forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup forall {mod}. DocMarkupH mod Identifier String
stringMarkup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"!" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall mod. Parser (DocH mod Identifier)
markdownLinkText)
String
url <- ParsecT Text ParserState Identity String
markdownLinkTarget
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall mod id. Picture -> DocH mod id
DocPic (String -> Maybe String -> Picture
Picture String
url (forall a. a -> Maybe a
Just String
text))
where
stringMarkup :: DocMarkupH mod Identifier String
stringMarkup = forall mod id.
(mod -> String) -> (id -> String) -> DocMarkupH mod id String
plainMarkup (forall a b. a -> b -> a
const String
"") Identifier -> String
renderIdent
renderIdent :: Identifier -> String
renderIdent (Identifier Namespace
ns Char
l String
c Char
r) = Namespace -> String
renderNs Namespace
ns forall a. Semigroup a => a -> a -> a
<> [Char
l] forall a. Semigroup a => a -> a -> a
<> String
c forall a. Semigroup a => a -> a -> a
<> [Char
r]
paragraph :: Parser (DocH mod Identifier)
paragraph :: forall mod. Parser (DocH mod Identifier)
paragraph = forall a. [Parser a] -> Parser a
choice' [ forall mod a. Parser (DocH mod a)
examples
, forall mod. Parser (DocH mod Identifier)
table
, do Text
indent <- ParsecT Text ParserState Identity Text
takeIndent
forall a. [Parser a] -> Parser a
choice' [ forall mod a. Parser (DocH mod a)
since
, forall mod. Text -> Parser (DocH mod Identifier)
unorderedList Text
indent
, forall mod. Text -> Parser (DocH mod Identifier)
orderedList Text
indent
, forall mod a. Parser (DocH mod a)
birdtracks
, forall mod. Parser (DocH mod Identifier)
codeblock
, forall mod a. Parser (DocH mod a)
property
, forall mod. Parser (DocH mod Identifier)
header
, forall mod. Parser (DocH mod Identifier)
textParagraphThatStartsWithMarkdownLink
, forall mod. Text -> Parser (DocH mod Identifier)
definitionList Text
indent
, forall mod id. DocH mod id -> DocH mod id
docParagraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall mod. Parser (DocH mod Identifier)
textParagraph
]
]
table :: Parser (DocH mod Identifier)
table :: forall mod. Parser (DocH mod Identifier)
table = do
Text
firstRow <- ParsecT Text ParserState Identity Text
parseFirstRow
let len :: Int
len = Text -> Int
T.length Text
firstRow
[Text]
restRows <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Int -> ParsecT Text ParserState Identity Text
parseRestRows Int
len))
forall mod id. Table (DocH mod id) -> DocH mod id
DocTable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall mod. Int -> [Text] -> Parser (Table (DocH mod Identifier))
tableStepTwo Int
len (Text
firstRow forall a. a -> [a] -> [a]
: [Text]
restRows)
where
parseFirstRow :: Parser Text
parseFirstRow :: ParsecT Text ParserState Identity Text
parseFirstRow = do
Parser ()
skipHorizontalSpace
Text
cs <- (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'+')
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int
T.length Text
cs forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&&
Text -> Char
T.head Text
cs forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
&&
Text -> Char
T.last Text
cs forall a. Eq a => a -> a -> Bool
== Char
'+')
Parser ()
skipHorizontalSpace
Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.newline
forall (m :: * -> *) a. Monad m => a -> m a
return Text
cs
parseRestRows :: Int -> Parser Text
parseRestRows :: Int -> ParsecT Text ParserState Identity Text
parseRestRows Int
l = do
Parser ()
skipHorizontalSpace
Text
bs <- forall s.
(s -> Char -> Maybe s)
-> s -> ParsecT Text ParserState Identity Text
scan forall {a}. (Ord a, Num a) => a -> Char -> Maybe a
predicate Int
l
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int
T.length Text
bs forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&&
(Text -> Char
T.head Text
bs forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Text -> Char
T.head Text
bs forall a. Eq a => a -> a -> Bool
== Char
'+') Bool -> Bool -> Bool
&&
(Text -> Char
T.last Text
bs forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Text -> Char
T.last Text
bs forall a. Eq a => a -> a -> Bool
== Char
'+'))
Parser ()
skipHorizontalSpace
Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Parsec.newline
forall (m :: * -> *) a. Monad m => a -> m a
return Text
bs
where
predicate :: a -> Char -> Maybe a
predicate a
n Char
c
| a
n forall a. Ord a => a -> a -> Bool
<= a
0 = forall a. Maybe a
Nothing
| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n' = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (a
n forall a. Num a => a -> a -> a
- a
1)
tableStepTwo
:: Int
-> [Text]
-> Parser (Table (DocH mod Identifier))
tableStepTwo :: forall mod. Int -> [Text] -> Parser (Table (DocH mod Identifier))
tableStepTwo Int
width = forall {mod}.
Int -> [Text] -> [Text] -> Parser (Table (DocH mod Identifier))
go Int
0 [] where
go :: Int -> [Text] -> [Text] -> Parser (Table (DocH mod Identifier))
go Int
_ [Text]
left [] = forall mod.
Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
tableStepThree Int
width (forall a. [a] -> [a]
reverse [Text]
left) forall a. Maybe a
Nothing
go Int
n [Text]
left (Text
r : [Text]
rs)
| (Char -> Bool) -> Text -> Bool
T.all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'=']) Text
r =
forall mod.
Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
tableStepThree Int
width (forall a. [a] -> [a]
reverse [Text]
left forall a. [a] -> [a] -> [a]
++ Text
r' forall a. a -> [a] -> [a]
: [Text]
rs) (forall a. a -> Maybe a
Just Int
n)
| Bool
otherwise =
Int -> [Text] -> [Text] -> Parser (Table (DocH mod Identifier))
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) (Text
r forall a. a -> [a] -> [a]
: [Text]
left) [Text]
rs
where
r' :: Text
r' = (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'=' then Char
'-' else Char
c) Text
r
tableStepThree
:: Int
-> [Text]
-> Maybe Int
-> Parser (Table (DocH mod Identifier))
tableStepThree :: forall mod.
Int -> [Text] -> Maybe Int -> Parser (Table (DocH mod Identifier))
tableStepThree Int
width [Text]
rs Maybe Int
hdrIndex = do
[TC]
cells <- Set (Int, Int) -> Parser [TC]
loop (forall a. a -> Set a
Set.singleton (Int
0, Int
0))
forall mod.
[Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
tableStepFour [Text]
rs Maybe Int
hdrIndex [TC]
cells
where
height :: Int
height = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
rs
loop :: Set.Set (Int, Int) -> Parser [TC]
loop :: Set (Int, Int) -> Parser [TC]
loop Set (Int, Int)
queue = case forall a. Set a -> Maybe (a, Set a)
Set.minView Set (Int, Int)
queue of
Maybe ((Int, Int), Set (Int, Int))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just ((Int
y, Int
x), Set (Int, Int)
queue')
| Int
y forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
>= Int
height Bool -> Bool -> Bool
|| Int
x forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
>= Int
width -> Set (Int, Int) -> Parser [TC]
loop Set (Int, Int)
queue'
| Bool
otherwise -> case Int -> Int -> Maybe (Int, Int)
scanRight Int
x Int
y of
Maybe (Int, Int)
Nothing -> Set (Int, Int) -> Parser [TC]
loop Set (Int, Int)
queue'
Just (Int
x2, Int
y2) -> do
let tc :: TC
tc = Int -> Int -> Int -> Int -> TC
TC Int
y Int
x Int
y2 Int
x2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TC
tc forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ Set (Int, Int) -> Parser [TC]
loop forall a b. (a -> b) -> a -> b
$ Set (Int, Int)
queue' forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall a. Ord a => [a] -> Set a
Set.fromList
[(Int
y, Int
x2), (Int
y2, Int
x), (Int
y2, Int
x2)]
scanRight :: Int -> Int -> Maybe (Int, Int)
scanRight :: Int -> Int -> Maybe (Int, Int)
scanRight Int
x Int
y = Int -> Maybe (Int, Int)
go (Int
x forall a. Num a => a -> a -> a
+ Int
1) where
bs :: Text
bs = [Text]
rs forall a. [a] -> Int -> a
!! Int
y
go :: Int -> Maybe (Int, Int)
go Int
x' | Int
x' forall a. Ord a => a -> a -> Bool
>= Int
width = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"overflow right "
| Text -> Int -> Char
T.index Text
bs Int
x' forall a. Eq a => a -> a -> Bool
== Char
'+' = Int -> Int -> Int -> Maybe (Int, Int)
scanDown Int
x Int
y Int
x' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe (Int, Int)
go (Int
x' forall a. Num a => a -> a -> a
+ Int
1)
| Text -> Int -> Char
T.index Text
bs Int
x' forall a. Eq a => a -> a -> Bool
== Char
'-' = Int -> Maybe (Int, Int)
go (Int
x' forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"not a border (right) " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
x,Int
y,Int
x')
scanDown :: Int -> Int -> Int -> Maybe (Int, Int)
scanDown :: Int -> Int -> Int -> Maybe (Int, Int)
scanDown Int
x Int
y Int
x2 = Int -> Maybe (Int, Int)
go (Int
y forall a. Num a => a -> a -> a
+ Int
1) where
go :: Int -> Maybe (Int, Int)
go Int
y' | Int
y' forall a. Ord a => a -> a -> Bool
>= Int
height = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"overflow down"
| Text -> Int -> Char
T.index ([Text]
rs forall a. [a] -> Int -> a
!! Int
y') Int
x2 forall a. Eq a => a -> a -> Bool
== Char
'+' = Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanLeft Int
x Int
y Int
x2 Int
y' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe (Int, Int)
go (Int
y' forall a. Num a => a -> a -> a
+ Int
1)
| Text -> Int -> Char
T.index ([Text]
rs forall a. [a] -> Int -> a
!! Int
y') Int
x2 forall a. Eq a => a -> a -> Bool
== Char
'|' = Int -> Maybe (Int, Int)
go (Int
y' forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"not a border (down) " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
x,Int
y,Int
x2,Int
y')
scanLeft :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanLeft :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanLeft Int
x Int
y Int
x2 Int
y2
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
x' -> Text -> Int -> Char
T.index Text
bs Int
x' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'-']) [Int
x..Int
x2] = Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanUp Int
x Int
y Int
x2 Int
y2
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"not a border (left) " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
x,Int
y,Int
x2,Int
y2)
where
bs :: Text
bs = [Text]
rs forall a. [a] -> Int -> a
!! Int
y2
scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
scanUp Int
x Int
y Int
x2 Int
y2
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
y' -> Text -> Int -> Char
T.index ([Text]
rs forall a. [a] -> Int -> a
!! Int
y') Int
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'|']) [Int
y..Int
y2] = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x2, Int
y2)
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"not a border (up) " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
x,Int
y,Int
x2,Int
y2)
data TC = TC !Int !Int !Int !Int
deriving Int -> TC -> String -> String
[TC] -> String -> String
TC -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TC] -> String -> String
$cshowList :: [TC] -> String -> String
show :: TC -> String
$cshow :: TC -> String
showsPrec :: Int -> TC -> String -> String
$cshowsPrec :: Int -> TC -> String -> String
Show
tcXS :: TC -> [Int]
tcXS :: TC -> Version
tcXS (TC Int
_ Int
x Int
_ Int
x2) = [Int
x, Int
x2]
tcYS :: TC -> [Int]
tcYS :: TC -> Version
tcYS (TC Int
y Int
_ Int
y2 Int
_) = [Int
y, Int
y2]
tableStepFour :: [Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
tableStepFour :: forall mod.
[Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
tableStepFour [Text]
rs Maybe Int
hdrIndex [TC]
cells = case Maybe Int
hdrIndex of
Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall id. [TableRow id] -> [TableRow id] -> Table id
Table [] forall {mod}. [TableRow (DocH mod Identifier)]
rowsDoc
Just Int
i -> case forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
i Version
yTabStops of
Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall id. [TableRow id] -> [TableRow id] -> Table id
Table [] forall {mod}. [TableRow (DocH mod Identifier)]
rowsDoc
Just Int
i' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall id. [TableRow id] -> [TableRow id] -> Table id
Table forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> ([a], [a])
splitAt Int
i' forall {mod}. [TableRow (DocH mod Identifier)]
rowsDoc
where
xTabStops :: Version
xTabStops = forall a. Ord a => [a] -> [a]
sortNub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TC -> Version
tcXS [TC]
cells
yTabStops :: Version
yTabStops = forall a. Ord a => [a] -> [a]
sortNub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TC -> Version
tcYS [TC]
cells
sortNub :: Ord a => [a] -> [a]
sortNub :: forall a. Ord a => [a] -> [a]
sortNub = forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList
init' :: [a] -> [a]
init' :: forall a. [a] -> [a]
init' [] = []
init' [a
_] = []
init' (a
x : [a]
xs) = a
x forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
init' [a]
xs
rowsDoc :: [TableRow (DocH mod Identifier)]
rowsDoc = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall mod. Text -> DocH mod Identifier
parseParagraph [TableRow Text]
rows
rows :: [TableRow Text]
rows = forall a b. (a -> b) -> [a] -> [b]
map Int -> TableRow Text
makeRow (forall a. [a] -> [a]
init' Version
yTabStops)
where
makeRow :: Int -> TableRow Text
makeRow Int
y = forall id. [TableCell id] -> TableRow id
TableRow forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> TC -> Maybe (TableCell Text)
makeCell Int
y) [TC]
cells
makeCell :: Int -> TC -> Maybe (TableCell Text)
makeCell Int
y (TC Int
y' Int
x Int
y2 Int
x2)
| Int
y forall a. Eq a => a -> a -> Bool
/= Int
y' = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall id. Int -> Int -> id -> TableCell id
TableCell Int
xts Int
yts (Int -> Int -> Int -> Int -> Text
extract (Int
x forall a. Num a => a -> a -> a
+ Int
1) (Int
y forall a. Num a => a -> a -> a
+ Int
1) (Int
x2 forall a. Num a => a -> a -> a
- Int
1) (Int
y2 forall a. Num a => a -> a -> a
- Int
1))
where
xts :: Int
xts = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (forall a. Ord a => a -> a -> Bool
< Int
x2) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
< Int
x) Version
xTabStops
yts :: Int
yts = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
P.takeWhile (forall a. Ord a => a -> a -> Bool
< Int
y2) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
< Int
y) Version
yTabStops
extract :: Int -> Int -> Int -> Int -> Text
extract :: Int -> Int -> Int -> Int -> Text
extract Int
x Int
y Int
x2 Int
y2 = Text -> [Text] -> Text
T.intercalate Text
"\n"
[ Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripStart forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int
x2 forall a. Num a => a -> a -> a
- Int
x forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
x forall a b. (a -> b) -> a -> b
$ [Text]
rs forall a. [a] -> Int -> a
!! Int
y'
| Int
y' <- [Int
y .. Int
y2]
]
since :: Parser (DocH mod a)
since :: forall mod a. Parser (DocH mod a)
since = (ParsecT Text ParserState Identity Text
"@since " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Version
version forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Version -> Parser ()
setSince forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall mod id. DocH mod id
DocEmpty
where
version :: ParsecT Text ParserState Identity Version
version = forall a. Integral a => Parser a
decimal forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`Parsec.sepBy1` ParsecT Text ParserState Identity Text
"."
header :: Parser (DocH mod Identifier)
= do
let psers :: [ParsecT Text ParserState Identity Text]
psers = forall a b. (a -> b) -> [a] -> [b]
map (Text -> ParsecT Text ParserState Identity Text
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> Text
T.replicate Text
"=") [Int
6, Int
5 .. Int
1]
pser :: ParsecT Text ParserState Identity Text
pser = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
Parsec.choice [ParsecT Text ParserState Identity Text]
psers
Int
depth <- Text -> Int
T.length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
pser
DocH mod Identifier
line <- forall mod. Text -> DocH mod Identifier
parseText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
nonEmptyLine)
DocH mod Identifier
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall mod. Parser (DocH mod Identifier)
paragraph forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall mod id. DocH mod id
DocEmpty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall mod id. Header (DocH mod id) -> DocH mod id
DocHeader (forall id. Int -> id -> Header id
Header Int
depth DocH mod Identifier
line) forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` DocH mod Identifier
rest
textParagraph :: Parser (DocH mod Identifier)
textParagraph :: forall mod. Parser (DocH mod Identifier)
textParagraph = forall mod. Text -> DocH mod Identifier
parseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text ParserState Identity Text
nonEmptyLine
textParagraphThatStartsWithMarkdownLink :: Parser (DocH mod Identifier)
textParagraphThatStartsWithMarkdownLink :: forall mod. Parser (DocH mod Identifier)
textParagraphThatStartsWithMarkdownLink = forall mod id. DocH mod id -> DocH mod id
docParagraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall mod id. DocH mod id -> DocH mod id -> DocH mod id
docAppend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall mod. Parser (DocH mod Identifier)
markdownLink forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall mod. Parser (DocH mod Identifier)
optionalTextParagraph)
where
optionalTextParagraph :: Parser (DocH mod Identifier)
optionalTextParagraph :: forall mod. Parser (DocH mod Identifier)
optionalTextParagraph = forall a. [Parser a] -> Parser a
choice' [ forall mod id. DocH mod id -> DocH mod id -> DocH mod id
docAppend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall mod a. Parser (DocH mod a)
whitespace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall mod. Parser (DocH mod Identifier)
textParagraph
, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall mod id. DocH mod id
DocEmpty ]
whitespace :: Parser (DocH mod a)
whitespace :: forall mod a. Parser (DocH mod a)
whitespace = forall mod id. String -> DocH mod id
DocString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text -> String
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
takeHorizontalSpace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text ParserState Identity Text
"\n")
where
f :: Text -> Maybe Text -> String
f :: Text -> Maybe Text -> String
f Text
xs (forall a. a -> Maybe a -> a
fromMaybe Text
"" -> Text
x)
| Text -> Bool
T.null (Text
xs forall a. Semigroup a => a -> a -> a
<> Text
x) = String
""
| Bool
otherwise = String
" "
unorderedList :: Text -> Parser (DocH mod Identifier)
unorderedList :: forall mod. Text -> Parser (DocH mod Identifier)
unorderedList Text
indent = forall mod id. [DocH mod id] -> DocH mod id
DocUnorderedList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {mod}.
ParsecT Text ParserState Identity [DocH mod Identifier]
p
where
p :: ParsecT Text ParserState Identity [DocH mod Identifier]
p = (ParsecT Text ParserState Identity Text
"*" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity Text
"-") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall mod.
Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
innerList Text
indent ParsecT Text ParserState Identity [DocH mod Identifier]
p
orderedList :: Text -> Parser (DocH mod Identifier)
orderedList :: forall mod. Text -> Parser (DocH mod Identifier)
orderedList Text
indent = forall mod id. [(Int, DocH mod id)] -> DocH mod id
DocOrderedList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {mod}.
ParsecT Text ParserState Identity [(Int, DocH mod Identifier)]
p
where
p :: ParsecT Text ParserState Identity [(Int, DocH mod Identifier)]
p = do
Int
index <- ParsecT Text ParserState Identity Int
paren forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text ParserState Identity Int
dot
forall mod.
Text
-> Parser [(Int, DocH mod Identifier)]
-> Int
-> Parser [(Int, DocH mod Identifier)]
innerList' Text
indent ParsecT Text ParserState Identity [(Int, DocH mod Identifier)]
p Int
index
dot :: ParsecT Text ParserState Identity Int
dot = (forall a. Integral a => Parser a
decimal :: Parser Int) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"."
paren :: ParsecT Text ParserState Identity Int
paren = ParsecT Text ParserState Identity Text
"(" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parser a
decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
")"
innerList' :: Text -> Parser [(Int, DocH mod Identifier)]
-> Int
-> Parser [(Int, DocH mod Identifier)]
innerList' :: forall mod.
Text
-> Parser [(Int, DocH mod Identifier)]
-> Int
-> Parser [(Int, DocH mod Identifier)]
innerList' Text
indent Parser [(Int, DocH mod Identifier)]
item Int
index = do
Text
c <- ParsecT Text ParserState Identity Text
takeLine
([Text]
cs, Either (DocH mod Identifier) [(Int, DocH mod Identifier)]
items) <- forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
more Text
indent Parser [(Int, DocH mod Identifier)]
item
let contents :: DocH mod Identifier
contents = forall mod id. DocH mod id -> DocH mod id
docParagraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropNLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ Text
c forall a. a -> [a] -> [a]
: [Text]
cs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either (DocH mod Identifier) [(Int, DocH mod Identifier)]
items of
Left DocH mod Identifier
p -> [(Int
index, forall {mod}. DocH mod Identifier
contents forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` DocH mod Identifier
p)]
Right [(Int, DocH mod Identifier)]
i -> (Int
index, forall {mod}. DocH mod Identifier
contents) forall a. a -> [a] -> [a]
: [(Int, DocH mod Identifier)]
i
innerList :: Text -> Parser [DocH mod Identifier]
-> Parser [DocH mod Identifier]
innerList :: forall mod.
Text
-> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier]
innerList Text
indent Parser [DocH mod Identifier]
item = do
Text
c <- ParsecT Text ParserState Identity Text
takeLine
([Text]
cs, Either (DocH mod Identifier) [DocH mod Identifier]
items) <- forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
more Text
indent Parser [DocH mod Identifier]
item
let contents :: DocH mod Identifier
contents = forall mod id. DocH mod id -> DocH mod id
docParagraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropNLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ Text
c forall a. a -> [a] -> [a]
: [Text]
cs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either (DocH mod Identifier) [DocH mod Identifier]
items of
Left DocH mod Identifier
p -> [forall {mod}. DocH mod Identifier
contents forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` DocH mod Identifier
p]
Right [DocH mod Identifier]
i -> forall {mod}. DocH mod Identifier
contents forall a. a -> [a] -> [a]
: [DocH mod Identifier]
i
definitionList :: Text -> Parser (DocH mod Identifier)
definitionList :: forall mod. Text -> Parser (DocH mod Identifier)
definitionList Text
indent = forall mod id. [(DocH mod id, DocH mod id)] -> DocH mod id
DocDefList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {mod} {mod}.
ParsecT
Text
ParserState
Identity
[(DocH mod Identifier, DocH mod Identifier)]
p
where
p :: ParsecT
Text
ParserState
Identity
[(DocH mod Identifier, DocH mod Identifier)]
p = do
DocH mod Identifier
label <- ParsecT Text ParserState Identity Text
"[" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall mod. Text -> DocH mod Identifier
parseParagraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1_ (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"]\n" :: String))) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (ParsecT Text ParserState Identity Text
"]" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text ParserState Identity Text
":")
Text
c <- ParsecT Text ParserState Identity Text
takeLine
([Text]
cs, Either
(DocH mod Identifier) [(DocH mod Identifier, DocH mod Identifier)]
items) <- forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
more Text
indent ParsecT
Text
ParserState
Identity
[(DocH mod Identifier, DocH mod Identifier)]
p
let contents :: DocH mod Identifier
contents = forall mod. Text -> DocH mod Identifier
parseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropNLs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ Text
c forall a. a -> [a] -> [a]
: [Text]
cs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either
(DocH mod Identifier) [(DocH mod Identifier, DocH mod Identifier)]
items of
Left DocH mod Identifier
x -> [(DocH mod Identifier
label, forall {mod}. DocH mod Identifier
contents forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` DocH mod Identifier
x)]
Right [(DocH mod Identifier, DocH mod Identifier)]
i -> (DocH mod Identifier
label, forall {mod}. DocH mod Identifier
contents) forall a. a -> [a] -> [a]
: [(DocH mod Identifier, DocH mod Identifier)]
i
dropNLs :: Text -> Text
dropNLs :: Text -> Text
dropNLs = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'\n')
more :: Monoid a => Text -> Parser a
-> Parser ([Text], Either (DocH mod Identifier) a)
more :: forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
more Text
indent Parser a
item = forall a. [Parser a] -> Parser a
choice' [ forall mod a.
Text -> Parser ([Text], Either (DocH mod Identifier) a)
innerParagraphs Text
indent
, forall a mod.
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
moreListItems Text
indent Parser a
item
, forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
moreContent Text
indent Parser a
item
, forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty)
]
innerParagraphs :: Text
-> Parser ([Text], Either (DocH mod Identifier) a)
innerParagraphs :: forall mod a.
Text -> Parser ([Text], Either (DocH mod Identifier) a)
innerParagraphs Text
indent = (,) [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall mod. Text -> Parser (DocH mod Identifier)
indentedParagraphs Text
indent)
moreListItems :: Text -> Parser a
-> Parser ([Text], Either (DocH mod Identifier) a)
moreListItems :: forall a mod.
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
moreListItems Text
indent Parser a
item = (,) [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
indentedItem
where
indentedItem :: Parser a
indentedItem = Text -> ParsecT Text ParserState Identity Text
string Text
indent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
item
moreContent :: Monoid a => Text -> Parser a
-> Parser ([Text], Either (DocH mod Identifier) a)
moreContent :: forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
moreContent Text
indent Parser a
item = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
nonEmptyLine forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a mod.
Monoid a =>
Text -> Parser a -> Parser ([Text], Either (DocH mod Identifier) a)
more Text
indent Parser a
item
indentedParagraphs :: Text -> Parser (DocH mod Identifier)
indentedParagraphs :: forall mod. Text -> Parser (DocH mod Identifier)
indentedParagraphs Text
indent =
(Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text -> Parser [Text]
dropFrontOfPara ParsecT Text ParserState Identity Text
indent') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall mod. String -> Parser (DocH mod Identifier)
parseParagraphs
where
indent' :: ParsecT Text ParserState Identity Text
indent' = Text -> ParsecT Text ParserState Identity Text
string forall a b. (a -> b) -> a -> b
$ Text
indent forall a. Semigroup a => a -> a -> a
<> Text
" "
dropFrontOfPara :: Parser Text -> Parser [Text]
dropFrontOfPara :: ParsecT Text ParserState Identity Text -> Parser [Text]
dropFrontOfPara ParsecT Text ParserState Identity Text
sp = do
[Text]
currentParagraph <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text ParserState Identity Text
sp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
takeNonEmptyLine))
[Text]
followingParagraphs <-
forall a. [Parser a] -> Parser a
choice' [ Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Text]
nextPar
, Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Text]
nlList
, forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return []
]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
currentParagraph forall a. [a] -> [a] -> [a]
++ [Text]
followingParagraphs)
where
nextPar :: Parser [Text]
nextPar = forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Text]
nlList forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text ParserState Identity Text -> Parser [Text]
dropFrontOfPara ParsecT Text ParserState Identity Text
sp
nlList :: Parser [Text]
nlList = ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Monad m => a -> m a
return [Text
"\n"]
nonSpace :: Text -> Parser Text
nonSpace :: Text -> ParsecT Text ParserState Identity Text
nonSpace Text
xs
| (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
xs = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty line"
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Text
xs
takeNonEmptyLine :: Parser Text
takeNonEmptyLine :: ParsecT Text ParserState Identity Text
takeNonEmptyLine = do
Text
l <- (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParsecT Text ParserState Identity Text
nonSpace
Text
_ <- ParsecT Text ParserState Identity Text
"\n"
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
l forall a. Semigroup a => a -> a -> a
<> Text
"\n")
takeIndent :: Parser Text
takeIndent :: ParsecT Text ParserState Identity Text
takeIndent = do
Text
indent <- ParsecT Text ParserState Identity Text
takeHorizontalSpace
forall a. [Parser a] -> Parser a
choice' [ ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
takeIndent
, forall (m :: * -> *) a. Monad m => a -> m a
return Text
indent
]
birdtracks :: Parser (DocH mod a)
birdtracks :: forall mod a. Parser (DocH mod a)
birdtracks = forall mod id. DocH mod id -> DocH mod id
DocCodeBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod id. String -> DocH mod id
DocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
stripSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text ParserState Identity Text
line
where
line :: ParsecT Text ParserState Identity Text
line = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
">" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
takeLine)
stripSpace :: [Text] -> [Text]
stripSpace :: [Text] -> [Text]
stripSpace = forall a. a -> Maybe a -> a
fromMaybe forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe Text
strip'
where
strip' :: Text -> Maybe Text
strip' Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> forall a. a -> Maybe a
Just Text
""
Just (Char
' ',Text
t') -> forall a. a -> Maybe a
Just Text
t'
Maybe (Char, Text)
_ -> forall a. Maybe a
Nothing
examples :: Parser (DocH mod a)
examples :: forall mod a. Parser (DocH mod a)
examples = forall mod id. [Example] -> DocH mod id
DocExamples forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\n")) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity [Example]
go)
where
go :: Parser [Example]
go :: ParsecT Text ParserState Identity [Example]
go = do
Text
prefix <- ParsecT Text ParserState Identity Text
takeHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
">>>"
Text
expr <- ParsecT Text ParserState Identity Text
takeLine
([Text]
rs, [Example]
es) <- Parser ([Text], [Example])
resultAndMoreExamples
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> [Text] -> Example
makeExample Text
prefix Text
expr [Text]
rs forall a. a -> [a] -> [a]
: [Example]
es)
where
resultAndMoreExamples :: Parser ([Text], [Example])
resultAndMoreExamples :: Parser ([Text], [Example])
resultAndMoreExamples = forall a. [Parser a] -> Parser a
choice' [ Parser ([Text], [Example])
moreExamples, Parser ([Text], [Example])
result, forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], []) ]
where
moreExamples :: Parser ([Text], [Example])
moreExamples :: Parser ([Text], [Example])
moreExamples = (,) [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity [Example]
go
result :: Parser ([Text], [Example])
result :: Parser ([Text], [Example])
result = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
nonEmptyLine forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ([Text], [Example])
resultAndMoreExamples
makeExample :: Text -> Text -> [Text] -> Example
makeExample :: Text -> Text -> [Text] -> Example
makeExample Text
prefix Text
expression [Text]
res =
String -> [String] -> Example
Example (Text -> String
T.unpack (Text -> Text
T.strip Text
expression)) [String]
result
where
result :: [String]
result = forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Eq a, IsString a) => a -> a
substituteBlankLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tryStripPrefix) [Text]
res
tryStripPrefix :: Text -> Text
tryStripPrefix Text
xs = forall a. a -> Maybe a -> a
fromMaybe Text
xs (Text -> Text -> Maybe Text
T.stripPrefix Text
prefix Text
xs)
substituteBlankLine :: a -> a
substituteBlankLine a
"<BLANKLINE>" = a
""
substituteBlankLine a
xs = a
xs
nonEmptyLine :: Parser Text
nonEmptyLine :: ParsecT Text ParserState Identity Text
nonEmptyLine = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter ((Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) ParsecT Text ParserState Identity Text
takeLine)
takeLine :: Parser Text
takeLine :: ParsecT Text ParserState Identity Text
takeLine = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine)
endOfLine :: Parser ()
endOfLine :: Parser ()
endOfLine = forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof
property :: Parser (DocH mod a)
property :: forall mod a. Parser (DocH mod a)
property = forall mod id. String -> DocH mod id
DocProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"prop>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
'\n'))
codeblock :: Parser (DocH mod Identifier)
codeblock :: forall mod. Parser (DocH mod Identifier)
codeblock =
forall mod id. DocH mod id -> DocH mod id
DocCodeBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mod. Text -> DocH mod Identifier
parseParagraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropSpaces
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity Text
block' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text ParserState Identity Text
"@")
where
dropSpaces :: Text -> Text
dropSpaces Text
xs =
case Text -> [Text]
splitByNl Text
xs of
[] -> Text
xs
[Text]
ys -> case Text -> Maybe (Char, Text)
T.uncons (forall a. [a] -> a
last [Text]
ys) of
Just (Char
' ',Text
_) -> case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe Text
dropSpace [Text]
ys of
Maybe [Text]
Nothing -> Text
xs
Just [Text]
zs -> Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
zs
Maybe (Char, Text)
_ -> Text
xs
splitByNl :: Text -> [Text]
splitByNl = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\Text
x -> case Text -> Maybe (Char, Text)
T.uncons Text
x of
Just (Char
'\n',Text
x') -> forall a. a -> Maybe a
Just ((Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
x')
Maybe (Char, Text)
_ -> forall a. Maybe a
Nothing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"\n" forall a. Semigroup a => a -> a -> a
<>)
dropSpace :: Text -> Maybe Text
dropSpace Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> forall a. a -> Maybe a
Just Text
""
Just (Char
' ',Text
t') -> forall a. a -> Maybe a
Just Text
t'
Maybe (Char, Text)
_ -> forall a. Maybe a
Nothing
block' :: ParsecT Text ParserState Identity Text
block' = forall s.
(s -> Char -> Maybe s)
-> s -> ParsecT Text ParserState Identity Text
scan Bool -> Char -> Maybe Bool
p Bool
False
where
p :: Bool -> Char -> Maybe Bool
p Bool
isNewline Char
c
| Bool
isNewline Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
== Char
'@' = forall a. Maybe a
Nothing
| Bool
isNewline Bool -> Bool -> Bool
&& Char -> Bool
isSpace Char
c = forall a. a -> Maybe a
Just Bool
isNewline
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n'
hyperlink :: Parser (DocH mod Identifier)
hyperlink :: forall mod. Parser (DocH mod Identifier)
hyperlink = forall a. [Parser a] -> Parser a
choice' [ forall mod a. Parser (DocH mod a)
angleBracketLink, forall mod a. Parser (DocH mod a)
autoUrl ]
angleBracketLink :: Parser (DocH mod a)
angleBracketLink :: forall mod a. Parser (DocH mod a)
angleBracketLink =
forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (String -> Maybe String -> a) -> Text -> a
makeLabeled (\String
s -> forall id. String -> Maybe id -> Hyperlink id
Hyperlink String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall mod id. String -> DocH mod id
DocString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
-> ParsecT Text ParserState Identity Text
disallowNewline (ParsecT Text ParserState Identity Text
"<" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
">")
markdownLinkText :: Parser (DocH mod Identifier)
markdownLinkText :: forall mod. Parser (DocH mod Identifier)
markdownLinkText = forall mod. Text -> DocH mod Identifier
parseParagraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"[" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
"]")
markdownLinkTarget :: Parser String
markdownLinkTarget :: ParsecT Text ParserState Identity String
markdownLinkTarget = Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text ParserState Identity String
url
where
whitespace :: Parser ()
whitespace :: Parser ()
whitespace = Parser ()
skipHorizontalSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Text ParserState Identity Text
"\n" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipHorizontalSpace)
url :: Parser String
url :: ParsecT Text ParserState Identity String
url = forall (m :: * -> *). MonadPlus m => m String -> m String
rejectWhitespace (Text -> String
decode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text ParserState Identity Text
"(" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Text ParserState Identity Text
takeUntil Text
")"))
rejectWhitespace :: MonadPlus m => m String -> m String
rejectWhitespace :: forall (m :: * -> *). MonadPlus m => m String -> m String
rejectWhitespace = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))
decode :: Text -> String
decode :: Text -> String
decode = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
removeEscapes
autoUrl :: Parser (DocH mod a)
autoUrl :: forall mod a. Parser (DocH mod a)
autoUrl = forall mod a. Text -> DocH mod a
mkLink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text ParserState Identity Text
url
where
url :: ParsecT Text ParserState Identity Text
url = forall a. Monoid a => a -> a -> a
mappend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [Parser a] -> Parser a
choice' [ ParsecT Text ParserState Identity Text
"http://", ParsecT Text ParserState Identity Text
"https://", ParsecT Text ParserState Identity Text
"ftp://"] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> ParsecT Text ParserState Identity Text
takeWhile1 (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
mkLink :: Text -> DocH mod a
mkLink :: forall mod a. Text -> DocH mod a
mkLink Text
s = case Text -> Maybe (Text, Char)
T.unsnoc Text
s of
Just (Text
xs,Char
x) | Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
",.!?" :: String) -> forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink (forall mod a. Text -> Hyperlink (DocH mod a)
mkHyperlink Text
xs) forall mod id. DocH mod id -> DocH mod id -> DocH mod id
`docAppend` forall mod id. String -> DocH mod id
DocString [Char
x]
Maybe (Text, Char)
_ -> forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink (forall mod a. Text -> Hyperlink (DocH mod a)
mkHyperlink Text
s)
mkHyperlink :: Text -> Hyperlink (DocH mod a)
mkHyperlink :: forall mod a. Text -> Hyperlink (DocH mod a)
mkHyperlink Text
lnk = forall id. String -> Maybe id -> Hyperlink id
Hyperlink (Text -> String
T.unpack Text
lnk) forall a. Maybe a
Nothing
identifier :: Parser (DocH mod Identifier)
identifier :: forall mod. Parser (DocH mod Identifier)
identifier = forall mod id. id -> DocH mod id
DocIdentifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Identifier
parseValid