{-| Naturals represented via ASCII numerals.

A concept which sees occasional use in places where neither speed nor size
efficiency matter.

The tar file format uses it, apparently to sidestep making a decision on byte
ordering. Though digits are encoded "big-endian", so, uh. I don't get it.

I don't really see the usage of these. It seems silly and inefficient, aimed
solely at easing debugging.
-}

{-# LANGUAGE AllowAmbiguousTypes #-}

module Binrep.Type.AsciiNat where

import Binrep
import Binrep.Util ( natVal'' )

import Data.Word ( Word8 )
import Data.List.NonEmpty ( NonEmpty( (:|) ) )
import Mason.Builder qualified as Mason
import Data.ByteString qualified as B
import Data.Semigroup ( sconcat )

import GHC.TypeNats ( Natural, KnownNat )
import GHC.Num.Natural ( naturalSizeInBase#, naturalToWord# )

import GHC.Generics ( Generic )
import Data.Data ( Data )
import Numeric ( showOct, showHex, showBin, showInt )

import FlatParse.Basic qualified as FP

-- | A 'Natural' represented in binary as an ASCII string, where each character
--   a is a digit in the given base (> 1).
--
-- 'Show' instances display the stored number in the given base. If the base has
-- a common prefix (e.g. @0x@ for hex), it is used.
newtype AsciiNat (base :: Natural) = AsciiNat { forall (base :: Natural). AsciiNat base -> Natural
getAsciiNat :: Natural }
    deriving stock ((forall x. AsciiNat base -> Rep (AsciiNat base) x)
-> (forall x. Rep (AsciiNat base) x -> AsciiNat base)
-> Generic (AsciiNat base)
forall (base :: Natural) x. Rep (AsciiNat base) x -> AsciiNat base
forall (base :: Natural) x. AsciiNat base -> Rep (AsciiNat base) x
forall x. Rep (AsciiNat base) x -> AsciiNat base
forall x. AsciiNat base -> Rep (AsciiNat base) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (base :: Natural) x. Rep (AsciiNat base) x -> AsciiNat base
$cfrom :: forall (base :: Natural) x. AsciiNat base -> Rep (AsciiNat base) x
Generic, Typeable (AsciiNat base)
Typeable (AsciiNat base)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AsciiNat base -> c (AsciiNat base))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (AsciiNat base))
-> (AsciiNat base -> Constr)
-> (AsciiNat base -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (AsciiNat base)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (AsciiNat base)))
-> ((forall b. Data b => b -> b) -> AsciiNat base -> AsciiNat base)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r)
-> (forall u. (forall d. Data d => d -> u) -> AsciiNat base -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AsciiNat base -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AsciiNat base -> m (AsciiNat base))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AsciiNat base -> m (AsciiNat base))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AsciiNat base -> m (AsciiNat base))
-> Data (AsciiNat base)
AsciiNat base -> DataType
AsciiNat base -> Constr
(forall b. Data b => b -> b) -> AsciiNat base -> AsciiNat base
forall {base :: Natural}. KnownNat base => Typeable (AsciiNat base)
forall (base :: Natural).
KnownNat base =>
AsciiNat base -> DataType
forall (base :: Natural). KnownNat base => AsciiNat base -> Constr
forall (base :: Natural).
KnownNat base =>
(forall b. Data b => b -> b) -> AsciiNat base -> AsciiNat base
forall (base :: Natural) u.
KnownNat base =>
Int -> (forall d. Data d => d -> u) -> AsciiNat base -> u
forall (base :: Natural) u.
KnownNat base =>
(forall d. Data d => d -> u) -> AsciiNat base -> [u]
forall (base :: Natural) r r'.
KnownNat base =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r
forall (base :: Natural) r r'.
KnownNat base =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r
forall (base :: Natural) (m :: * -> *).
(KnownNat base, Monad m) =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
forall (base :: Natural) (m :: * -> *).
(KnownNat base, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
forall (base :: Natural) (c :: * -> *).
KnownNat base =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AsciiNat base)
forall (base :: Natural) (c :: * -> *).
KnownNat base =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AsciiNat base -> c (AsciiNat base)
forall (base :: Natural) (t :: * -> *) (c :: * -> *).
(KnownNat base, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (AsciiNat base))
forall (base :: Natural) (t :: * -> * -> *) (c :: * -> *).
(KnownNat base, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AsciiNat base))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AsciiNat base -> u
forall u. (forall d. Data d => d -> u) -> AsciiNat base -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AsciiNat base)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AsciiNat base -> c (AsciiNat base)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (AsciiNat base))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AsciiNat base))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
$cgmapMo :: forall (base :: Natural) (m :: * -> *).
(KnownNat base, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
$cgmapMp :: forall (base :: Natural) (m :: * -> *).
(KnownNat base, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
$cgmapM :: forall (base :: Natural) (m :: * -> *).
(KnownNat base, Monad m) =>
(forall d. Data d => d -> m d)
-> AsciiNat base -> m (AsciiNat base)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AsciiNat base -> u
$cgmapQi :: forall (base :: Natural) u.
KnownNat base =>
Int -> (forall d. Data d => d -> u) -> AsciiNat base -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AsciiNat base -> [u]
$cgmapQ :: forall (base :: Natural) u.
KnownNat base =>
(forall d. Data d => d -> u) -> AsciiNat base -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r
$cgmapQr :: forall (base :: Natural) r r'.
KnownNat base =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r
$cgmapQl :: forall (base :: Natural) r r'.
KnownNat base =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AsciiNat base -> r
gmapT :: (forall b. Data b => b -> b) -> AsciiNat base -> AsciiNat base
$cgmapT :: forall (base :: Natural).
KnownNat base =>
(forall b. Data b => b -> b) -> AsciiNat base -> AsciiNat base
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AsciiNat base))
$cdataCast2 :: forall (base :: Natural) (t :: * -> * -> *) (c :: * -> *).
(KnownNat base, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AsciiNat base))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (AsciiNat base))
$cdataCast1 :: forall (base :: Natural) (t :: * -> *) (c :: * -> *).
(KnownNat base, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (AsciiNat base))
dataTypeOf :: AsciiNat base -> DataType
$cdataTypeOf :: forall (base :: Natural).
KnownNat base =>
AsciiNat base -> DataType
toConstr :: AsciiNat base -> Constr
$ctoConstr :: forall (base :: Natural). KnownNat base => AsciiNat base -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AsciiNat base)
$cgunfold :: forall (base :: Natural) (c :: * -> *).
KnownNat base =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AsciiNat base)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AsciiNat base -> c (AsciiNat base)
$cgfoldl :: forall (base :: Natural) (c :: * -> *).
KnownNat base =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AsciiNat base -> c (AsciiNat base)
Data)
    deriving (AsciiNat base -> AsciiNat base -> Bool
(AsciiNat base -> AsciiNat base -> Bool)
-> (AsciiNat base -> AsciiNat base -> Bool) -> Eq (AsciiNat base)
forall (base :: Natural). AsciiNat base -> AsciiNat base -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsciiNat base -> AsciiNat base -> Bool
$c/= :: forall (base :: Natural). AsciiNat base -> AsciiNat base -> Bool
== :: AsciiNat base -> AsciiNat base -> Bool
$c== :: forall (base :: Natural). AsciiNat base -> AsciiNat base -> Bool
Eq, Eq (AsciiNat base)
Eq (AsciiNat base)
-> (AsciiNat base -> AsciiNat base -> Ordering)
-> (AsciiNat base -> AsciiNat base -> Bool)
-> (AsciiNat base -> AsciiNat base -> Bool)
-> (AsciiNat base -> AsciiNat base -> Bool)
-> (AsciiNat base -> AsciiNat base -> Bool)
-> (AsciiNat base -> AsciiNat base -> AsciiNat base)
-> (AsciiNat base -> AsciiNat base -> AsciiNat base)
-> Ord (AsciiNat base)
AsciiNat base -> AsciiNat base -> Bool
AsciiNat base -> AsciiNat base -> Ordering
AsciiNat base -> AsciiNat base -> AsciiNat base
forall (base :: Natural). Eq (AsciiNat base)
forall (base :: Natural). AsciiNat base -> AsciiNat base -> Bool
forall (base :: Natural).
AsciiNat base -> AsciiNat base -> Ordering
forall (base :: Natural).
AsciiNat base -> AsciiNat base -> AsciiNat base
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AsciiNat base -> AsciiNat base -> AsciiNat base
$cmin :: forall (base :: Natural).
AsciiNat base -> AsciiNat base -> AsciiNat base
max :: AsciiNat base -> AsciiNat base -> AsciiNat base
$cmax :: forall (base :: Natural).
AsciiNat base -> AsciiNat base -> AsciiNat base
>= :: AsciiNat base -> AsciiNat base -> Bool
$c>= :: forall (base :: Natural). AsciiNat base -> AsciiNat base -> Bool
> :: AsciiNat base -> AsciiNat base -> Bool
$c> :: forall (base :: Natural). AsciiNat base -> AsciiNat base -> Bool
<= :: AsciiNat base -> AsciiNat base -> Bool
$c<= :: forall (base :: Natural). AsciiNat base -> AsciiNat base -> Bool
< :: AsciiNat base -> AsciiNat base -> Bool
$c< :: forall (base :: Natural). AsciiNat base -> AsciiNat base -> Bool
compare :: AsciiNat base -> AsciiNat base -> Ordering
$ccompare :: forall (base :: Natural).
AsciiNat base -> AsciiNat base -> Ordering
Ord) via Natural

