{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}

module Text.Numerals.Internal
  ( _div10,
    _rem10,
    _divisableBy,
    _divisable100,
    _pluralize,
    _pluralize',
    _showText,
    _mergeWith,
    _mergeWithSpace,
    _mergeWithHyphen,
    _mergeWith',
    _replaceSuffix,
    _hundred,
    _thousand,
    _million,
    _billion,
    _trillion,
    _iLog,
    _iLogFloor,
    _stripLastIf,
    _showIntegral,
    _showPositive,
    _genText,
    _shrinkText,
  )
where

import Control.Applicative (liftA2)
import Data.Char (intToDigit)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif
import Data.Text (Text, cons, dropEnd, inits, isSuffixOf, pack, singleton, tails)
import qualified Data.Text as T
import Test.QuickCheck (listOf)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
import Test.QuickCheck.Gen (Gen)

_pluralize :: a -> a -> Int -> a
_pluralize :: forall a. a -> a -> Int -> a
_pluralize a
sing a
plur = Int -> a
forall {a}. (Eq a, Num a) => a -> a
go
  where
    go :: a -> a
go a
1 = a
sing
    go (-1) = a
sing
    go a
_ = a
plur

_pluralize' :: a -> a -> Int -> a
_pluralize' :: forall a. a -> a -> Int -> a
_pluralize' a
sing a
plur = Int -> a
forall {a}. (Eq a, Num a) => a -> a
go
  where
    go :: a -> a
go a
1 = a
sing
    go a
_ = a
plur

_stripLastIf :: Char -> Text -> Text
_stripLastIf :: Char -> Text -> Text
_stripLastIf Char
c Text
t
  | Char -> Text
singleton Char
c Text -> Text -> Bool
`isSuffixOf` Text
t = HasCallStack => Text -> Text
Text -> Text
T.init Text
t
  | Bool
otherwise = Text
t

_mergeWith' :: Char -> Text -> Text -> Text
_mergeWith' :: Char -> Text -> Text -> Text
_mergeWith' Char
m = ((Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
cons Char
m) ((Text -> Text) -> Text -> Text)
-> (Text -> Text -> Text) -> Text -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)

_mergeWithSpace :: Text -> Text -> Text
_mergeWithSpace :: Text -> Text -> Text
_mergeWithSpace = Char -> Text -> Text -> Text
_mergeWith' Char
' '

_mergeWithHyphen :: Text -> Text -> Text
_mergeWithHyphen :: Text -> Text -> Text
_mergeWithHyphen = Char -> Text -> Text -> Text
_mergeWith' Char
'-'

_mergeWith :: Text -> Text -> Text -> Text
_mergeWith :: Text -> Text -> Text -> Text
_mergeWith Text
m = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text) -> (Text -> Text) -> Text -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m)

_showText :: Show a => a -> Text
_showText :: forall a. Show a => a -> Text
_showText = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

_divisableBy :: Integral i => i -> i -> Bool
_divisableBy :: forall i. Integral i => i -> i -> Bool
_divisableBy i
n = (i
0 i -> i -> Bool
forall a. Eq a => a -> a -> Bool
==) (i -> Bool) -> (i -> i) -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> i -> i
forall a. Integral a => a -> a -> a
`mod` i
n)

_divisable100 :: Integral i => i -> Bool
_divisable100 :: forall i. Integral i => i -> Bool
_divisable100 = i -> i -> Bool
forall i. Integral i => i -> i -> Bool
_divisableBy i
forall i. Integral i => i
_hundred

_div10 :: Integral i => i -> i
_div10 :: forall i. Integral i => i -> i
_div10 = (i -> i -> i
forall a. Integral a => a -> a -> a
`div` i
forall i. Integral i => i
_ten)

_rem10 :: Integral i => i -> i
_rem10 :: forall i. Integral i => i -> i
_rem10 = (i -> i -> i
forall a. Integral a => a -> a -> a
`rem` i
forall i. Integral i => i
_ten)

_ten :: Integral i => i
_ten :: forall i. Integral i => i
_ten = i
10

_hundred :: Integral i => i
_hundred :: forall i. Integral i => i
_hundred = i
100

_thousand :: Integral i => i
_thousand :: forall i. Integral i => i
_thousand = i
1000

_million :: Integral i => i
_million :: forall i. Integral i => i
_million = i
1000000

_billion :: Integral i => i
_billion :: forall i. Integral i => i
_billion = i
1000000000

