module ASCII.Decimal
    (
    {- * Read/show for numeric strings -}
    {- ** Natural -} showNatural, readNatural,
    {- ** Integer -} showInteger, readInteger,
    {- ** Integral -} showIntegral, readIntegral,

    {- * The digit type -} Digit (..),

    {- * Decimal digit superset classes -}
    {- ** Of digit -} DigitSuperset (..),
    {- ** Of digit lists -} DigitStringSuperset (..),

    {- * Character/number conversions -}
    {- ** Natural -} naturalDigitMaybe, digitNatural,
    {- ** Integer -} integerDigitMaybe, digitInteger

    ) where

import qualified ASCII.Char as ASCII
import qualified ASCII.Refinement
import ASCII.Refinement (ASCII, asciiUnsafe)
import ASCII.Superset (StringSuperset, fromChar, fromCharList, toCharListMaybe,
                       toCharMaybe)

import Control.Monad ((<=<), (=<<))
import Data.Bifoldable (bifoldMap)
import Data.Bits (Bits, toIntegralSized)
import Data.Bool (Bool, (&&), (||))
import Data.Data (Data)
import Data.Eq (Eq)
import Data.Function (id, (.))
import Data.Functor (fmap)
import Data.Hashable (Hashable)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Maybe (Maybe (..), fromJust, isJust)
import Data.Monoid (mempty)
import Data.Ord (Ord (..))
import Data.Word (Word8)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import Prelude (Bounded (..), Enum (..), Integer, Integral, abs, fromEnum,
                fromInteger, fromIntegral, negate, quotRem, toEnum, toInteger,
                (*), (+), (-))
import Text.Show (Show)

import qualified Data.Bool as Bool
import qualified Data.Char as Unicode
import qualified Data.List as List

import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as LBS

import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as TB

import DList (DList)
import qualified DList

