{-# language Safe #-}

-- | Functions to test whether values of various
-- types represent digits in the range /0/ to /9/.
module D10.Predicate where

import Numeric.Natural (Natural)

-- | Determines whether a 'Char' is in the range @'0'@ to @'9'@.
isD10Char :: Char -> Bool
isD10Char :: Char -> Bool
isD10Char Char
x = Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'

-- | Determines whether a 'String' consists of a single character
-- and that character is within the range @'0'@ to @'9'@.
isD10Str :: String -> Bool
isD10Str :: String -> Bool
isD10Str [Char
x] = Char -> Bool
isD10Char Char
x
isD10Str String
_   = Bool
False

-- | Determines whether a 'String' consists entirely of characters
-- that are within the range @'0'@ to @'9'@.
isD10ListStr :: String -> Bool
isD10ListStr :: String -> Bool
isD10ListStr = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isD10Char

-- | Determines whether a 'Natural' is in the range 0 to 9.
isD10Nat :: Natural -> Bool
isD10Nat :: Natural -> Bool
isD10Nat Natural
x = Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
9

-- | Determines whether an 'Integer' is in the range 0 to 9.
isD10Integer :: Integer -> Bool
isD10Integer :: Integer -> Bool
isD10Integer Integer
x = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
9

-- | Determines whether an 'Int' is in the range 0 to 9.
isD10Int :: Int -> Bool
isD10Int :: Int -> Bool
isD10Int Int
x = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9

-- | Determines whether a number whose type has an 'Integral'
-- instance is in the range 0 to 9.
isD10Integral :: Integral a => a -> Bool
isD10Integral :: a -> Bool
isD10Integral a
x = Integer -> Bool
isD10Integer (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x)