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 :: 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
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
([], 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
# ())
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."
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)