{- |

The subset of ASCII used to represent unsigned decimal numbers:

* 'ASCII.Char.Digit0' to 'ASCII.Char.Digit9'

-}
data Digit
    = Digit0  -- ^ Zero
    | Digit1  -- ^ One
    | Digit2  -- ^ Two
    | Digit3  -- ^ Three
    | Digit4  -- ^ Four
    | Digit5  -- ^ Five
    | Digit6  -- ^ Six
    | Digit7  -- ^ Seven
    | Digit8  -- ^ Eight
    | Digit9  -- ^ Nine
    deriving stock (Digit
forall a. a -> a -> Bounded a
maxBound :: Digit
$cmaxBound :: Digit
minBound :: Digit
$cminBound :: Digit
Bounded, Int -> Digit
Digit -> Int
Digit -> [Digit]
Digit -> Digit
Digit -> Digit -> [Digit]
Digit -> Digit -> Digit -> [Digit]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Digit -> Digit -> Digit -> [Digit]
$cenumFromThenTo :: Digit -> Digit -> Digit -> [Digit]
enumFromTo :: Digit -> Digit -> [Digit]
$cenumFromTo :: Digit -> Digit -> [Digit]
enumFromThen :: Digit -> Digit -> [Digit]
$cenumFromThen :: Digit -> Digit -> [Digit]
enumFrom :: Digit -> [Digit]
$cenumFrom :: Digit -> [Digit]
fromEnum :: Digit -> Int
$cfromEnum :: Digit -> Int
toEnum :: Int -> Digit
$ctoEnum :: Int -> Digit
pred :: Digit -> Digit
$cpred :: Digit -> Digit
succ :: Digit -> Digit
$csucc :: Digit -> Digit
Enum, Digit -> Digit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Digit -> Digit -> Bool
$c/= :: Digit -> Digit -> Bool
== :: Digit -> Digit -> Bool
$c== :: Digit -> Digit -> Bool
Eq, Eq Digit
Digit -> Digit -> Bool
Digit -> Digit -> Ordering
Digit -> Digit -> Digit
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 :: Digit -> Digit -> Digit
$cmin :: Digit -> Digit -> Digit
max :: Digit -> Digit -> Digit
$cmax :: Digit -> Digit -> Digit
>= :: Digit -> Digit -> Bool
$c>= :: Digit -> Digit -> Bool
> :: Digit -> Digit -> Bool
$c> :: Digit -> Digit -> Bool
<= :: Digit -> Digit -> Bool
$c<= :: Digit -> Digit -> Bool
< :: Digit -> Digit -> Bool
$c< :: Digit -> Digit -> Bool
compare :: Digit -> Digit -> Ordering
$ccompare :: Digit -> Digit -> Ordering
Ord, Int -> Digit -> ShowS
[Digit] -> ShowS
Digit -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Digit] -> ShowS
$cshowList :: [Digit] -> ShowS
show :: Digit -> [Char]
$cshow :: Digit -> [Char]
showsPrec :: Int -> Digit -> ShowS
$cshowsPrec :: Int -> Digit -> ShowS
Show, Typeable Digit
Digit -> DataType
Digit -> Constr
(forall b. Data b => b -> b) -> Digit -> Digit
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) -> Digit -> u
forall u. (forall d. Data d => d -> u) -> Digit -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Digit -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Digit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Digit -> m Digit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Digit -> m Digit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Digit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Digit -> c Digit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Digit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Digit)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Digit -> m Digit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Digit -> m Digit
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Digit -> m Digit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Digit -> m Digit
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Digit -> m Digit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Digit -> m Digit
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Digit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Digit -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Digit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Digit -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Digit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Digit -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Digit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Digit -> r
gmapT :: (forall b. Data b => b -> b) -> Digit -> Digit
$cgmapT :: (forall b. Data b => b -> b) -> Digit -> Digit
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Digit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Digit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Digit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Digit)
dataTypeOf :: Digit -> DataType
$cdataTypeOf :: Digit -> DataType
toConstr :: Digit -> Constr
$ctoConstr :: Digit -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Digit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Digit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Digit -> c Digit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Digit -> c Digit
Data, forall x. Rep Digit x -> Digit
forall x. Digit -> Rep Digit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Digit x -> Digit
$cfrom :: forall x. Digit -> Rep Digit x
Generic)
    deriving anyclass Eq Digit
Int -> Digit -> Int
Digit -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Digit -> Int
$chash :: Digit -> Int
hashWithSalt :: Int -> Digit -> Int
$chashWithSalt :: Int -> Digit -> Int
Hashable


---  Show functions  ---

{- |

Examples:

* @showNatural 0@ = @"0"@
* @showNatural 268@ = @"268"@

-}
showNatural :: DigitStringSuperset string => Natural -> string
showNatural :: forall string. DigitStringSuperset string => Natural -> string
showNatural =
    \case
        Natural
0 -> forall string. DigitStringSuperset string => [Digit] -> string
fromDigitList [ Digit
Digit0 ]
        Natural
n -> forall string. DigitStringSuperset string => [Digit] -> string
fromDigitList (Natural -> [Digit]
naturalList Natural
n)
  where
    naturalList :: Natural -> [Digit]
    naturalList :: Natural -> [Digit]
naturalList = forall a. DList a -> [a]
DList.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> DList Digit
r
      where
        r :: Natural -> DList Digit
        r :: Natural -> DList Digit
r = \case
            Natural
0 -> forall a. Monoid a => a
mempty
            Natural
n ->
                forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap
                    Natural -> DList Digit
