module Data.Ascii.Word8 where

-- base
import Data.Word (Word8)
import qualified Data.Char as C

fromChar :: Char -> Maybe Word8
fromChar :: Char -> Maybe Word8
fromChar Char
c = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
128 then Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) else Maybe Word8
forall a. Maybe a
Nothing
  where i :: Int
i = Char -> Int
C.ord Char
c

toChar :: Word8 -> Char
toChar :: Word8 -> Char
toChar = Int -> Char
C.chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Unsafe version of 'fromChar'
ascii :: Char -> Word8
ascii :: Char -> Word8
ascii = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
C.ord
{-# INLINE ascii #-}

isAscii :: Word8 -> Bool
isAscii :: Word8 -> Bool
isAscii = (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128)

isControl :: Word8 -> Bool
isControl :: Word8 -> Bool
isControl Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
32 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
127

isPrintable :: Word8 -> Bool
isPrintable :: Word8 -> Bool
isPrintable Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
32 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
127

isWhiteSpace :: Word8 -> Bool
isWhiteSpace :: Word8 -> Bool
isWhiteSpace Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
ascii Char
' ' Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
9 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
13

isSpaceOrTab :: Word8 -> Bool
isSpaceOrTab :: Word8 -> Bool
isSpaceOrTab Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
ascii Char
' ' Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
ascii Char
'\t'

isLower :: Word8 -> Bool
isLower :: Word8 -> Bool
isLower Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
ascii Char
'a' Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
ascii Char
'z'

isUpper :: Word8 -> Bool
isUpper :: Word8 -> Bool
isUpper Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
ascii Char
'A' Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
ascii Char
'Z'

toLower :: Word8 -> Word8
toLower :: Word8 -> Word8
toLower Word8
w | Word8 -> Bool
isUpper Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32
          | Bool
otherwise = Word8
w

toUpper :: Word8 -> Word8
toUpper :: Word8 -> Word8
toUpper Word8
w | Word8 -> Bool
isLower Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
32
          | Bool
otherwise = Word8
w

isAlpha :: Word8 -> Bool
isAlpha :: Word8 -> Bool
isAlpha Word8
w = Word8 -> Bool
isUpper Word8
w Bool -> Bool -> Bool
|| Word8 -> Bool
isLower Word8
w

isDigit :: Word8 -> Bool
isDigit :: Word8 -> Bool
isDigit Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
ascii Char
'0' Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
ascii Char
'9'

isAlphaNum :: Word8 -> Bool
isAlphaNum :: Word8 -> Bool
isAlphaNum Word8
w = Word8 -> Bool
isDigit Word8
w Bool -> Bool -> Bool
|| Word8 -> Bool
isAlpha Word8
w

fromDigit :: Num a => Word8 -> Maybe a
fromDigit :: Word8 -> Maybe a
fromDigit Word8
w | Word8 -> Bool
isDigit Word8
w = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a. Num a => Word8 -> a
unsafeFromDigit Word8
w
            | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
{-# INLINABLE fromDigit #-}

unsafeFromDigit :: Num a => Word8 -> a
unsafeFromDigit :: Word8 -> a
unsafeFromDigit Word8
w = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Char -> Word8
ascii Char
'0')
{-# INLINE unsafeFromDigit #-}

isOctDigit :: Word8 -> Bool
isOctDigit :: Word8 -> Bool
isOctDigit Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
ascii Char
'0' Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
ascii Char
'7'

fromOctDigit :: Num a => Word8 -> Maybe a
fromOctDigit :: Word8 -> Maybe a
fromOctDigit Word8
w | Word8 -> Bool
isOctDigit Word8
w = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a. Num a => Word8 -> a
unsafeFromOctDigit Word8
w
               | Bool
otherwise    = Maybe a
forall a. Maybe a
Nothing
{-# INLINABLE fromOctDigit #-}

unsafeFromOctDigit :: Num a => Word8 -> a
unsafeFromOctDigit :: Word8 -> a
unsafeFromOctDigit = Word8 -> a
forall a. Num a => Word8 -> a
unsafeFromDigit
{-# INLINE unsafeFromOctDigit #-}

isLowAF :: Word8 -> Bool
isLowAF :: Word8 -> Bool
isLowAF Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
ascii Char
'a' Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
ascii Char
'f'
{-# INLINE isLowAF #-}

fromLowAF :: Num a => Word8 -> a
fromLowAF :: Word8 -> a
fromLowAF Word8
w = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Char -> Word8
ascii Char
'a' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
10)
{-# INLINE fromLowAF #-}

isLowHexDigit :: Word8 -> Bool
isLowHexDigit :: Word8 -> Bool
isLowHexDigit Word8
w = Word8 -> Bool
isDigit Word8
w Bool -> Bool -> Bool
|| Word8 -> Bool
isLowAF Word8
w

fromLowHexDigit :: Num a => Word8 -> Maybe a
fromLowHexDigit :: Word8 -> Maybe a
fromLowHexDigit Word8
w | Word8 -> Bool
isDigit Word8
w = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a. Num a => Word8 -> a
unsafeFromDigit Word8
w
                  | Word8 -> Bool
isLowAF Word8
w = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a. Num a => Word8 -> a
fromLowAF Word8
w
                  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
{-# INLINABLE fromLowHexDigit #-}

unsafeFromLowHexDigit :: Num a => Word8 -> a
unsafeFromLowHexDigit :: Word8 -> a
unsafeFromLowHexDigit Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Word8
ascii Char
'a' = Word8 -> a
forall a. Num a => Word8 -> a
unsafeFromDigit Word8
w
                        | Bool
otherwise     = Word8 -> a
forall a. Num a => Word8 -> a
fromLowAF Word8
w
{-# INLINE unsafeFromLowHexDigit #-}

isUpAF :: Word8 -> Bool
isUpAF :: Word8 -> Bool
isUpAF Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
ascii Char
'A' Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
ascii Char
'F'
{-# INLINE isUpAF #-}

fromUpAF :: Num a => Word8 -> a
fromUpAF :: Word8 -> a
fromUpAF Word8
w = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Char -> Word8
ascii Char
'A' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
10)
{-# INLINE fromUpAF #-}

isUpHexDigit :: Word8 -> Bool
isUpHexDigit :: Word8 -> Bool
isUpHexDigit Word8
w = Word8 -> Bool
isDigit Word8
w Bool -> Bool -> Bool
|| Word8 -> Bool
isUpAF Word8
w

fromUpHexDigit :: Num a => Word8 -> Maybe a
fromUpHexDigit :: Word8 -> Maybe a
fromUpHexDigit Word8
w | Word8 -> Bool
isDigit Word8
w = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a. Num a => Word8 -> a
unsafeFromDigit Word8
w
                 | Word8 -> Bool
isUpAF Word8
w  = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a. Num a => Word8 -> a
fromUpAF Word8
w
                 | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
{-# INLINABLE fromUpHexDigit #-}

unsafeFromUpHexDigit :: Num a => Word8 -> a
unsafeFromUpHexDigit :: Word8 -> a
unsafeFromUpHexDigit Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Word8
ascii Char
'A' = Word8 -> a
forall a. Num a => Word8 -> a
unsafeFromDigit Word8
w
                       | Bool
otherwise     = Word8 -> a
forall a. Num a => Word8 -> a
fromUpAF Word8
w
{-# INLINE unsafeFromUpHexDigit #-}

isHexDigit :: Word8 -> Bool
isHexDigit :: Word8 -> Bool
isHexDigit Word8
w = Word8 -> Bool
isDigit Word8
w Bool -> Bool -> Bool
|| Word8 -> Bool
isUpAF Word8
w Bool -> Bool -> Bool
|| Word8 -> Bool
isLowAF Word8
w

fromHexDigit :: Num a => Word8 -> Maybe a
fromHexDigit :: Word8 -> Maybe a
fromHexDigit Word8
w | Word8 -> Bool
isDigit Word8
w = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a. Num a => Word8 -> a
unsafeFromDigit Word8
w
               | Word8 -> Bool
isUpAF Word8
w  = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a. Num a => Word8 -> a
fromUpAF Word8
w
               | Word8 -> Bool
isLowAF Word8
w = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a. Num a => Word8 -> a
fromLowAF Word8
w
               | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
{-# INLINABLE fromHexDigit #-}

unsafeFromHexDigit :: Num a => Word8 -> a
unsafeFromHexDigit :: Word8 -> a
unsafeFromHexDigit Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Word8
ascii Char
'A' = Word8 -> a
forall a. Num a => Word8 -> a
unsafeFromDigit Word8
w
                     | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Word8
ascii Char
'a' = Word8 -> a
forall a. Num a => Word8 -> a
fromUpAF Word8
w
                     | Bool
otherwise     = Word8 -> a
forall a. Num a => Word8 -> a
fromLowAF Word8
w
{-# INLINE unsafeFromHexDigit #-}