instance Show (AsciiNat 2)  where showsPrec :: Int -> AsciiNat 2 -> ShowS
showsPrec Int
_ AsciiNat 2
n = String -> ShowS
showString String
"0b" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showBin (AsciiNat 2 -> Natural
forall (base :: Natural). AsciiNat base -> Natural
getAsciiNat AsciiNat 2
n)
instance Show (AsciiNat 8)  where showsPrec :: Int -> AsciiNat 8 -> ShowS
showsPrec Int
_ AsciiNat 8
n = String -> ShowS
showString String
"0o" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showOct (AsciiNat 8 -> Natural
forall (base :: Natural). AsciiNat base -> Natural
getAsciiNat AsciiNat 8
n)
instance Show (AsciiNat 10) where showsPrec :: Int -> AsciiNat 10 -> ShowS
showsPrec Int
_ AsciiNat 10
n = Natural -> ShowS
forall a. Integral a => a -> ShowS
showInt (AsciiNat 10 -> Natural
forall (base :: Natural). AsciiNat base -> Natural
getAsciiNat AsciiNat 10
n)
instance Show (AsciiNat 16) where showsPrec :: Int -> AsciiNat 16 -> ShowS
showsPrec Int
_ AsciiNat 16
n = String -> ShowS
showString String
"0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (AsciiNat 16 -> Natural
forall (base :: Natural). AsciiNat base -> Natural
getAsciiNat AsciiNat 16
n)