r
                    (forall a. a -> DList a
DList.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                    (forall a. Integral a => a -> a -> (a, a)
quotRem Natural
n Natural
10)

{- |

Examples:

* @showInteger 0@ = @"0"@
* @showInteger 12@ = @"12"@
* @showInteger (negate 12)@ = @"-12"@

-}
showInteger :: StringSuperset string => Integer -> string
showInteger :: forall string. StringSuperset string => Integer -> string
showInteger = forall string. FromString string => [Char] -> string
fromCharList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
integerList
  where
    integerList :: Integer -> [ASCII.Char]
    integerList :: Integer -> [Char]
integerList =
        \case
            Integer
0           ->  [ Char
ASCII.Digit0 ]
            Integer
n | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0   ->  Char
ASCII.HyphenMinus forall a. a -> [a] -> [a]
: Integer -> [Char]
nonNegativeIntegerList (forall a. Num a => a -> a
abs Integer
n)
            Integer
n           ->  Integer -> [Char]
nonNegativeIntegerList Integer
n

    nonNegativeIntegerList :: Integer -> [ASCII.Char]
    nonNegativeIntegerList :: Integer -> [Char]
nonNegativeIntegerList = forall a. DList a -> [a]
DList.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DList Char
r
      where
        r :: Integer -> DList ASCII.Char
        r :: Integer -> DList Char
r = \case
            Integer
0 -> forall a. Monoid a => a
mempty
            Integer
n ->
                forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap
                    Integer -> DList Char
r
                    (forall a. a -> DList a
DList.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. DigitSuperset char => Digit -> char
fromDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger)
                    (forall a. Integral a => a -> a -> (a, a)
quotRem Integer
n Integer
10)

showIntegral :: (Integral n, StringSuperset string) => n -> string
showIntegral :: forall n string. (Integral n, StringSuperset string) => n -> string
showIntegral = forall string. StringSuperset string => Integer -> string
showInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger


---  Read functions  ---

{- |

Examples:

* @readNatural "0"@ = @Just 0@
* @readNatural "268"@ = @Just 268@
* @readNatural "0004"@ = @Just 4@
* @readNatural ""@ = @Nothing@
* @readNatural "-4"@ = @Nothing@
* @readNatural "12345678901234567890"@ = @Just 12345678901234567890@

-}
readNatural :: DigitStringSuperset string => string -> Maybe Natural
readNatural :: forall string.
DigitStringSuperset string =>
string -> Maybe Natural
readNatural = (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Digit -> Natural
readNaturalDigits) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall string.
DigitStringSuperset string =>
string -> Maybe [Digit]
toDigitListMaybe
  where
    readNaturalDigits :: NonEmpty Digit -> Natural
    readNaturalDigits :: NonEmpty Digit -> Natural
readNaturalDigits = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Natural
total Digit
x -> (Natural
10 forall a. Num a => a -> a -> a
* Natural
total) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Digit
x)) Natural
0

{- |

Examples:

* @readInteger "0"@ = @Just 0@
* @readInteger "268"@ = @Just 268@
* @readInteger "0004"@ = @Just 4@
* @readInteger ""@ = @Nothing@
* @readInteger "-4"@ = @Just (-4)@
* @readInteger "12345678901234567890"@ = @Just 12345678901234567890@

-}
readInteger :: StringSuperset string => string -> Maybe Integer
readInteger :: forall string. StringSuperset string => string -> Maybe Integer
readInteger = [Char] -> Maybe Integer
readIntegerCharList forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall string. ToString string => string -> Maybe [Char]
toCharListMaybe
  where
    readIntegerCharList :: [ASCII.Char] -> Maybe Integer
    readIntegerCharList :: [Char] -> Maybe Integer
readIntegerCharList =
        \case
            Char
ASCII.HyphenMinus : [Char]
xs  ->  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate ([Char] -> Maybe Integer
readNonNegative [Char]
xs)
            [Char]
xs                      ->  [Char] -> Maybe Integer
readNonNegative [Char]
xs

    readNonNegative :: [ASCII.Char] -> Maybe Integer
    readNonNegative :: [Char] -> Maybe Integer
readNonNegative = (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Digit -> Integer
readIntegerDigits) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall string.
DigitStringSuperset string =>
string -> Maybe [Digit]
toDigitListMaybe

    readIntegerDigits :: NonEmpty Digit -> Integer
    readIntegerDigits :: NonEmpty Digit -> Integer
readIntegerDigits = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Integer
total Digit
x -> (Integer
10 forall a. Num a => a -> a -> a
* Integer
total) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Digit
x)) Integer
0

