{-
pandoc-crossref is a pandoc filter for numbering figures,
equations, tables and cross-references to them.
Copyright 2009–2014 Roel van Dijk
Copyright 2022 Nikolay Yakimov <root@livid.pp.ru>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

This file contains code covered by the license found in licenses/LICENSE.roman-numerals
-}

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

{-| Parsing and pretty printing of Roman numerals.

This module provides functions for parsing and pretty printing Roman
numerals. Because the notation of Roman numerals has varied through
the centuries this package allows for some customisation using a
configuration that is passed to the conversion functions.

Example:

>>> toRoman 1729 :: String
"MDCCXXIX"

>>> fromRoman "MDCCXXIX" :: Maybe Integer
Just 1729

>>> fromRoman "Bla" :: Maybe Integer
Nothing
-}
module Text.Numeral.Roman
  ( -- * Types
    NumeralConfig
  , mkNumConfig

    -- * Pretty printing
  , convertTo

    -- * Parsing
  , convertFrom

    -- * Default Configurations
  , modernRoman

    -- * Utility
  , toRoman
  , fromRoman
  ) where

import Control.Monad (mzero)
import Data.Function (on)
import Data.List (sortBy)
import qualified Data.Text as T (Text, null, stripPrefix)
import Data.Text.Internal.Builder
import qualified Data.Text.Lazy as TL (toStrict)

-- |A configuration with which the 'convertTo' and 'convertFrom' functions can
-- be parameterized.
data NumeralConfig n = NC
  { -- |Symbol to represent the value 0.
    forall n. NumeralConfig n -> Text
ncZero  :: T.Text
    -- |A table of symbols and their numerical values. The table must be
    -- ordered in descending order of the value of the symbols. If any symbol
    -- is the empty string then 'convertFrom' will be &#x22a5;.
  , forall n. NumeralConfig n -> [(Text, n)]
ncTable :: [(T.Text, n)]
  }

-- |Smart constructor for a 'NumeralConfig'.
mkNumConfig :: (Ord n, Num n)
            => T.Text -- ^Symbol for zero
            -> T.Text -- ^Symbol for one
            -> [(T.Text, n)] -- ^ Symbol-value table.
            -> NumeralConfig n
mkNumConfig :: forall n.
(Ord n, Num n) =>
Text -> Text -> [(Text, n)] -> NumeralConfig n
mkNumConfig Text
z Text
o [(Text, n)]
tab =
  NC { ncZero :: Text
ncZero = Text
z, ncTable :: [(Text, n)]
ncTable = ((Text, n) -> (Text, n) -> Ordering) -> [(Text, n)] -> [(Text, n)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((n -> n -> Ordering) -> n -> n -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip n -> n -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (n -> n -> Ordering)
-> ((Text, n) -> n) -> (Text, n) -> (Text, n) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text, n) -> n
forall a b. (a, b) -> b
snd) ((Text
o, n
1) (Text, n) -> [(Text, n)] -> [(Text, n)]
forall a. a -> [a] -> [a]
: [(Text, n)]
tab) }

-- |Converts a number to a Roman numeral according to the given configuration.
convertTo :: (Ord n, Num n) => NumeralConfig n -> n -> T.Text
convertTo :: forall n. (Ord n, Num n) => NumeralConfig n -> n -> Text
convertTo NumeralConfig n
nc n
n | n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0    = NumeralConfig n -> Text
forall n. NumeralConfig n -> Text
ncZero NumeralConfig n
nc
               | Bool
otherwise = Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ n -> [(Text, n)] -> Builder
forall {t}. (Ord t, Num t) => t -> [(Text, t)] -> Builder
go n
n ([(Text, n)] -> Builder) -> [(Text, n)] -> Builder
forall a b. (a -> b) -> a -> b
$ NumeralConfig n -> [(Text, n)]
forall n. NumeralConfig n -> [(Text, n)]
ncTable NumeralConfig n
nc
  where
    go :: t -> [(Text, t)] -> Builder
go t
_ [] = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"Roman.convertTo: out of symbols (BUG)"
    go t
i tab :: [(Text, t)]
tab@(~(Text
sym, t
val) : [(Text, t)]
ts) | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0    = Builder
forall a. Monoid a => a
mempty
                                | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