_trillion :: Integral i => i
_trillion :: forall i. Integral i => i
_trillion = i
1000000000000

_iLogFloor :: (Integral i, Integral j) => i -> i -> (i, j, i)
_iLogFloor :: forall i j. (Integral i, Integral j) => i -> i -> (i, j, i)
_iLogFloor i
b i
m = i -> (i, j, i)
forall {b}. Num b => i -> (i, b, i)
go i
b
  where
    go :: i -> (i, b, i)
go i
i
      | i
m i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
i = (i
m, b
0, i
1)
      | i
q i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
i = (i
q, b
2 b -> b -> b
forall a. Num a => a -> a -> a
* b
e, i
j)
      | Bool
otherwise = (i -> i -> i
forall a. Integral a => a -> a -> a
div i
q i
i, b
2 b -> b -> b
forall a. Num a => a -> a -> a
* b
e b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, i
j i -> i -> i
forall a. Num a => a -> a -> a
* i
i)
      where
        ~(i
q, b
e, i
j) = i -> (i, b, i)
go (i
i i -> i -> i
forall a. Num a => a -> a -> a
* i
i)

_iLog :: (Integral i, Integral j) => i -> i -> Maybe j
_iLog :: forall i j. (Integral i, Integral j) => i -> i -> Maybe j
_iLog i
b i
m = (i, j) -> j
forall a b. (a, b) -> b
snd ((i, j) -> j) -> Maybe (i, j) -> Maybe j
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> Maybe (i, j)
forall {b}. Num b => i -> Maybe (i, b)
go i
b
  where
    go :: i -> Maybe (i, b)
go i
i
      | i
m i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
i = (i, b) -> Maybe (i, b)
forall a. a -> Maybe a
Just (i
m, b
0)
      | Just (i
q, b
e) <- i -> Maybe (i, b)
go (i
i i -> i -> i
forall a. Num a => a -> a -> a
* i
i) = i -> i -> b -> Maybe (i, b)
forall {a} {b}. (Integral a, Num b) => a -> a -> b -> Maybe (a, b)
go' i
i i
q b
e
      | Bool
otherwise = Maybe (i, b)
forall a. Maybe a
Nothing
    go' :: a -> a -> b -> Maybe (a, b)
go' a
i a
q b
e
      | a
q a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
i = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
q, b
2 b -> b -> b
forall a. Num a => a -> a -> a
* b
e)
      | a
md a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
d, b
2 b -> b -> b
forall a. Num a => a -> a -> a
* b
e b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
      | Bool
otherwise = Maybe (a, b)
forall a. Maybe a
Nothing
      where
        (a
d, a
md) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
q a
i

_replaceSuffix :: Int -> Text -> Text -> Text
_replaceSuffix :: Int -> Text -> Text -> Text
_replaceSuffix Int
n Text
s = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
dropEnd Int
n

_showIntegral :: Integral i => i -> String -> String
_showIntegral :: forall i. Integral i => i -> String -> String
_showIntegral i
n String
s
  | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0 = Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: Integer -> String -> String
forall i. Integral i => i -> String -> String
_showPositive (-(i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n :: Integer)) String
s
  | Bool
otherwise = i -> String -> String
forall i. Integral i => i -> String -> String
_showPositive i
n String
s

_showPositive :: Integral i => i -> String -> String
_showPositive :: forall i. Integral i => i -> String -> String
_showPositive i
n String
s
  | i
q i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
0 = String
tl
  | Bool
otherwise = i -> String -> String
forall i. Integral i => i -> String -> String
_showPositive i
q String
tl
  where
    (i
q, i
r) = i -> i -> (i, i)
forall a. Integral a => a -> a -> (a, a)
quotRem i
n i
10
    tl :: String
tl = Int -> Char
intToDigit (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
r) Char -> String -> String
forall a. a -> [a] -> [a]
: String
s

_genText :: Gen Text
_genText :: Gen Text
_genText = String -> Text
pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf Gen Char
forall a. Arbitrary a => Gen a
arbitrary

_shrinkText :: Text -> [Text]
_shrinkText :: Text -> [Text]
_shrinkText = ([Text] -> [Text] -> [Text])
-> (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall a b c.
(a -> b -> c) -> (Text -> a) -> (Text -> b) -> Text -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Text -> Text -> Text) -> [Text] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)) Text -> [Text]
inits (Text -> [Text]
tails (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1)