{- |

Examples:

* @readIntegral "0"@ = @Just (0 :: Word8)@
* @readIntegral "175"@ = @Just (175 :: Word8)@
* @readIntegral "268"@ = @(Nothing :: Maybe Word8)@
* @readIntegral "0004"@ = @Just (4 :: Word8)@
* @readIntegral ""@ = @(Nothing :: Maybe Word8)@
* @readIntegral "-4"@ = @(Nothing :: Maybe Word8)@
* @readIntegral "12345678901234567890"@ = @(Nothing :: Maybe Word8)@

-}
readIntegral :: (StringSuperset string, Integral num, Bits num) => string -> Maybe num
readIntegral :: forall string num.
(StringSuperset string, Integral num, Bits num) =>
string -> Maybe num
readIntegral = forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall string. StringSuperset string => string -> Maybe Integer
readInteger


---  Uninteresting monomorphic specializations of polymorphic functions  ---

{- |

Examples:

* @naturalDigitMaybe 5@ = @Just Digit5@
* @naturalDigitMaybe 12@ = @Nothing@

-}
naturalDigitMaybe :: Natural -> Maybe Digit
naturalDigitMaybe :: Natural -> Maybe Digit
naturalDigitMaybe Natural
n = if Natural
n forall a. Ord a => a -> a -> Bool
> Natural
9 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n))

{- |

Examples:

* @integerDigitMaybe 5@ = @Just Digit5@
* @integerDigitMaybe 12@ = @Nothing@

-}
integerDigitMaybe :: Integer -> Maybe Digit
integerDigitMaybe :: Integer -> Maybe Digit
integerDigitMaybe Integer
n = if (Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
n forall a. Ord a => a -> a -> Bool
> Integer
9) then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a. Enum a => Int -> a
toEnum (forall a. Num a => Integer -> a
fromInteger Integer
n))

digitNatural :: Digit -> Natural
digitNatural :: Digit -> Natural
digitNatural = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

digitInteger :: Digit -> Integer
digitInteger :: Digit -> Integer
digitInteger = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum


---  Classes  ---

class DigitSuperset char
  where

    fromDigit :: Digit -> char

    isDigit :: char -> Bool
    isDigit = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. DigitSuperset char => char -> Maybe Digit
toDigitMaybe

    toDigitUnsafe :: char -> Digit
    toDigitUnsafe = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. DigitSuperset char => char -> Maybe Digit
toDigitMaybe

    toDigitMaybe :: char -> Maybe Digit
    toDigitMaybe char
x = if forall char. DigitSuperset char => char -> Bool
isDigit char
x then forall a. a -> Maybe a
Just (forall char. DigitSuperset char => char -> Digit
toDigitUnsafe char
x) else forall a. Maybe a
Nothing

    {-# minimal fromDigit, ((isDigit, toDigitUnsafe) | toDigitMaybe) #-}

class DigitStringSuperset string
  where

    fromDigitList :: [Digit] -> string

    isDigitString :: string -> Bool
    isDigitString = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string.
DigitStringSuperset string =>
string -> Maybe [Digit]
toDigitListMaybe

    toDigitListUnsafe :: string -> [Digit]
    toDigitListUnsafe = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string.
DigitStringSuperset string =>
string -> Maybe [Digit]
toDigitListMaybe

    toDigitListMaybe :: string -> Maybe [Digit]
    toDigitListMaybe string
x = if forall string. DigitStringSuperset string => string -> Bool
isDigitString string
x then forall a. a -> Maybe a
Just (forall string. DigitStringSuperset string => string -> [Digit]
toDigitListUnsafe string
x) else forall a. Maybe a
Nothing

    {-# minimal fromDigitList, ((isDigitString, toDigitListUnsafe) | toDigitListMaybe) #-}


---  DigitSuperset instances  ---

instance DigitSuperset Digit
  where
    isDigit :: Digit -> Bool
isDigit Digit
_ = Bool
Bool.True
    fromDigit :: Digit -> Digit
fromDigit = forall a. a -> a
id
    toDigitUnsafe :: Digit -> Digit
toDigitUnsafe = forall a. a -> a
id
    toDigitMaybe :: Digit -> Maybe Digit
toDigitMaybe = forall a. a -> Maybe a
Just

instance DigitSuperset ASCII.Char
  where
    isDigit :: Char -> Bool
isDigit Char
x = Char
x forall a. Ord a => a -> a -> Bool
>= Char
ASCII.Digit0 Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
ASCII.Digit9
    fromDigit :: Digit -> Char
fromDigit     = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> Int
x forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum Char
ASCII.Digit0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
    toDigitUnsafe :: Char -> Digit
toDigitUnsafe = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> Int
x forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
ASCII.Digit0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

instance DigitSuperset Unicode.Char
  where
    isDigit :: Char -> Bool
isDigit Char
x = Char
x forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
'9'
    fromDigit :: Digit -> Char
fromDigit     = Int -> Char
Unicode.chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> Int
x forall a. Num a => a -> a -> a
+ Char -> Int
Unicode.ord Char
'0') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
    toDigitUnsafe :: Char -> Digit
toDigitUnsafe = forall a. Enum a => Int -> a
toEnum      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> Int
x forall a. Num a => a -> a -> a
- Char -> Int
Unicode.ord Char
'0') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Unicode.ord

