{-# LANGUAGE CPP, 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, singleton, tails, pack)
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 :: 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' :: 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 = 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: i
_ten = i
10

_hundred :: Integral i => i
_hundred :: i
_hundred = i
100

_thousand :: Integral i => i
_thousand :: i
_thousand = i
1000

_million :: Integral i => i
_million :: i
_million = i
1000000

_billion :: Integral i => i
_billion :: i
_billion = i
1000000000

_trillion :: Integral i => i
_trillion :: i
_trillion = i
1000000000000

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

_iLog :: (Integral i, Integral j) => i -> i -> Maybe j
_iLog :: 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
ii -> i -> i
forall a. Num a => a -> a -> a
*i
i) = i -> i -> b -> Maybe (i, b)
forall a b. (Num b, Integral a) => 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 :: 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 :: 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 (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)