module Data.Digit.Natural
  ( _NaturalDigits
  , naturalToDigits
  , digitsToNatural
  ) where

import           Prelude             (Int, error, fromIntegral, maxBound, (*),
                                      (+), (-), (>), (^))

import           Control.Category    ((.))
import           Control.Lens        (Prism', ifoldrM, prism', ( # ))

import           Data.Foldable       (length)
import           Data.Function       (($))
import           Data.Functor        (fmap, (<$>))
import           Data.Semigroup      ((<>))

import           Data.List           (replicate)

import           Data.List.NonEmpty  (NonEmpty ((:|)))
import qualified Data.List.NonEmpty  as NE

import           Data.Maybe          (Maybe (..))

import           Data.Digit.Decimal
import           Data.Digit.Integral (integralDecimal)

import           Numeric.Natural     (Natural)

import           Data.Scientific     (toDecimalDigits)

-- |
--
-- >>> _NaturalDigits # 0
-- DecDigit0 :| []
--
-- >>> _NaturalDigits # 1
-- DecDigit1 :| []
--
-- >>> _NaturalDigits # 922
-- DecDigit9 :| [DecDigit2,DecDigit2]
--
-- >>> (DecDigit9 :| [DecDigit2,DecDigit2]) ^? _NaturalDigits
-- Just 922
--
-- >>> (DecDigit1 :| []) ^? _NaturalDigits
-- Just 1
--
-- prop> \x -> digitsToNatural ( naturalToDigits x ) == Just x
--
_NaturalDigits :: Prism' (NonEmpty DecDigit) Natural
_NaturalDigits :: p Natural (f Natural)
-> p (NonEmpty DecDigit) (f (NonEmpty DecDigit))
_NaturalDigits = (Natural -> NonEmpty DecDigit)
-> (NonEmpty DecDigit -> Maybe Natural)
-> Prism (NonEmpty DecDigit) (NonEmpty DecDigit) Natural Natural
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Natural -> NonEmpty DecDigit
naturalToDigits NonEmpty DecDigit -> Maybe Natural
digitsToNatural

-- |
--
-- >>> naturalDigits 0
-- DecDigit0 :| []
--
-- >>> naturalDigits 9
-- DecDigit9 :| []
--
-- >>> naturalDigits 393
-- DecDigit3 :| [DecDigit9,DecDigit3]
--
naturalToDigits :: Natural -> NonEmpty DecDigit
naturalToDigits :: Natural -> NonEmpty DecDigit
naturalToDigits Natural
n =
  case Scientific -> ([Int], Int)
toDecimalDigits (Scientific -> ([Int], Int)) -> Scientific -> ([Int], Int)
forall a b. (a -> b) -> a -> b
$ Natural -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n of
    -- toDecimalDigits :: n -> ([n],n)
    -- toDecimalDigits 0    = ([0],0)
    -- toDecimalDigits (-0) = ([0],0)
    -- toDecimalDigits (-1) = ([-1],1)
    ([],   Int
_  ) -> [Char] -> NonEmpty DecDigit
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Scientific.toDecimalDigits is no longer correct!"
    (Int
x:[Int]
xs, Int
eXP) -> Int -> DecDigit
forall a p.
(Eq a, Num a, D0 p, D1 p, D2 p, D3 p, D4 p, D5 p, D6 p, D7 p, D8 p,
 D9 p) =>
a -> p
g Int
x DecDigit -> [DecDigit] -> NonEmpty DecDigit
forall a. a -> [a] -> NonEmpty a
:| (Int -> DecDigit
forall a p.
(Eq a, Num a, D0 p, D1 p, D2 p, D3 p, D4 p, D5 p, D6 p, D7 p, D8 p,
 D9 p) =>
a -> p
g (Int -> DecDigit) -> [Int] -> [DecDigit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
xs) [DecDigit] -> [DecDigit] -> [DecDigit]
forall a. Semigroup a => a -> a -> a
<> [Int] -> Int -> [DecDigit]
forall (t :: * -> *) a a. (Foldable t, D0 a) => t a -> Int -> [a]
t (Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs) Int
eXP

  where
    t :: t a -> Int -> [a]
t t a
allDigs Int
eXP =
      Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
eXP Int -> Int -> Int
forall a. Num a => a -> a -> a
- t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
allDigs) (Tagged () (Identity ()) -> Tagged a (Identity a)
forall d. D0 d => Prism' d ()
d0 (Tagged () (Identity ()) -> Tagged a (Identity a)) -> () -> a
forall t b. AReview t b -> b -> t
# ())

    -- EWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW!
    -- But you can't reach this point unless you have a non-zero absolute integral value. So... I dunno.
    g :: a -> p
g a
0 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D0 d => Prism' d ()
d0 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
1 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D1 d => Prism' d ()
d1 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
2 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D2 d => Prism' d ()
d2 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
3 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D3 d => Prism' d ()
d3 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
4 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D4 d => Prism' d ()
d4 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
5 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D5 d => Prism' d ()
d5 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
6 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D6 d => Prism' d ()
d6 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
7 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D7 d => Prism' d ()
d7 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
8 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D8 d => Prism' d ()
d8 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
9 = Tagged () (Identity ()) -> Tagged p (Identity p)
forall d. D9 d => Prism' d ()
d9 (Tagged () (Identity ()) -> Tagged p (Identity p)) -> () -> p
forall t b. AReview t b -> b -> t
# ()
    g a
_ = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"The universe now has more than ten digits."

-- | Create a number from a list of digits with the integer bounds of the machine.
--
-- >>> digitsToNatural (DecDigit3 :| [DecDigit4])
-- Just 34
--
-- >>> digitsToNatural (DecDigit0 :| [])
-- Just 0
--
-- >>> digitsToNatural (naturalToDigits (maxBound :: Natural))
-- Just 9223372036854775807
--
-- >>> digitsToNatural (naturalToDigits $ (maxBound :: Natural) + 1)
-- Nothing
digitsToNatural :: NonEmpty DecDigit -> Maybe Natural
digitsToNatural :: NonEmpty DecDigit -> Maybe Natural
digitsToNatural = (Int -> Natural) -> Maybe Int -> Maybe Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Int -> Maybe Natural)
-> (NonEmpty DecDigit -> Maybe Int)
-> NonEmpty DecDigit
-> Maybe Natural
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> DecDigit -> Int -> Maybe Int)
-> Int -> NonEmpty DecDigit -> Maybe Int
forall i (f :: * -> *) (m :: * -> *) a b.
(FoldableWithIndex i f, Monad m) =>
(i -> a -> b -> m b) -> b -> f a -> m b
ifoldrM Int -> DecDigit -> Int -> Maybe Int
f Int
0 (NonEmpty DecDigit -> Maybe Int)
-> (NonEmpty DecDigit -> NonEmpty DecDigit)
-> NonEmpty DecDigit
-> Maybe Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty DecDigit -> NonEmpty DecDigit
forall a. NonEmpty a -> NonEmpty a
NE.reverse
  where
    f :: Int -> DecDigit -> Int -> Maybe Int
    f :: Int -> DecDigit -> Int -> Maybe Int
f Int
i DecDigit
d Int
curr =
      let
        next :: Int
next = (Tagged DecDigit (Identity DecDigit) -> Tagged Int (Identity Int)
forall a d. (Integral a, Decimal d) => Prism' a d
integralDecimal (Tagged DecDigit (Identity DecDigit) -> Tagged Int (Identity Int))
-> DecDigit -> Int
forall t b. AReview t b -> b -> t
# DecDigit
d) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
10 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i)
      in
        if Int
curr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
next
        then Maybe Int
forall a. Maybe a
Nothing
        else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
curr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
next)