val  = Text -> Builder
fromText Text
sym Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> t -> [(Text, t)] -> Builder
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
- t
val) [(Text, t)]
tab
                                | Bool
otherwise = t -> [(Text, t)] -> Builder
go t
i [(Text, t)]
ts


-- |Parses a string as a Roman numeral according to the given
-- configuration. Result is 'Nothing' if the input is not a valid numeral.
convertFrom :: (Ord n, Num n) => NumeralConfig n -> T.Text -> Maybe n
convertFrom :: forall n. (Ord n, Num n) => NumeralConfig n -> Text -> Maybe n
convertFrom NumeralConfig n
nc Text
s
  | NumeralConfig n -> Text
forall n. NumeralConfig n -> Text
ncZero NumeralConfig n
nc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s = n -> Maybe n
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return n
0
  | Bool
otherwise = do
    n
n <- n -> [(Text, n)] -> Text -> Maybe n
forall {m :: * -> *} {t}.
(MonadPlus m, Num t) =>
t -> [(Text, t)] -> Text -> m t
go n
0 (NumeralConfig n -> [(Text, n)]
forall n. NumeralConfig n -> [(Text, n)]
ncTable NumeralConfig n
nc) Text
s
    if Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== NumeralConfig n -> n -> Text
forall n. (Ord n, Num n) => NumeralConfig n -> n -> Text
convertTo NumeralConfig n
nc n
n then n -> Maybe n
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return n
n else Maybe n
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  where
    go :: t -> [(Text, t)] -> Text -> m t
go t
n [(Text, t)]
_ Text
x | Text -> Bool
T.null Text
x = t -> m t
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return t
n
    go t
_ [] Text
_           = m t
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    go t
n tab :: [(Text, t)]
tab@((Text
sym, t
val) : [(Text, t)]
ts) Text
x =
      m t -> (Text -> m t) -> Maybe Text -> m t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (t -> [(Text, t)] -> Text -> m t
go t
n [(Text, t)]
ts Text
x) (t -> [(Text, t)] -> Text -> m t
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
val) [(Text, t)]
tab) (Maybe Text -> m t) -> Maybe Text -> m t
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
sym Text
x

-- |Configuration for Roman numerals as they are commonly used today. The value
-- 0 is represented by the empty string. It can be interpreted as not writing
-- down a number. This configuration is practically limited to the range
-- [1..3999]. Smaller numbers will result in an empty string. Larger numbers
-- will result in repeated use of the \'M\' symbol.
modernRoman :: (Ord n, Num n) => NumeralConfig n
modernRoman :: forall n. (Ord n, Num n) => NumeralConfig n
modernRoman = Text -> Text -> [(Text, n)] -> NumeralConfig n
forall n.
(Ord n, Num n) =>
Text -> Text -> [(Text, n)] -> NumeralConfig n
mkNumConfig
  Text
""
  Text
"I"
  [ (Text
"IV", n
4)
  , (Text
"V" , n
5)
  , (Text
"IX", n
9)
  , (Text
"X" , n
10)
  , (Text
"XL", n
40)
  , (Text
"L" , n
50)
  , (Text
"XC", n
90)
  , (Text
"C" , n
100)
  , (Text
"CD", n
400)
  , (Text
"D" , n
500)
  , (Text
"CM", n
900)
  , (Text
"M" , n
1000)
  ]

-- |Converts a number to a modern Roman numeral.
toRoman :: (Ord n, Num n) => n -> T.Text
toRoman :: forall n. (Ord n, Num n) => n -> Text
toRoman = NumeralConfig n -> n -> Text
forall n. (Ord n, Num n) => NumeralConfig n -> n -> Text
convertTo NumeralConfig n
forall n. (Ord n, Num n) => NumeralConfig n
modernRoman

-- |Parses a string as a modern Roman numeral.
fromRoman :: (Ord n, Num n) => T.Text -> Maybe n
fromRoman :: forall n. (Ord n, Num n) => Text -> Maybe n
fromRoman = NumeralConfig n -> Text -> Maybe n
forall n. (Ord n, Num n) => NumeralConfig n -> Text -> Maybe n
convertFrom NumeralConfig n
forall n. (Ord n, Num n) => NumeralConfig n
modernRoman