instance DigitSuperset Word8
  where
    fromDigit :: Digit -> Word8
fromDigit Digit
x = forall char. FromChar char => Char -> char
fromChar (forall char. DigitSuperset char => Digit -> char
fromDigit Digit
x :: ASCII.Char)
    toDigitMaybe :: Word8 -> Maybe Digit
toDigitMaybe Word8
w = forall char. DigitSuperset char => char -> Maybe Digit
toDigitMaybe forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall char. ToChar char => char -> Maybe Char
toCharMaybe Word8
w :: Maybe ASCII.Char)

instance DigitSuperset char => DigitSuperset (ASCII char)
  where
    isDigit :: ASCII char -> Bool
isDigit = forall char. DigitSuperset char => char -> Bool
isDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
ASCII.Refinement.lift
    fromDigit :: Digit -> ASCII char
fromDigit = forall superset. superset -> ASCII superset
asciiUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. DigitSuperset char => Digit -> char
fromDigit
    toDigitUnsafe :: ASCII char -> Digit
toDigitUnsafe = forall char. DigitSuperset char => char -> Digit
toDigitUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
ASCII.Refinement.lift
    toDigitMaybe :: ASCII char -> Maybe Digit
toDigitMaybe = forall char. DigitSuperset char => char -> Maybe Digit
toDigitMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
ASCII.Refinement.lift


---  DigitStringSuperset instances  ---

instance DigitStringSuperset [Digit]
  where
    isDigitString :: [Digit] -> Bool
isDigitString [Digit]
_ = Bool
Bool.True
    fromDigitList :: [Digit] -> [Digit]
fromDigitList = forall a. a -> a
id
    toDigitListUnsafe :: [Digit] -> [Digit]
toDigitListUnsafe = forall a. a -> a
id
    toDigitListMaybe :: [Digit] -> Maybe [Digit]
toDigitListMaybe = forall a. a -> Maybe a
Just

instance DigitStringSuperset [ASCII.Char]
  where
    isDigitString :: [Char] -> Bool
isDigitString = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all forall char. DigitSuperset char => char -> Bool
isDigit
    fromDigitList :: [Digit] -> [Char]
fromDigitList = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => Digit -> char
fromDigit
    toDigitListUnsafe :: [Char] -> [Digit]
toDigitListUnsafe = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => char -> Digit
toDigitUnsafe

instance DigitStringSuperset [Unicode.Char]
  where
    isDigitString :: [Char] -> Bool
isDigitString = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all forall char. DigitSuperset char => char -> Bool
isDigit
    fromDigitList :: [Digit] -> [Char]
