{-# 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
  -- first try to parse an item like the parent
  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']

-- from pandoc:
romanNumeral :: Stream s m Char
             => Bool                  -- ^ Uppercase if true
             -> 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