    {-# 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 = SyntaxSpec m il bl
    forall a. Monoid a => a
    mempty
      { syntaxBlockSpecs =
         [ listItemSpec (bulletListMarker <|> fancyOrderedListMarker) ]
      }

    fancyOrderedListMarker :: Monad m => BlockParser m il bl ListType
    fancyOrderedListMarker :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
    fancyOrderedListMarker = do
      mbListType <- BlockParser m il bl (Maybe ListType)
    forall (m :: * -> *) il bl.
    Monad m =>
    BlockParser m il bl (Maybe ListType)
    getParentListType
      -- first try to parse an item like the parent
      let pInSeries = case Maybe ListType
    mbListType of
                         Just (OrderedList Int
    _ EnumeratorType
    e DelimiterType
    d) -> ParsecT [Tok] u m ListType -> ParsecT [Tok] u m ListType
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (EnumeratorType -> DelimiterType -> ParsecT [Tok] u m ListType
    forall {s}.
    EnumeratorType -> DelimiterType -> ParsecT [Tok] s m ListType
    pMarker EnumeratorType
    e DelimiterType
    d)
                         Maybe ListType
    _ -> ParsecT [Tok] u m ListType
    forall a. ParsecT [Tok] u m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
      pInSeries <|>
          do initialParen <- option False $ True <$ symbol '('
             (start, enumtype) <- pDecimal <|>
                                  (case mbListType of
                                     Maybe ListType
    Nothing -> ParsecT [Tok] (BPState m il bl) m (Int, EnumeratorType)
    forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
    pLowerRomanOne ParsecT [Tok] (BPState m il bl) m (Int, EnumeratorType)
    -> ParsecT [Tok] (BPState m il bl) m (Int, EnumeratorType)
    -> ParsecT [Tok] (BPState m il bl) m (Int, EnumeratorType)
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> ParsecT [Tok] (BPState m il bl) m (Int, EnumeratorType)
    forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
    pUpperRomanOne
                                     Maybe ListType
    _ -> ParsecT [Tok] (BPState m il bl) m (Int, EnumeratorType)
    forall a. ParsecT [Tok] (BPState m il bl) m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero) <|>
                                  pLowerAlpha <|> pUpperAlpha <|>
                                  pLowerRoman <|> pUpperRoman
             delimtype <- if initialParen
                             then TwoParens <$ symbol ')'
                             else Period <$ symbol '.' <|> OneParen <$ symbol ')'
             when (delimtype == Period &&
                  (enumtype == UpperRoman || enumtype == UpperAlpha)) $ checkSpace
             return $! OrderedList start enumtype delimtype

      where
        checkSpace :: ParsecT [Tok] u m ()
    checkSpace = do
            Tok tt _ t <- ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m a
    lookAhead ParsecT [Tok] u m Tok
    forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
    anyTok
            guard $ case tt of
                      TokType
    Spaces  -> Text -> Int
    T.length Text
    t Int -> Int -> Bool
    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
          Bool -> ParsecT [Tok] s m () -> ParsecT [Tok] s m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DelimiterType
    d DelimiterType -> DelimiterType -> Bool
    forall a. Eq a => a -> a -> Bool
    == DelimiterType
    TwoParens) (ParsecT [Tok] s m () -> ParsecT [Tok] s m ())
    -> ParsecT [Tok] s m () -> ParsecT [Tok] s m ()
    forall a b. (a -> b) -> a -> b
    $ () () -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ()
    forall a b. a -> ParsecT [Tok] s m b -> ParsecT [Tok] s m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Char -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '('
          (start, enumtype) <- case EnumeratorType
    e of
            EnumeratorType
    Decimal -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
    pDecimal
            EnumeratorType
    LowerRoman -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
    pLowerRoman
            EnumeratorType
    UpperRoman -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
    pUpperRoman
            EnumeratorType
    LowerAlpha -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
    pLowerAlpha
            EnumeratorType
    UpperAlpha -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall {s}. ParsecT [Tok] s m (Int, EnumeratorType)
    pUpperAlpha
          delimtype <- case d of
            DelimiterType
    TwoParens -> DelimiterType
    TwoParens DelimiterType
    -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m DelimiterType
    forall a b. a -> ParsecT [Tok] s m b -> ParsecT [Tok] s m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Char -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    ')'
            DelimiterType
    OneParen  -> DelimiterType
    OneParen DelimiterType
    -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m DelimiterType
    forall a b. a -> ParsecT [Tok] s m b -> ParsecT [Tok] s m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Char -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    ')'
            DelimiterType
    Period    -> DelimiterType
    Period DelimiterType
    -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m DelimiterType
    forall a b. a -> ParsecT [Tok] s m b -> ParsecT [Tok] s m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Char -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '.'
          when (delimtype == Period &&
               (enumtype == UpperRoman || enumtype == UpperAlpha)) $ checkSpace
          return $! OrderedList start enumtype delimtype
        pDecimal :: ParsecT [Tok] s m (Int, EnumeratorType)
    pDecimal = do
          Tok WordChars _ ds <- (Text -> Bool) -> ParsecT [Tok] s m Tok
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    10)
          case TR.decimal ds of
            Left String
    e -> String -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. String -> ParsecT [Tok] s m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    e
            Right (Int
    x,Text
    _) -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. a -> ParsecT [Tok] s m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType))
    -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a b. (a -> b) -> a -> b
    $! (Int
    x, EnumeratorType
    Decimal)

        pLowerAlpha :: ParsecT [Tok] s m (Int, EnumeratorType)
    pLowerAlpha = do
          Tok WordChars _ ds <- (Text -> Bool) -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Text -> Bool) -> ParsecT [Tok] s m Tok
    satisfyWord (\Text
    t ->
                                  Text -> Int
    T.length Text
    t Int -> Int -> Bool
    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 T.uncons ds of
            Maybe (Char, Text)
    Nothing    -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. ParsecT [Tok] s m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            Just (Char
    c,Text
    _) -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. a -> ParsecT [Tok] s m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType))
    -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a b. (a -> b) -> a -> b
    $! (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    'a', EnumeratorType
    LowerAlpha)

        pUpperAlpha :: ParsecT [Tok] s m (Int, EnumeratorType)
    pUpperAlpha = do
          Tok WordChars _ ds <- (Text -> Bool) -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Text -> Bool) -> ParsecT [Tok] s m Tok
    satisfyWord (\Text
    t ->
                                  Text -> Int
    T.length Text
    t Int -> Int -> Bool
    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 T.uncons ds of
            Maybe (Char, Text)
    Nothing    -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. ParsecT [Tok] s m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            Just (Char
    c,Text
    _) -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. a -> ParsecT [Tok] s m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType))
    -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a b. (a -> b) -> a -> b
    $! (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    c Int -> Int -> Int
    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) (Int, EnumeratorType)
    -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a b. a -> ParsecT [Tok] s m b -> ParsecT [Tok] s m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Text -> Bool) -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Text -> Bool) -> ParsecT [Tok] s m Tok
    satisfyWord (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "i")
        pUpperRomanOne :: ParsecT [Tok] s m (Int, EnumeratorType)
    pUpperRomanOne = (Int
    1, EnumeratorType
    UpperRoman) (Int, EnumeratorType)
    -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a b. a -> ParsecT [Tok] s m b -> ParsecT [Tok] s m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Text -> Bool) -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Text -> Bool) -> ParsecT [Tok] s m Tok
    satisfyWord (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "I")

        pLowerRoman :: ParsecT [Tok] s m (Int, EnumeratorType)
    pLowerRoman = do
          Tok WordChars _ ds <- (Text -> Bool) -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Text -> Bool) -> ParsecT [Tok] s m Tok
    satisfyWord (\Text
    t ->
                                  Text -> Int
    T.length Text
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    10 Bool -> Bool -> Bool
    &&
                                  (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    isLowerRoman Text
    t)
          case parse (romanNumeral False) "" ds of
            Left ParseError
    _     -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. ParsecT [Tok] s m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            Right Int
    x    -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. a -> ParsecT [Tok] s m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType))
    -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a b. (a -> b) -> a -> b
    $! (Int
    x, EnumeratorType
    LowerRoman)

        pUpperRoman :: ParsecT [Tok] s m (Int, EnumeratorType)
    pUpperRoman = do
          Tok WordChars _ ds <- (Text -> Bool) -> ParsecT [Tok] s m Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Text -> Bool) -> ParsecT [Tok] s m Tok
    satisfyWord (\Text
    t ->
                                  Text -> Int
    T.length Text
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    10 Bool -> Bool -> Bool
    &&
                                  (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    isUpperRoman Text
    t)
          case parse (romanNumeral True) "" ds of
            Left ParseError
    _     -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. ParsecT [Tok] s m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            Right Int
    x    -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a. a -> ParsecT [Tok] s m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType))
    -> (Int, EnumeratorType) -> ParsecT [Tok] s m (Int, EnumeratorType)
    forall a b. (a -> b) -> a -> b
    $! (Int
    x, EnumeratorType
    UpperRoman)

    isLowerRoman :: Char -> Bool
    isLowerRoman :: Char -> Bool
    isLowerRoman Char
    c = Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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 Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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 = Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m 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 s (m :: * -> *) u.
    Stream s m 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 s (m :: * -> *) u.
    Stream s m 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 s (m :: * -> *) u.
    Stream s m 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 s (m :: * -> *) u.
    Stream s m 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 s (m :: * -> *) u.
    Stream s m 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 s (m :: * -> *) u.
    Stream s m 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 s (m :: * -> *) u.
    Stream s m 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]
        thousands <- ((Int
    1000 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *) (Int -> Int) -> (String -> Int) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length) (String -> Int) -> ParsecT s st m String -> 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 String
    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
        ninehundreds <- option 0 $ try $ hundred >> thousand >> return 900
        fivehundreds <- option 0 $ 500 <$ fivehundred
        fourhundreds <- option 0 $ try $ hundred >> fivehundred >> return 400
        hundreds <- ((100 *) . length) <$> many hundred
        nineties <- option 0 $ try $ ten >> hundred >> return 90
        fifties <- option 0 (50 <$ fifty)
        forties <- option 0 $ try $ ten >> fifty >> return 40
        tens <- ((10 *) . length) <$> many ten
        nines <- option 0 $ try $ one >> ten >> return 9
        fives <- option 0 (5 <$ five)
        fours <- option 0 $ try $ one >> five >> return 4
        ones <- length <$> many one
        let 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 total == 0
           then fail "not a roman numeral"
           else return $! total