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 :: Prism' (NonEmpty DecDigit) Natural
_NaturalDigits :: Prism' (NonEmpty DecDigit) Natural
_NaturalDigits = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Natural -> NonEmpty DecDigit
naturalToDigits NonEmpty DecDigit -> Maybe Natural
digitsToNatural
naturalToDigits :: Natural -> NonEmpty DecDigit
naturalToDigits :: Natural -> NonEmpty DecDigit
naturalToDigits Natural
n =
case Scientific -> ([Int], Int)
toDecimalDigits forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n of
([], Int
_ ) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Scientific.toDecimalDigits is no longer correct!"
(Int
x:[Int]
xs, Int
eXP) -> forall {a} {t}.
(Eq a, Num a, D0 t, D1 t, D2 t, D3 t, D4 t, D5 t, D6 t, D7 t, D8 t,
D9 t) =>
a -> t
g Int
x forall a. a -> [a] -> NonEmpty a
:| (forall {a} {t}.
(Eq a, Num a, D0 t, D1 t, D2 t, D3 t, D4 t, D5 t, D6 t, D7 t, D8 t,
D9 t) =>
a -> t
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
xs) forall a. Semigroup a => a -> a -> a
<> forall {t :: * -> *} {a} {a}.
(Foldable t, D0 a) =>
t a -> Int -> [a]
t (Int
xforall a. a -> [a] -> [a]
:[Int]
xs) Int
eXP
where
t :: t a -> Int -> [a]
t t a
allDigs Int
eXP =
forall a. Int -> a -> [a]
replicate (Int
eXP forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
allDigs) (forall d. D0 d => Prism' d ()
d0 forall t b. AReview t b -> b -> t
# ())
g :: a -> t
g a
0 = forall d. D0 d => Prism' d ()
d0 forall t b. AReview t b -> b -> t
# ()
g a
1 = forall d. D1 d => Prism' d ()
d1 forall t b. AReview t b -> b -> t
# ()
g a
2 = forall d. D2 d => Prism' d ()
d2 forall t b. AReview t b -> b -> t
# ()
g a
3 = forall d. D3 d => Prism' d ()
d3 forall t b. AReview t b -> b -> t
# ()
g a
4 = forall d. D4 d => Prism' d ()
d4 forall t b. AReview t b -> b -> t
# ()
g a
5 = forall d. D5 d => Prism' d ()
d5 forall t b. AReview t b -> b -> t
# ()
g a
6 = forall d. D6 d => Prism' d ()
d6 forall t b. AReview t b -> b -> t
# ()
g a
7 = forall d. D7 d => Prism' d ()
d7 forall t b. AReview t b -> b -> t
# ()
g a
8 = forall d. D8 d => Prism' d ()
d8 forall t b. AReview t b -> b -> t
# ()
g a
9 = forall d. D9 d => Prism' d ()
d9 forall t b. AReview t b -> b -> t
# ()
g a
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"The universe now has more than ten digits."
digitsToNatural :: NonEmpty DecDigit -> Maybe Natural
digitsToNatural :: NonEmpty DecDigit -> Maybe Natural
digitsToNatural = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = (forall a d. (Integral a, Decimal d) => Prism' a d
integralDecimal forall t b. AReview t b -> b -> t
# DecDigit
d) forall a. Num a => a -> a -> a
* (Int
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i)
in
if Int
curr forall a. Ord a => a -> a -> Bool
> forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- Int
next
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (Int
curr forall a. Num a => a -> a -> a
+ Int
next)