{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
Module      : Text.Pandoc.Parsing.Lists
Copyright   : © 2006-2024 John MacFarlane
License     : GPL-2.0-or-later
Maintainer  : John MacFarlane <jgm@berkeley.edu>

Parsers for list markers.
-}

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

-- | Parses a roman numeral (uppercase or lowercase), returns number.
romanNumeral :: (Stream s m Char, UpdateSourcePos s Char)
             => Bool                  -- ^ Uppercase if true
             -> 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

-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
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)

-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
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)

-- | Parses a decimal numeral and returns (Decimal, number).
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)

-- | Parses a '@' and optional label and
-- returns (DefaultStyle, [next example number]).  The next
-- example number is incremented in parser state, and the label
-- (if present) is added to the label table.
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
  case Text -> Map Text Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
lab (ParserState -> Map Text Int
stateExamples ParserState
st) of
    Maybe Int
Nothing -> do -- new label
      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 = num + 1
                           , stateExamples    = 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)
    Just Int
num -> -- reuse existing label
      (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)

-- | Parses a '#' returns (DefaultStyle, 1).
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)

-- | Parses a lowercase letter and returns (LowerAlpha, number).
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)

-- | Parses an uppercase letter and returns (UpperAlpha, number).
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)

-- | Parses a roman numeral i or I
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))

-- | Parses an ordered list marker and returns list attributes.
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]]

-- | Parses a list number (num) followed by a period, returns list attributes.
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)

-- | Parses a list number (num) followed by a paren, returns list attributes.
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)

-- | Parses a list number (num) enclosed in parens, returns list attributes.
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)

-- | Parses an ordered list marker with a given style and delimiter,
-- returns number.
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
<|>  -- # can continue any kind of list
            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