{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Commonmark.Extensions.FancyList
( fancyListSpec
)
where
import Commonmark.Types
import Commonmark.Tokens
import Commonmark.Syntax
import Commonmark.TokParsers
import Commonmark.Blocks
import qualified Data.Text as T
import Control.Monad (mzero, guard, when)
import Text.Parsec
import qualified Data.Text.Read as TR
import Data.Char (isAlpha, isDigit, isLower, isUpper, ord, toLower)
fancyListSpec :: (Monad m, IsBlock il bl, IsInline il)
=> SyntaxSpec m il bl
fancyListSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il) =>
SyntaxSpec m il bl
fancyListSpec = forall a. Monoid a => a
mempty
{ syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs =
[ forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockParser m il bl ListType -> BlockSpec m il bl
listItemSpec (forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
bulletListMarker forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
fancyOrderedListMarker) ]
}
fancyOrderedListMarker :: Monad m => BlockParser m il bl ListType
fancyOrderedListMarker :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
fancyOrderedListMarker = do
Maybe ListType
mbListType <- forall (m :: * -> *) il bl.
Monad m =>
BlockParser m il bl (Maybe ListType)
getParentListType
let pInSeries :: ParsecT [Tok] u m ListType
pInSeries = case Maybe ListType
mbListType of
Just (OrderedList Int
_ EnumeratorType
e DelimiterType
d) -> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall {s}.
EnumeratorType -> DelimiterType -> ParsecT [Tok] s m ListType
pMarker EnumeratorType
e DelimiterType
d)
Maybe ListType
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
forall {u}. ParsecT [Tok] u m ListType
pInSeries forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
do Bool
initialParen <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False forall a b. (a -> b) -> a -> b
$ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'('
(Int
start, EnumeratorType
enumtype) <- forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pDecimal forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(case Maybe ListType
mbListType of
Maybe ListType
Nothing -> forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pLowerRomanOne forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pUpperRomanOne
Maybe ListType
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pLowerAlpha forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pUpperAlpha forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pLowerRoman forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pUpperRoman
DelimiterType
delimtype <- if Bool
initialParen
then DelimiterType
TwoParens forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
')'
else DelimiterType
Period forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> DelimiterType
OneParen forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
')'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DelimiterType
delimtype forall a. Eq a => a -> a -> Bool
== DelimiterType
Period Bool -> Bool -> Bool
&&
(EnumeratorType
enumtype forall a. Eq a => a -> a -> Bool
== EnumeratorType
UpperRoman Bool -> Bool -> Bool
|| EnumeratorType
enumtype forall a. Eq a => a -> a -> Bool
== EnumeratorType
UpperAlpha)) forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT [Tok] u m ()
checkSpace
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int -> EnumeratorType -> DelimiterType -> ListType
OrderedList Int
start EnumeratorType
enumtype DelimiterType
delimtype
where
checkSpace :: ParsecT [Tok] u m ()
checkSpace = do
Tok TokType
tt SourcePos
_ Text
t <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ case TokType
tt of
TokType
Spaces -> Text -> Int
T.length Text
t forall a. Ord a => a -> a -> Bool
> Int
1
TokType
LineEnd -> Bool
True
TokType
_ -> Bool
False
pMarker :: EnumeratorType -> DelimiterType -> ParsecT [Tok] s m ListType
pMarker EnumeratorType
e DelimiterType
d = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DelimiterType
d forall a. Eq a => a -> a -> Bool
== DelimiterType
TwoParens) forall a b. (a -> b) -> a -> b
$ () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'('
(Int
start, EnumeratorType
enumtype) <- case EnumeratorType
e of
EnumeratorType
Decimal -> forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pDecimal
EnumeratorType
LowerRoman -> forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pLowerRoman
EnumeratorType
UpperRoman -> forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pUpperRoman
EnumeratorType
LowerAlpha -> forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pLowerAlpha
EnumeratorType
UpperAlpha -> forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
pUpperAlpha
DelimiterType
delimtype <- case DelimiterType
d of
DelimiterType
TwoParens -> DelimiterType
TwoParens forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
')'
DelimiterType
OneParen -> DelimiterType
OneParen forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
')'
DelimiterType
Period -> DelimiterType
Period forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DelimiterType
delimtype forall a. Eq a => a -> a -> Bool
== DelimiterType
Period Bool -> Bool -> Bool
&&
(EnumeratorType
enumtype forall a. Eq a => a -> a -> Bool
== EnumeratorType
UpperRoman Bool -> Bool -> Bool
|| EnumeratorType
enumtype forall a. Eq a => a -> a -> Bool
== EnumeratorType
UpperAlpha)) forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT [Tok] u m ()
checkSpace
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int -> EnumeratorType -> DelimiterType -> ListType
OrderedList Int
start EnumeratorType
enumtype DelimiterType
delimtype
pDecimal :: ParsecT [Tok] s m (Int, EnumeratorType)
pDecimal = do
Tok TokType
WordChars SourcePos
_ Text
ds <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t ->
(Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t Bool -> Bool -> Bool
&& Text -> Int
T.length Text
t forall a. Ord a => a -> a -> Bool
< Int
10)
case forall a. Integral a => Reader a
TR.decimal Text
ds of
Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
Right (Int
x,Text
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Int
x, EnumeratorType
Decimal)
pLowerAlpha :: ParsecT [Tok] s m (Int, EnumeratorType)
pLowerAlpha = do
Tok TokType
WordChars SourcePos
_ Text
ds <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t ->
Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&&
(Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlpha Text
t Bool -> Bool -> Bool
&&
(Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLower Text
t)
case Text -> Maybe (Char, Text)
T.uncons Text
ds of
Maybe (Char, Text)
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just (Char
c,Text
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Int
1 forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a', EnumeratorType
LowerAlpha)
pUpperAlpha :: ParsecT [Tok] s m (Int, EnumeratorType)
pUpperAlpha = do
Tok TokType
WordChars SourcePos
_ Text
ds <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t ->
Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&&
(Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlpha Text
t Bool -> Bool -> Bool
&&
(Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isUpper Text
t)
case Text -> Maybe (Char, Text)
T.uncons Text
ds of
Maybe (Char, Text)
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just (Char
c,Text
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Int
1 forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A', EnumeratorType
UpperAlpha)
pLowerRomanOne :: ParsecT [Tok] s m (Int, EnumeratorType)
pLowerRomanOne = (Int
1, EnumeratorType
LowerRoman) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (forall a. Eq a => a -> a -> Bool
== Text
"i")
pUpperRomanOne :: ParsecT [Tok] s m (Int, EnumeratorType)
pUpperRomanOne = (Int
1, EnumeratorType
UpperRoman) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (forall a. Eq a => a -> a -> Bool
== Text
"I")
pLowerRoman :: ParsecT [Tok] s m (Int, EnumeratorType)
pLowerRoman = do
Tok TokType
WordChars SourcePos
_ Text
ds <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t ->
Text -> Int
T.length Text
t forall a. Ord a => a -> a -> Bool
< Int
10 Bool -> Bool -> Bool
&&
(Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLowerRoman Text
t)
case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (forall s (m :: * -> *) st.
Stream s m Char =>
Bool -> ParsecT s st m Int
romanNumeral Bool
False) String
"" Text
ds of
Left ParseError
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Right Int
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Int
x, EnumeratorType
LowerRoman)
pUpperRoman :: ParsecT [Tok] s m (Int, EnumeratorType)
pUpperRoman = do
Tok TokType
WordChars SourcePos
_ Text
ds <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t ->
Text -> Int
T.length Text
t forall a. Ord a => a -> a -> Bool
< Int
10 Bool -> Bool -> Bool
&&
(Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isUpperRoman Text
t)
case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (forall s (m :: * -> *) st.
Stream s m Char =>
Bool -> ParsecT s st m Int
romanNumeral Bool
True) String
"" Text
ds of
Left ParseError
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Right Int
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Int
x, EnumeratorType
UpperRoman)
isLowerRoman :: Char -> Bool
isLowerRoman :: Char -> Bool
isLowerRoman Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'i',Char
'v',Char
'x',Char
'l',Char
'c',Char
'd',Char
'm']
isUpperRoman :: Char -> Bool
isUpperRoman :: Char -> Bool
isUpperRoman Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'I',Char
'V',Char
'X',Char
'L',Char
'C',Char
'D',Char
'M']
romanNumeral :: Stream s m Char
=> Bool
-> ParsecT s st m Int
romanNumeral :: forall s (m :: * -> *) st.
Stream s m Char =>
Bool -> ParsecT s st m Int
romanNumeral Bool
upperCase = do
let rchar :: Char -> ParsecT s u m Char
rchar Char
uc = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
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 = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'I'
let five :: ParsecT s u m Char
five = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'V'
let ten :: ParsecT s u m Char
ten = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'X'
let fifty :: ParsecT s u m Char
fifty = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'L'
let hundred :: ParsecT s u m Char
hundred = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'C'
let fivehundred :: ParsecT s u m Char
fivehundred = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'D'
let thousand :: ParsecT s u m Char
thousand = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rchar Char
'M'
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall {u}. ParsecT s u m Char
one, forall {u}. ParsecT s u m Char
five, forall {u}. ParsecT s u m Char
ten, forall {u}. ParsecT s u m Char
fifty, forall {u}. ParsecT s u m Char
hundred, forall {u}. ParsecT s u m Char
fivehundred, forall {u}. ParsecT s u m Char
thousand]
Int
thousands <- ((Int
1000 forall a. Num a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT s u m Char
thousand
Int
ninehundreds <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT s u m Char
hundred forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {u}. ParsecT s u m Char
thousand forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
900
Int
fivehundreds <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 forall a b. (a -> b) -> a -> b
$ Int
500 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}. ParsecT s u m Char
fivehundred
Int
fourhundreds <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT s u m Char
hundred forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {u}. ParsecT s u m Char
fivehundred forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
400
Int
hundreds <- ((Int
100 forall a. Num a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT s u m Char
hundred
Int
nineties <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT s u m Char
ten forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {u}. ParsecT s u m Char
hundred forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
90
Int
fifties <- 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}. ParsecT s u m Char
fifty)
Int
forties <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT s u m Char
ten forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {u}. ParsecT s u m Char
fifty forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
40
Int
tens <- ((Int
10 forall a. Num a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT s u m Char
ten
Int
nines <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT s u m Char
one forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {u}. ParsecT s u m Char
ten forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
9
Int
fives <- 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}. ParsecT s u m Char
five)
Int
fours <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall {u}. ParsecT s u m Char
one forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {u}. ParsecT s u m Char
five forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
Int
ones <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT s u m Char
one
let total :: Int
total = Int
thousands forall a. Num a => a -> a -> a
+ Int
ninehundreds forall a. Num a => a -> a -> a
+ Int
fivehundreds forall a. Num a => a -> a -> a
+ Int
fourhundreds forall a. Num a => a -> a -> a
+
Int
hundreds forall a. Num a => a -> a -> a
+ Int
nineties forall a. Num a => a -> a -> a
+ Int
fifties forall a. Num a => a -> a -> a
+ Int
forties forall a. Num a => a -> a -> a
+ Int
tens forall a. Num a => a -> a -> a
+ Int
nines forall a. Num a => a -> a -> a
+
Int
fives forall a. Num a => a -> a -> a
+ Int
fours forall a. Num a => a -> a -> a
+ Int
ones
if Int
total forall a. Eq a => a -> a -> Bool
== Int
0
then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a roman numeral"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
total