-- | Compare two 'AsciiNat's with arbitrary bases.
asciiNatCompare :: AsciiNat b1 -> AsciiNat b2 -> Ordering
asciiNatCompare :: forall (b1 :: Natural) (b2 :: Natural).
AsciiNat b1 -> AsciiNat b2 -> Ordering
asciiNatCompare (AsciiNat Natural
n1) (AsciiNat Natural
n2) = Natural -> Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Natural
n1 Natural
n2

-- | The bytelength of an 'AsciiNat' is the number of digits in the number in
--   the given base. We can calculate this generically with great efficiency
--   using GHC primitives.
instance KnownNat base => BLen (AsciiNat base) where
    blen :: AsciiNat base -> Int
blen (AsciiNat Natural
n) = Word# -> Int
forall a. AsBLen a => Word# -> a
wordToBLen# (Word# -> Natural -> Word#
naturalSizeInBase# (Natural -> Word#
naturalToWord# Natural
base) Natural
n)
      where base :: Natural
base = forall (a :: Natural). KnownNat a => Natural
natVal'' @base

--------------------------------------------------------------------------------

instance Put (AsciiNat 8) where
    put :: AsciiNat 8 -> Builder
put = (Word8 -> Word8) -> Natural -> Natural -> Builder
natToAsciiBytes (Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
0x30) Natural
8 (Natural -> Builder)
-> (AsciiNat 8 -> Natural) -> AsciiNat 8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsciiNat 8 -> Natural
forall (base :: Natural). AsciiNat base -> Natural
getAsciiNat

instance Get (AsciiNat 8) where
    get :: Getter (AsciiNat 8)
get = do
        ByteString
bs <- Getter ByteString
forall a. Get a => Getter a
get
        case (Word8 -> Maybe Word8)
-> Natural -> ByteString -> Either Word8 Natural
asciiBytesToNat Word8 -> Maybe Word8
octalFromAsciiDigit Natural
8 ByteString
bs of
          Left Word8
bs' -> String -> Getter (AsciiNat 8)
forall e a. e -> Parser e a
FP.err (String -> Getter (AsciiNat 8)) -> String -> Getter (AsciiNat 8)
forall a b. (a -> b) -> a -> b
$ String
"TODO " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
bs'
          Right Natural
