{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}

-- |
-- 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,

    -- * Try to parse a vulgar fraction
    fromVulgar,
    fromVulgarToRatio,

    -- * Render to a vulgar fraction, with a fallback to using small characters
    ratioToVulgarFallback,
    toVulgarFallback,

    -- * Convert 'Text' to a vulgar fraction or fallback on a 'Text' that contains a numerator and denominator as a sequence of characters
    fromVulgarFallback,
    fromVulgarFallbackToRatio,
  )
where

import Control.Applicative ((<|>))
import Data.Char.Small (asSub', fromSubSup, ratioPartsToUnicode', unicodeToRatioParts)
import Data.Ratio (Ratio, denominator, numerator, (%))
import Data.Text (Text, cons, singleton, unpack)
import Text.Read (readMaybe)

-- | Convert the given 'Ratio' item to a vulgar fraction character, if such character exists; 'Nothing' otherwise.
ratioToVulgar ::
  Integral i =>
  -- | The 'Ratio' for which we try to find the corresponding 'Char'acter.
  Ratio i ->
  -- | The corresponding 'Char'acter wrapped in a 'Just' if such character exists; 'Nothing' otherwise.
  Maybe Char
ratioToVulgar :: forall i. Integral i => Ratio i -> Maybe Char
ratioToVulgar Ratio i
r = forall i j. (Integral i, Integral j) => i -> j -> Maybe Char
toVulgar (forall a. Ratio a -> a
numerator Ratio i
r) (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 =>
  -- | The given 'Ratio' to convert.
  Ratio i ->
  -- | A 'Text' object with a single 'Char'acter if a vulgar fraction character exists; otherwise a 'Text' object created by 'ratioPartsToUnicode''.
  Text
ratioToVulgarFallback :: forall i. Integral i => Ratio i -> Text
ratioToVulgarFallback Ratio i
nd = forall i j. (Integral i, Integral j) => i -> j -> Text
toVulgarFallback (forall a. Ratio a -> a
numerator Ratio i
nd) (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) =>
  -- | The given numerator.
  i ->
  -- | The given denominator.
  j ->
  -- | The corresponding 'Char'acter wrapped in a 'Just' if such character exists; 'Nothing' otherwise.
  Maybe Char
toVulgar :: forall i j. (Integral i, Integral j) => i -> j -> Maybe Char
toVulgar i
1 j
4 = forall a. a -> Maybe a
Just Char
'\x00bc'
toVulgar i
1 j
2 = forall a. a -> Maybe a
Just Char
'\x00bd'
toVulgar i
3 j
4 = forall a. a -> Maybe a
Just Char
'\x00be'
toVulgar i
1 j
7 = forall a. a -> Maybe a
Just Char
'\x2150'
toVulgar i
1 j
9 = forall a. a -> Maybe a
Just Char
'\x2151'
toVulgar i
1 j
10 = forall a. a -> Maybe a
Just Char
'\x2152'
toVulgar i
1 j
3 = forall a. a -> Maybe a
Just Char
'\x2153'
toVulgar i
2 j
3 = forall a. a -> Maybe a
Just Char
'\x2154'
toVulgar i
1 j
5 = forall a. a -> Maybe a
Just Char
'\x2155'
toVulgar i
2 j
5 = forall a. a -> Maybe a
Just Char
'\x2156'
toVulgar i
3 j
5 = forall a. a -> Maybe a
Just Char
'\x2157'
toVulgar i
4 j
5 = forall a. a -> Maybe a
Just Char
'\x2158'
toVulgar i
1 j
6 = forall a. a -> Maybe a
Just Char
'\x2159'
toVulgar i
5 j
6 = forall a. a -> Maybe a
Just Char
'\x215a'
toVulgar i
1 j
8 = forall a. a -> Maybe a
Just Char
'\x215b'
toVulgar i
3 j
8 = forall a. a -> Maybe a
Just Char
'\x215c'
toVulgar i
5 j
8 = forall a. a -> Maybe a
Just Char
'\x215d'
toVulgar i
7 j
8 = forall a. a -> Maybe a
Just Char
'\x215e'
toVulgar i
0 j
3 = forall a. a -> Maybe a
Just Char
'\x2189' -- used in baseball
toVulgar i
_ j
_ = 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) =>
  -- | The given /numerator/.
  i ->
  -- | The given /denominator/.
  j ->
  -- | A 'Text' object with a single 'Char'acter if a vulgar fraction character exists; otherwise a 'Text' object created by 'ratioPartsToUnicode''.
  Text
