{-# LANGUAGE Safe #-}

{-|
Module      : Data.Char.Number.VulgarFraction
Description : A module used to render vulgar fractions with Unicode.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

Uncode has two blocks where vulgar fractions are defined: <https://www.unicode.org/charts/PDF/U0080.pdf C1 controls and latin supplement 1> and
<https://www.unicode.org/charts/PDF/U2150.pdf Number forms>. These are fractions that are commenly used.

The module exports function 'toVulgar' and 'ratioToVulgar' to convert the ratio to a 'Char' with that fraction if that exists. The
functon 'ratioToVulgarFallback' and 'ratioToVulgarFallback' are used to try to find a vulgar fraction character, and if that fails,
it prints the fraction with the help of the 'Data.Char.Small' module.
-}


module Data.Char.Number.VulgarFraction (
    -- * Render to a vulgar fraction
    ratioToVulgar, toVulgar
    -- * Render to a vulgar fraction, with a fallback to using small characters
  , ratioToVulgarFallback, toVulgarFallback
  ) where

import Data.Ratio(Ratio, numerator, denominator)
import Data.Text(Text, cons, singleton)

import Data.Char.Small(asSub', ratioPartsToUnicode')

-- | Convert the given 'Ratio' item to a vulgar fraction character, if such character exists; 'Nothing' otherwise.
ratioToVulgar :: Integral i
  => Ratio i  -- ^ The 'Ratio' for which we try to find the corresponding 'Char'acter.
  -> Maybe Char -- ^ The corresponding 'Char'acter wrapped in a 'Just' if such character exists; 'Nothing' otherwise.
ratioToVulgar :: Ratio i -> Maybe Char
ratioToVulgar Ratio i
r = i -> i -> Maybe Char
forall i j. (Integral i, Integral j) => i -> j -> Maybe Char
toVulgar (Ratio i -> i
forall a. Ratio a -> a
numerator Ratio i
r) (Ratio i -> i
forall a. Ratio a -> a
denominator Ratio i
r)

-- | Convert the given 'Ratio' to a singleton 'Text' with the vulgar fraction character,
-- if such character exists; it will make ue of the 'ratioPartsToUnicode'' to generate a 'Text'
-- object (with multiple 'Char'acters) that looks like a fraction.
ratioToVulgarFallback :: Integral i
  => Ratio i  -- ^ The given 'Ratio' to convert.
  -> Text  -- ^ A 'Text' object with a single 'Char'acter if a vulgar fraction character exists; otherwise a 'Text' object created by 'ratioPartsToUnicode''.
ratioToVulgarFallback :: Ratio i -> Text
ratioToVulgarFallback Ratio i
nd = i -> i -> Text
forall i j. (Integral i, Integral j) => i -> j -> Text
toVulgarFallback (Ratio i -> i
forall a. Ratio a -> a
numerator Ratio i
nd) (Ratio i -> i
forall a. Ratio a -> a
denominator Ratio i
nd)

-- | Convert the given /numerator/ den /denominator/ to a vulgar fraction character, if such character exists; 'Nothing' otherwise.
toVulgar :: (Integral i, Integral j)
  => i  -- ^ The given numerator.
  -> j  -- ^ The given denominator.
  -> Maybe Char -- ^ The corresponding 'Char'acter wrapped in a 'Just' if such character exists; 'Nothing' otherwise.
toVulgar :: i -> j -> Maybe Char
toVulgar i
1 j
4 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x00bc'
toVulgar i
1 j
2 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x00bd'
toVulgar i
3 j
4 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x00be'
toVulgar i
1 j
7 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2150'
toVulgar i
1 j
9 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2151'
toVulgar i
1 j
10 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2152'
toVulgar i
1 j
3 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2153'
toVulgar i
2 j
3 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2154'
toVulgar i
1 j
5 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2155'
toVulgar i
2 j
5 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2156'
toVulgar i
3 j
5 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2157'
toVulgar i
4 j
5 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2158'
toVulgar i
1 j
6 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2159'
toVulgar i
5 j
6 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x215a'
toVulgar i
1 j
8 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x215b'
toVulgar i
3 j
8 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x215c'
toVulgar i
5 j
8 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x215d'
toVulgar i
7 j
8 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x215e'
toVulgar i
0 j
3 = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x2189'  -- used in baseball
toVulgar i
_ j
_ = Maybe Char
forall a. Maybe a
Nothing

-- | Convert the given numerator and denominator to a singleton 'Text' with the vulgar fraction character,
-- if such character exists; it will make ue of the 'ratioPartsToUnicode'' to generate a 'Text'
-- object (with multiple 'Char'acters) that looks like a fraction.
toVulgarFallback :: (Integral i, Integral j)
  => i  -- ^ The given /numerator/.
  -> j  -- ^ The given /denominator/.
  -> Text  -- ^ A 'Text' object with a single 'Char'acter if a vulgar fraction character exists; otherwise a 'Text' object created by 'ratioPartsToUnicode''.
toVulgarFallback :: i -> j -> Text
toVulgarFallback i
i j
j = Text -> (Char -> Text) -> Maybe Char -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (i -> j -> Text
forall i j. (Integral j, Integral i) => i -> j -> Text
go i
i j
j) Char -> Text
singleton (i -> j -> Maybe Char
forall i j. (Integral i, Integral j) => i -> j -> Maybe Char
toVulgar i
i j
j)
  where go :: i -> j -> Text
go i
1 j
d | j
d j -> j -> Bool
forall a. Ord a => a -> a -> Bool
> j
0 = Char -> Text -> Text
cons Char
'\x215f' ( j -> Text
forall i. Integral i => i -> Text
asSub' j
d)
        go i
n j
d = i -> j -> Text
forall i j. (Integral i, Integral j) => i -> j -> Text
ratioPartsToUnicode' i
n j
d