{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Parsing.Lists
( anyOrderedListMarker
, decimal
, lowerAlpha
, lowerRoman
, orderedListMarker
, romanNumeral
, upperAlpha
, upperRoman
)
where
import Data.Char
( isAsciiUpper
, isAsciiLower
, ord
, toLower
)
import Data.Maybe (fromMaybe)
import Text.Pandoc.Definition
( ListNumberDelim(..)
, ListAttributes
, ListNumberStyle(..)
)
import Text.Pandoc.Shared (safeRead)
import Text.Pandoc.Sources
import Text.Parsec
( (<|>)
, ParsecT
, Stream(..)
, choice
, getState
, lookAhead
, many
, many1
, option
, try
, updateState
)
import Text.Pandoc.Parsing.State
import qualified Data.Map as M
import qualified Data.Text as T
romanNumeral :: (Stream s m Char, UpdateSourcePos s Char)
=> Bool
-> ParsecT s st m Int
romanNumeral :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Bool -> ParsecT s st m Int
romanNumeral Bool
upperCase = do
let rchar :: Char -> ParsecT s u m Char
rchar Char
uc = Char -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char (Char -> ParsecT s u m Char) -> Char -> ParsecT s u m Char
forall a b. (a -> b) -> a -> b
$ if Bool
upperCase then Char
uc else Char -> Char
toLower Char
uc
let one :: ParsecT s u m Char
one = Char -> ParsecT s u m Char
forall {m :: * -> *} {s} {u}.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
rchar Char
'I'
let five :: ParsecT s u m Char
five = Char -> ParsecT s u m Char
forall {m :: * -> *} {s} {u}.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
rchar Char
'V'
let ten :: ParsecT s u m Char
ten = Char -> ParsecT s u m Char
forall {m :: * -> *} {s} {u}.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
rchar Char
'X'
let fifty :: ParsecT s u m Char
fifty = Char -> ParsecT s u m Char
forall {m :: * -> *} {s} {u}.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
rchar Char
'L'
let hundred :: ParsecT s u m Char
hundred = Char -> ParsecT s u m Char
forall {m :: * -> *} {s} {u}.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
rchar Char
'C'
let fivehundred :: ParsecT s u m Char
fivehundred = Char -> ParsecT s u m Char
forall {m :: * -> *} {s} {u}.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
rchar Char
'D'
let thousand :: ParsecT s u m Char
thousand = Char -> ParsecT s u m Char
forall {m :: * -> *} {s} {u}.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
rchar Char
'M'
ParsecT s st m Char -> ParsecT s st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT s st m Char -> ParsecT s st m Char)
-> ParsecT s st m Char -> ParsecT s st m Char
forall a b. (a -> b) -> a -> b
$ [ParsecT s st m Char] -> ParsecT s st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s st m Char
forall {u}. ParsecT s u m Char
one, ParsecT s st m Char
forall {u}. ParsecT s u m Char
five, ParsecT s st m Char
forall {u}. ParsecT s u m Char
ten, ParsecT s st m Char
forall {u}. ParsecT s u m Char
fifty, ParsecT s st m Char
forall {u}. ParsecT s u m Char
hundred, ParsecT s st m Char
forall {u}. ParsecT s u m Char
fivehundred, ParsecT s st m Char
forall {u}. ParsecT s u m Char
thousand]
Int
thousands <- (Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> ([Char] -> Int) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> ParsecT s st m [Char] -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s st m Char
forall {u}. ParsecT s u m Char
thousand
Int
ninehundreds <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
hundred ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall {u}. ParsecT s u m Char
thousand ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
900
Int
fivehundreds <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ Int
500 Int -> ParsecT s st m Char -> ParsecT s st m Int
forall a b. a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
fivehundred
Int
fourhundreds <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
hundred ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall {u}. ParsecT s u m Char
fivehundred ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
400
Int
hundreds <- (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> ([Char] -> Int) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> ParsecT s st m [Char] -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s st m Char
forall {u}. ParsecT s u m Char
hundred
Int
nineties <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
ten ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall {u}. ParsecT s u m Char
hundred ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
90
Int
fifties <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (Int
50 Int -> ParsecT s st m Char -> ParsecT s st m Int
forall a b. a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
fifty)
Int
forties <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
ten ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall {u}. ParsecT s u m Char
fifty ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
40
Int
tens <- (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> ([Char] -> Int) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> ParsecT s st m [Char] -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s st m Char
forall {u}. ParsecT s u m Char
ten
Int
nines <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
one ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall {u}. ParsecT s u m Char
ten ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
9
Int
fives <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (Int
5 Int -> ParsecT s st m Char -> ParsecT s st m Int
forall a b. a -> ParsecT s st m b -> ParsecT s st m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
five)
Int
fours <- Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Char
forall {u}. ParsecT s u m Char
one ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall {u}. ParsecT s u m Char
five ParsecT s st m Char -> ParsecT s st m Int -> ParsecT s st m Int
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT s st m Int
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
Int
ones <- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> ParsecT s st m [Char] -> ParsecT s st m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m Char -> ParsecT s st m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s st m Char
forall {u}. ParsecT s u m Char
one
let total :: Int
total = Int
thousands Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ninehundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fivehundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fourhundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Int
hundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nineties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fifties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tens Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nines Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Int
fives Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fours Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ones
if Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [Char] -> ParsecT s st m Int
forall a. [Char] -> ParsecT s st m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Prelude.fail [Char]
"not a roman numeral"
else Int -> ParsecT s st m Int
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
total
upperRoman :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s st m (ListNumberStyle, Int)
upperRoman :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
upperRoman = do
Int
num <- Bool -> ParsecT s st m Int
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Bool -> ParsecT s st m Int
romanNumeral Bool
True
(ListNumberStyle, Int) -> ParsecT s st m (ListNumberStyle, Int)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
UpperRoman, Int
num)
lowerRoman :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s st m (ListNumberStyle, Int)
lowerRoman :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
lowerRoman = do
Int
num <- Bool -> ParsecT s st m Int
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Bool -> ParsecT s st m Int
romanNumeral Bool
False
(ListNumberStyle, Int) -> ParsecT s st m (ListNumberStyle, Int)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
LowerRoman, Int
num)
decimal :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s st m (ListNumberStyle, Int)
decimal :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
decimal = do
[Char]
num <- ParsecT s st m Char -> ParsecT s st m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit
(ListNumberStyle, Int) -> ParsecT s st m (ListNumberStyle, Int)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
Decimal, Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
num)
exampleNum :: (Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s ParserState m (ListNumberStyle, Int)
exampleNum :: forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s ParserState m (ListNumberStyle, Int)
exampleNum = do
Char -> ParsecT s ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'@'
Text
lab <- [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([[Char]] -> [Text]) -> [[Char]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Text) -> [[Char]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
T.pack ([[Char]] -> Text)
-> ParsecT s ParserState m [[Char]] -> ParsecT s ParserState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParsecT s ParserState m [Char] -> ParsecT s ParserState m [[Char]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s ParserState m Char -> ParsecT s ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum ParsecT s ParserState m [Char]
-> ParsecT s ParserState m [Char] -> ParsecT s ParserState m [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
ParsecT s ParserState m [Char] -> ParsecT s ParserState m [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do Char
c <- Char -> ParsecT s ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'_' ParsecT s ParserState m Char
-> ParsecT s ParserState m Char -> ParsecT s ParserState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT s ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-'
[Char]
cs <- ParsecT s ParserState m Char -> ParsecT s ParserState m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s ParserState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum
[Char] -> ParsecT s ParserState m [Char]
forall a. a -> ParsecT s ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs)))
ParserState
st <- ParsecT s ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let num :: Int
num = ParserState -> Int
stateNextExample ParserState
st
let newlabels :: Map Text Int
newlabels = if Text -> Bool
T.null Text
lab
then ParserState -> Map Text Int
stateExamples ParserState
st
else Text -> Int -> Map Text Int -> Map Text Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
lab Int
num (Map Text Int -> Map Text Int) -> Map Text Int -> Map Text Int
forall a b. (a -> b) -> a -> b
$ ParserState -> Map Text Int
stateExamples ParserState
st
(ParserState -> ParserState) -> ParsecT s ParserState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ParserState -> ParserState) -> ParsecT s ParserState m ())
-> (ParserState -> ParserState) -> ParsecT s ParserState m ()
forall a b. (a -> b) -> a -> b
$ \ParserState
s -> ParserState
s{ stateNextExample :: Int
stateNextExample = Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, stateExamples :: Map Text Int
stateExamples = Map Text Int
newlabels }
(ListNumberStyle, Int)
-> ParsecT s ParserState m (ListNumberStyle, Int)
forall a. a -> ParsecT s ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
Example, Int
num)
defaultNum :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s st m (ListNumberStyle, Int)
defaultNum :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
defaultNum = do
Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'#'
(ListNumberStyle, Int) -> ParsecT s st m (ListNumberStyle, Int)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
DefaultStyle, Int
1)
lowerAlpha :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s st m (ListNumberStyle, Int)
lowerAlpha :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
lowerAlpha = do
Char
ch <- (Char -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAsciiLower
(ListNumberStyle, Int) -> ParsecT s st m (ListNumberStyle, Int)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
LowerAlpha, Char -> Int
ord Char
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
upperAlpha :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s st m (ListNumberStyle, Int)
upperAlpha :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
upperAlpha = do
Char
ch <- (Char -> Bool) -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAsciiUpper
(ListNumberStyle, Int) -> ParsecT s st m (ListNumberStyle, Int)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
UpperAlpha, Char -> Int
ord Char
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
romanOne :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s st m (ListNumberStyle, Int)
romanOne :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
romanOne = (Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'i' ParsecT s st m Char
-> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m (ListNumberStyle, Int)
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ListNumberStyle, Int) -> ParsecT s st m (ListNumberStyle, Int)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
LowerRoman, Int
1)) ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m (ListNumberStyle, Int)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'I' ParsecT s st m Char
-> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m (ListNumberStyle, Int)
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ListNumberStyle, Int) -> ParsecT s st m (ListNumberStyle, Int)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListNumberStyle
UpperRoman, Int
1))
anyOrderedListMarker :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s ParserState m ListAttributes
anyOrderedListMarker :: forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s ParserState m ListAttributes
anyOrderedListMarker = [ParsecT s ParserState m ListAttributes]
-> ParsecT s ParserState m ListAttributes
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m ListAttributes
delimParser ParsecT s ParserState m (ListNumberStyle, Int)
numParser | ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m ListAttributes
delimParser <- [ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m ListAttributes
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inPeriod, ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m ListAttributes
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inOneParen, ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m ListAttributes
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inTwoParens],
ParsecT s ParserState m (ListNumberStyle, Int)
numParser <- [ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
decimal, ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s ParserState m (ListNumberStyle, Int)
exampleNum, ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
defaultNum, ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
romanOne,
ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
lowerAlpha, ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
lowerRoman, ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
upperAlpha, ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
upperRoman]]
inPeriod :: (Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inPeriod :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inPeriod ParsecT s st m (ListNumberStyle, Int)
num = ParsecT s st m ListAttributes -> ParsecT s st m ListAttributes
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m ListAttributes -> ParsecT s st m ListAttributes)
-> ParsecT s st m ListAttributes -> ParsecT s st m ListAttributes
forall a b. (a -> b) -> a -> b
$ do
(ListNumberStyle
style, Int
start) <- ParsecT s st m (ListNumberStyle, Int)
num
Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'.'
let delim :: ListNumberDelim
delim = if ListNumberStyle
style ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
DefaultStyle
then ListNumberDelim
DefaultDelim
else ListNumberDelim
Period
ListAttributes -> ParsecT s st m ListAttributes
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start, ListNumberStyle
style, ListNumberDelim
delim)
inOneParen :: (Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inOneParen :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inOneParen ParsecT s st m (ListNumberStyle, Int)
num = ParsecT s st m ListAttributes -> ParsecT s st m ListAttributes
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m ListAttributes -> ParsecT s st m ListAttributes)
-> ParsecT s st m ListAttributes -> ParsecT s st m ListAttributes
forall a b. (a -> b) -> a -> b
$ do
(ListNumberStyle
style, Int
start) <- ParsecT s st m (ListNumberStyle, Int)
num
Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
')'
ListAttributes -> ParsecT s st m ListAttributes
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start, ListNumberStyle
style, ListNumberDelim
OneParen)
inTwoParens :: (Stream s m Char, UpdateSourcePos s Char)
=> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inTwoParens :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inTwoParens ParsecT s st m (ListNumberStyle, Int)
num = ParsecT s st m ListAttributes -> ParsecT s st m ListAttributes
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m ListAttributes -> ParsecT s st m ListAttributes)
-> ParsecT s st m ListAttributes -> ParsecT s st m ListAttributes
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'('
(ListNumberStyle
style, Int
start) <- ParsecT s st m (ListNumberStyle, Int)
num
Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
')'
ListAttributes -> ParsecT s st m ListAttributes
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start, ListNumberStyle
style, ListNumberDelim
TwoParens)
orderedListMarker :: (Stream s m Char, UpdateSourcePos s Char)
=> ListNumberStyle
-> ListNumberDelim
-> ParsecT s ParserState m Int
orderedListMarker :: forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ListNumberStyle -> ListNumberDelim -> ParsecT s ParserState m Int
orderedListMarker ListNumberStyle
style ListNumberDelim
delim = do
let num :: ParsecT s ParserState m (ListNumberStyle, Int)
num = ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
defaultNum ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m (ListNumberStyle, Int)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
case ListNumberStyle
style of
ListNumberStyle
DefaultStyle -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
decimal
ListNumberStyle
Example -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s ParserState m (ListNumberStyle, Int)
exampleNum
ListNumberStyle
Decimal -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
decimal
ListNumberStyle
UpperRoman -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
upperRoman
ListNumberStyle
LowerRoman -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
lowerRoman
ListNumberStyle
UpperAlpha -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
upperAlpha
ListNumberStyle
LowerAlpha -> ParsecT s ParserState m (ListNumberStyle, Int)
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
lowerAlpha
let context :: ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
context = case ListNumberDelim
delim of
ListNumberDelim
DefaultDelim -> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inPeriod
ListNumberDelim
Period -> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inPeriod
ListNumberDelim
OneParen -> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inOneParen
ListNumberDelim
TwoParens -> ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
inTwoParens
(Int
start, ListNumberStyle
_, ListNumberDelim
_) <- ParsecT s ParserState m (ListNumberStyle, Int)
-> ParsecT s ParserState m ListAttributes
forall {st}.
ParsecT s st m (ListNumberStyle, Int)
-> ParsecT s st m ListAttributes
context ParsecT s ParserState m (ListNumberStyle, Int)
num
Int -> ParsecT s ParserState m Int
forall a. a -> ParsecT s ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
start