fromDigitList = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => Digit -> char
fromDigit
    toDigitListUnsafe :: [Char] -> [Digit]
toDigitListUnsafe = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => char -> Digit
toDigitUnsafe

instance DigitStringSuperset T.Text
  where
    isDigitString :: Text -> Bool
isDigitString = (Char -> Bool) -> Text -> Bool
T.all forall char. DigitSuperset char => char -> Bool
isDigit
    fromDigitList :: [Digit] -> Text
fromDigitList = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => Digit -> char
fromDigit
    toDigitListUnsafe :: Text -> [Digit]
toDigitListUnsafe = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => char -> Digit
toDigitUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

instance DigitStringSuperset LT.Text
  where
    isDigitString :: Text -> Bool
isDigitString = (Char -> Bool) -> Text -> Bool
LT.all forall char. DigitSuperset char => char -> Bool
isDigit
    fromDigitList :: [Digit] -> Text
fromDigitList = [Char] -> Text
LT.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => Digit -> char
fromDigit
    toDigitListUnsafe :: Text -> [Digit]
toDigitListUnsafe = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => char -> Digit
toDigitUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
LT.unpack

instance DigitStringSuperset TB.Builder
  where
    fromDigitList :: [Digit] -> Builder
fromDigitList = Text -> Builder
TB.fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. DigitStringSuperset string => [Digit] -> string
fromDigitList
    toDigitListMaybe :: Builder -> Maybe [Digit]
toDigitListMaybe = forall string.
DigitStringSuperset string =>
string -> Maybe [Digit]
toDigitListMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText

instance DigitStringSuperset BS.ByteString
  where
    isDigitString :: ByteString -> Bool
isDigitString = (Word8 -> Bool) -> ByteString -> Bool
BS.all forall char. DigitSuperset char => char -> Bool
isDigit
    fromDigitList :: [Digit] -> ByteString
fromDigitList = [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => Digit -> char
fromDigit
    toDigitListUnsafe :: ByteString -> [Digit]
toDigitListUnsafe = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => char -> Digit
toDigitUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack

instance DigitStringSuperset LBS.ByteString
  where
    isDigitString :: ByteString -> Bool
isDigitString = (Word8 -> Bool) -> ByteString -> Bool
LBS.all forall char. DigitSuperset char => char -> Bool
isDigit
    fromDigitList :: [Digit] -> ByteString
fromDigitList = [Word8] -> ByteString
LBS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => Digit -> char
fromDigit
    toDigitListUnsafe :: ByteString -> [Digit]
toDigitListUnsafe = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. DigitSuperset char => char -> Digit
toDigitUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
LBS.unpack

instance DigitStringSuperset BSB.Builder
  where
    fromDigitList :: [Digit] -> Builder
fromDigitList = ByteString -> Builder
BSB.lazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. DigitStringSuperset string => [Digit] -> string
fromDigitList
    toDigitListMaybe :: Builder -> Maybe [Digit]
toDigitListMaybe = forall string.
DigitStringSuperset string =>
string -> Maybe [Digit]
toDigitListMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString

instance DigitStringSuperset char => DigitStringSuperset (ASCII char)
  where
    isDigitString :: ASCII char -> Bool
isDigitString = forall string. DigitStringSuperset string => string -> Bool
isDigitString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
ASCII.Refinement.lift
    fromDigitList :: [Digit] -> ASCII char
fromDigitList = forall superset. superset -> ASCII superset
asciiUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. DigitStringSuperset string => [Digit] -> string
fromDigitList
    toDigitListUnsafe :: ASCII char -> [Digit]
toDigitListUnsafe = forall string. DigitStringSuperset string => string -> [Digit]
toDigitListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
ASCII.Refinement.lift
    toDigitListMaybe :: ASCII char -> Maybe [Digit]
toDigitListMaybe = forall string.
DigitStringSuperset string =>
string -> Maybe [Digit]
toDigitListMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
ASCII.Refinement.lift