toVulgarFallback :: forall i j. (Integral i, Integral j) => i -> j -> Text
toVulgarFallback i
i j
j = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall {i} {j}. (Integral j, Integral i) => i -> j -> Text
go i
i j
j) Char -> Text
singleton (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 forall a. Ord a => a -> a -> Bool
> j
0 = Char -> Text -> Text
cons Char
'\x215f' (forall i. Integral i => i -> Text
asSub' j
d)
    go i
n j
d = forall i j. (Integral i, Integral j) => i -> j -> Text
ratioPartsToUnicode' i
n j
d

-- | Try to convert a given 'Char', if it is a /vulgar fraction/, to a 2-tuple with the numerator and denominator. Returns 'Nothing' if the 'Char'
-- is not a vulgar fraction character.
fromVulgar ::
  (Integral i, Integral j) =>
  -- | The character to decode.
  Char ->
  -- | The numerator and denominator wrapped in a 'Just' if the character is a vulgar fraction, 'Nothing' otherwise.
  Maybe (i, j)
fromVulgar :: forall i j. (Integral i, Integral j) => Char -> Maybe (i, j)
fromVulgar Char
'\x00bc' = forall a. a -> Maybe a
Just (i
1, j
4)
fromVulgar Char
'\x00bd' = forall a. a -> Maybe a
Just (i
1, j
2)
fromVulgar Char
'\x00be' = forall a. a -> Maybe a
Just (i
3, j
4)
fromVulgar Char
'\x2150' = forall a. a -> Maybe a
Just (i
1, j
7)
fromVulgar Char
'\x2151' = forall a. a -> Maybe a
Just (i
1, j
9)
fromVulgar Char
'\x2152' = forall a. a -> Maybe a
Just (i
1, j
10)
fromVulgar Char
'\x2153' = forall a. a -> Maybe a
Just (i
1, j
3)
fromVulgar Char
'\x2154' = forall a. a -> Maybe a
Just (i
2, j
3)
fromVulgar Char
'\x2155' = forall a. a -> Maybe a
Just (i
1, j
5)
fromVulgar Char
'\x2156' = forall a. a -> Maybe a
Just (i
2, j
5)
fromVulgar Char
'\x2157' = forall a. a -> Maybe a
Just (i
3, j
5)
fromVulgar Char
'\x2158' = forall a. a -> Maybe a
Just (i
4, j
5)
fromVulgar Char
'\x2159' = forall a. a -> Maybe a
Just (i
1, j
6)
fromVulgar Char
'\x215a' = forall a. a -> Maybe a
Just (i
5, j
6)
fromVulgar Char
'\x215b' = forall a. a -> Maybe a
Just (i
1, j
8)
fromVulgar Char
'\x215c' = forall a. a -> Maybe a
Just (i
3, j
8)
fromVulgar Char
'\x215d' = forall a. a -> Maybe a
Just (i
5, j
8)
fromVulgar Char
'\x215e' = forall a. a -> Maybe a
Just (i
7, j
8)
fromVulgar Char
'\x2189' = forall a. a -> Maybe a
Just (i
0, j
3) -- used in baseball
fromVulgar Char
_ = forall a. Maybe a
Nothing

-- | Try to convert the given 'Char', if it is a /vulgar fraction/, to a 'Ratio' object. Returns 'Nothing' if the 'Char' is not a vulgar fraction character.
fromVulgarToRatio ::
  Integral i =>
  -- | The character to decode.
  Char ->
  -- | The corresponding 'Ratio' wrapped in a 'Just' if the ratio is a vulgar fraction, 'Nothing' otherwise.
  Maybe (Ratio i)
fromVulgarToRatio :: forall i. Integral i => Char -> Maybe (Ratio i)
fromVulgarToRatio = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Integral a => a -> a -> Ratio a
(%)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i j. (Integral i, Integral j) => Char -> Maybe (i, j)
fromVulgar

-- | Try to parse the text as a /vulgar fraction/ and fallback on the 'unicodeToRatioParts' function to parse it as a fraction.
fromVulgarFallback ::
  (Read i, Integral i, Read j, Integral j) =>
  -- | The 'Text' we try to decode as a (vulgar) fraction.
  Text ->
  -- | A 2-tuple with the numerator and denominator wrapped in a 'Just' if the 'Text' can be parsed, 'Nothing' otherwise.
  Maybe (i, j)
fromVulgarFallback :: forall i j.
(Read i, Integral i, Read j, Integral j) =>
Text -> Maybe (i, j)
fromVulgarFallback Text
d = forall {i} {j}. (Integral i, Integral j) => [Char] -> Maybe (i, j)
_attm0 [Char]
d' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {t} {a}. (Num t, Read a) => [Char] -> Maybe (t, a)
_attm1 [Char]
d' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall i j. (Read i, Read j) => Text -> Maybe (i, j)
unicodeToRatioParts Text
d
  where
    d' :: [Char]
d' = Text -> [Char]
unpack Text
d
    _attm0 :: [Char] -> Maybe (i, j)
_attm0 [Char
d0] = forall i j. (Integral i, Integral j) => Char -> Maybe (i, j)
fromVulgar Char
d0
    _attm0 [Char]
_ = forall a. Maybe a
Nothing
    _attm1 :: [Char] -> Maybe (t, a)
_attm1 (Char
'\x215f' : [Char]
ds) = (t
1,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => [Char] -> Maybe a
readMaybe (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fromSubSup [Char]
ds)
    _attm1 [Char]
_ = forall a. Maybe a
Nothing

-- | Try to parse the text as a /vulgar fraction/ and fallback on the 'unicodeToRatioParts' function to parse it as a fraction.
fromVulgarFallbackToRatio ::
  (Read i, Integral i) =>
  -- | The 'Text' we try to decode as a (vulgar) fraction.
  Text ->
  -- | The parsed 'Ratio' wrapped in a 'Just' if the 'Text' can be parsed, 'Nothing' otherwise.
  Maybe (Ratio i)
fromVulgarFallbackToRatio :: forall i. (Read i, Integral i) => Text -> Maybe (Ratio i)
fromVulgarFallbackToRatio = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Integral a => a -> a -> Ratio a
(%)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i j.
(Read i, Integral i, Read j, Integral j) =>
Text -> Maybe (i, j)
fromVulgarFallback