n  -> AsciiNat 8 -> Getter (AsciiNat 8)
forall (m :: * -> *) a. Monad m => a -> m a
return (AsciiNat 8 -> Getter (AsciiNat 8))
-> AsciiNat 8 -> Getter (AsciiNat 8)
forall a b. (a -> b) -> a -> b
$ Natural -> AsciiNat 8
forall (base :: Natural). Natural -> AsciiNat base
AsciiNat Natural
n

octalFromAsciiDigit :: Word8 -> Maybe Word8
octalFromAsciiDigit :: Word8 -> Maybe Word8
octalFromAsciiDigit = \case
  Word8
0x30 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
0
  Word8
0x31 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
1
  Word8
0x32 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
2
  Word8
0x33 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
3
  Word8
0x34 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
4
  Word8
0x35 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
5
  Word8
0x36 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
6
  Word8
0x37 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
7
  Word8
_    -> Maybe Word8
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------

natToAsciiBytes :: (Word8 -> Word8) -> Natural -> Natural -> Builder
natToAsciiBytes :: (Word8 -> Word8) -> Natural -> Natural -> Builder
natToAsciiBytes Word8 -> Word8
f Natural
base =
    NonEmpty Builder -> Builder
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty Builder -> Builder)
-> (Natural -> NonEmpty Builder) -> Natural -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Builder) -> NonEmpty Word8 -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word8
w -> Word8 -> Builder
Mason.word8 Word8
w) (NonEmpty Word8 -> NonEmpty Builder)
-> (Natural -> NonEmpty Word8) -> Natural -> NonEmpty Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> NonEmpty Word8 -> NonEmpty Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Word8
f (NonEmpty Word8 -> NonEmpty Word8)
-> (Natural -> NonEmpty Word8) -> Natural -> NonEmpty Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b
digits @Word8 Natural
base

asciiBytesToNat :: (Word8 -> Maybe Word8) -> Natural -> B.ByteString -> Either Word8 Natural
asciiBytesToNat :: (Word8 -> Maybe Word8)
-> Natural -> ByteString -> Either Word8 Natural
asciiBytesToNat Word8 -> Maybe Word8
f Natural
base ByteString
bs =
    case (Word8
 -> Either Word8 (Natural, Natural)
 -> Either Word8 (Natural, Natural))
-> Either Word8 (Natural, Natural)
-> ByteString
-> Either Word8 (Natural, Natural)
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr Word8
-> Either Word8 (Natural, Natural)
-> Either Word8 (Natural, Natural)
go ((Natural, Natural) -> Either Word8 (Natural, Natural)
forall a b. b -> Either a b
Right (Natural
0, Natural
0)) ByteString
bs of
      Left Word8
w -> Word8 -> Either Word8 Natural
forall a b. a -> Either a b
Left Word8
w
      Right (Natural
n, Natural
_) -> Natural -> Either Word8 Natural
forall a b. b -> Either a b
Right Natural
n
  where
    go :: Word8 -> Either Word8 (Natural, Natural) -> Either Word8 (Natural, Natural)
    go :: Word8
-> Either Word8 (Natural, Natural)
-> Either Word8 (Natural, Natural)
go Word8
_ (Left Word8
w) = Word8 -> Either Word8 (Natural, Natural)
forall a b. a -> Either a b
Left Word8
w
    go Word8
w (Right (Natural
n, Natural
expo)) =
        case Word8 -> Maybe Word8
f Word8
w of
          Maybe Word8
Nothing -> Word8 -> Either Word8 (Natural, Natural)
forall a b. a -> Either a b
Left Word8
w
          Just Word8
d  -> (Natural, Natural) -> Either Word8 (Natural, Natural)
forall a b. b -> Either a b
Right (Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
baseNatural -> Natural -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^Natural
expo, Natural
expoNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
+Natural
1)

digits :: forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b
digits :: forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b
digits a
base = [b] -> a -> NonEmpty b
go []
  where
    go :: [b] -> a -> NonEmpty b
go [b]
s a
x = NonEmpty b -> a -> NonEmpty b
loop (b
head' b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:| [b]
s) a
tail'
      where
        head' :: b
head' = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
base)
        tail' :: a
tail' = a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
base
    loop :: NonEmpty b -> a -> NonEmpty b
loop s :: NonEmpty b
s@(b
r :| [b]
rs) = \case
        a
0 -> NonEmpty b
s
        a
x -> [b] -> a -> NonEmpty b
go (b
r b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
rs) a
x