{-| The __American Standard Code for Information Interchange__ (ASCII) comprises
a set of 128 characters, each represented by 7 bits. 33 of these characters are
/'Control' codes/; a few of these are still in use, but most are obsolete relics
of the early days of computing. The other 95 are /'Printable' characters/ such
as letters and numbers, mostly corresponding to the keys on an American English
keyboard.

Nowadays instead of ASCII we typically work with text using an encoding such as
UTF-8 that can represent the entire Unicode character set, which includes over a
hundred thousand characters and is not limited to the symbols of any particular
writing system or culture. However, ASCII is still relevant to network
protocols; for example, we can see it in the specification of
<https://www.rfc-editor.org/rfc/rfc9110.html#name-syntax-notation HTTP>.

There is a convenient relationship between ASCII and Unicode: the ASCII
characters are the first 128 characters of the much larger Unicode character set.
The <https://www.unicode.org/charts/PDF/U0000.pdf C0 Controls and Basic Latin>
section of the Unicode standard contains a list of all the ASCII characters.
You may also find this list replicated in the "ASCII.Char" module; each ASCII
character corresponds to a constructor of the 'ASCII.Char' type.

We do not elaborate on the semantics of the control characters here,
because this information is both obsolete and restricted by copyright law.
It is described by a document entitled
/"Coded Character Sets - 7-Bit American National Standard Code for Information Interchange (7-Bit ASCII)"/,
published by American National Standards Institute (ANSI) and available for purchase
<https://webstore.ansi.org/Standards/INCITS/INCITS1986R2012 on their website>.
-}
module ASCII
  (
    {- * @Char@ -}

        {- ** ASCII -}
            {- $char -} Char,

        {- ** Unicode -}
            UnicodeChar,

        {- ** Case-insensitive -}
            {- $caselessChar -} CaselessChar,

    {- * Character classifications -}

        {- ** Print/control groups -}
            {- $groups -} Group (..), charGroup, inGroup,

        {- ** Upper/lower case -}
            {- $case -} Case (..), letterCase, isCase, toCaseChar, toCaseString,
            disregardCase, refineCharToCase, refineStringToCase,

        {- ** Letters -}
            isLetter,

        {- ** Letters and numbers -}
            isAlphaNum,

        {- ** Decimal digits -}
            {- $digit -} isDigit, Digit,

        {- ** Hexadecimal digits -}
            {- $hexchar -} isHexDigit, HexChar,

        {- ** Octal digits -}
            isOctDigit,

        {- ** Spaces and symbols -}
            isSpace, isPunctuation, isSymbol, isVisible,

    {- * Monomorphic character conversions -}

        {- $monomorphicConversions -}

        {- ** @ASCII.Char@ ↔ @Int@ -}
            {- $intConversions -}
            charToInt, intToCharMaybe, intToCharUnsafe,

        {- ** @ASCII.Char@ ↔ @Word8@ -}
            {- $word8Conversions -}
            charToWord8, word8ToCharMaybe, word8ToCharUnsafe,

        {- ** @ASCII.Char@ ↔ @UnicodeChar@ -}
            {- $unicodeCharConversions -}
            charToUnicode, unicodeToCharMaybe, unicodeToCharUnsafe,

    {- * Monomorphic digit conversions -}

        {- ** @Digit@ ↔ @Word8@ -}
            {- $digitWord8Conversions -}
            digitToWord8, word8ToDigitMaybe, word8ToDigitUnsafe,

        {- ** @Digit@ ↔ @ASCII.Char@ -}
            {- $digitCharConversions -}
            digitToChar, charToDigitMaybe, charToDigitUnsafe,

        {- ** @Digit@ ↔ @UnicodeChar@ -}
            {- $digitUnicodeConversions -}
            digitToUnicode, unicodeToDigitMaybe, unicodeToDigitUnsafe,

        {- ** @HexChar@ ↔ @Word8@ -}
            {- $hexCharWord8Conversions -}
            hexCharToWord8, word8ToHexCharMaybe, word8ToHexCharUnsafe,

        {- ** @HexChar@ ↔ @ASCII.Char@ -}
            {- $hexCharCharConversions -}
            hexCharToChar, charToHexCharMaybe, charToHexCharUnsafe,

        {- ** @HexChar@ ↔ @UnicodeChar@ -}
            {- $hexCharUnicodeConversions -}
            hexCharToUnicode, unicodeToHexCharMaybe, unicodeToHexCharUnsafe,

    {- * Monomorphic string conversions -}

        {- ** @ASCII.Char@ ↔ @String@ -}
            {- $unicodeStringConversions -}
            charListToUnicodeString, unicodeStringToCharListMaybe,
            unicodeStringToCharListUnsafe,

        {- ** @ASCII.Char@ ↔ @Text@ -}
            {- $textConversions -}
            charListToText, textToCharListMaybe, textToCharListUnsafe,

        {- ** @ASCII.Char@ ↔ @ByteString@ -}
            {- $byteStringConversions -}
            charListToByteString, byteStringToCharListMaybe,
            byteStringToCharListUnsafe,

        {- ** @ASCII ByteString@ -> @Text@ -}
            asciiByteStringToText, asciiByteStringToTextLazy,

    {- * Monomorphic conversions between ASCII supersets -}

        {- $monoSupersetConversions -}

        {- ** @ByteString@ ↔ @String@ -}
            byteStringToUnicodeStringMaybe, unicodeStringToByteStringMaybe,

        {- ** @[Word8]@ ↔ @String@ -}
            byteListToUnicodeStringMaybe, unicodeStringToByteListMaybe,

    {- * Monomorphic numeric string conversions -}

        {- ** @Natural@ ↔ @[Digit]@ -}
            showNaturalDigits, readNaturalDigits,

        {- ** @Natural@ ↔ @[HexChar]@ -}
            showNaturalHexChars, readNaturalHexChars,

    {- * Refinement types -}
        {- $refinement -} ASCII,
        ASCII'case, ASCII'upper, ASCII'lower, KnownCase (..),

    {- * Polymorphic conversions -}

        {- ** Narrowing -}
            toCharMaybe, toCharListMaybe, toDigitMaybe, toHexCharMaybe,

        {- ** Validate -}
            validateChar, validateString,

        {- ** Widening -}
            {- $lift -} lift,
            {- $toText -} toStrictText, toLazyText, toUnicodeCharList,
            {- $fromChar -} fromChar, fromCharList,
            {- $fromDigit -} fromDigit, fromDigitList,
            {- $fromHexChar -} fromHexChar, fromHexCharList,
            {- $forgetCase -} forgetCase,

        {- ** Convert -}
            {- $supersetConversions -}
            convertCharMaybe, convertCharOrFail, convertStringMaybe,
            convertStringOrFail, convertRefinedString,

        {- ** Integral strings -}
            {- $numbers -}
            showIntegralDecimal, showIntegralHexadecimal,
            readIntegralDecimal, readIntegralHexadecimal,

        {- ** Natural strings -}
            showNaturalDecimal, showNaturalHexadecimal,
            readNaturalDecimal, readNaturalHexadecimal,

        {- ** Single-digit strings -}
            digitString, hexCharString,

    {- * Classes -}

        {- ** Supersets of ASCII -}
            CharSuperset, StringSuperset,
            StringSupersetConversion, ToText,

        {- ** Equivalents to ASCII -}
            CharIso, StringIso,

        {- ** Supersets of numeric characters -}
            DigitSuperset, DigitStringSuperset, HexCharSuperset, HexStringSuperset,

    {- * Quasi-quoters -}
        char, string, caseless, lower, upper,
  )
  where

import ASCII.Case (Case (..))
import ASCII.CaseRefinement (KnownCase (..), ASCII'case, ASCII'upper, ASCII'lower, refineCharToCase, refineStringToCase, forgetCase)
import ASCII.Caseless (CaselessChar)
import ASCII.Char (Char)
import ASCII.Decimal (Digit, DigitStringSuperset, DigitSuperset, fromDigit, fromDigitList)
import ASCII.Group (Group (..))
import ASCII.Hexadecimal (HexChar, HexCharSuperset, HexStringSuperset, fromHexChar, fromHexCharList)
import ASCII.Isomorphism (CharIso, StringIso)
import ASCII.QuasiQuoters (char, string, caseless, lower, upper)
import ASCII.Refinement (ASCII, lift, validateChar, validateString)
import ASCII.Superset (CharSuperset, StringSuperset, toCharMaybe, toCharListMaybe, fromChar, fromCharList)
import ASCII.SupersetConversion (StringSupersetConversion)
import ASCII.Superset.Text (ToText (..))

import Control.Monad ((>=>))
import Control.Monad.Fail (MonadFail)
import Data.Bits (Bits)
import Data.Bool (Bool (..))
import Data.Foldable (any)
import Data.Function ((.))
import Data.Int (Int)
import Data.Maybe (Maybe, maybe)
import Data.Word (Word8)
import Numeric.Natural (Natural)
import Prelude (Integral)

import qualified ASCII.Case
import qualified ASCII.Caseless
import qualified ASCII.Decimal
import qualified ASCII.Group
import qualified ASCII.Hexadecimal
import qualified ASCII.Isomorphism
import qualified ASCII.Predicates
import qualified ASCII.Superset
import qualified ASCII.SupersetConversion as SupersetConversion

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Char as Unicode
import qualified Data.String as Unicode
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Encoding as LText

{- $char

See also: "ASCII.Char" -}

{- $caselessChar

See also: "ASCII.Caseless" -}

{-| A character in the full range of Unicode

ASCII 'Char' is a subset of this type. Convert using 'charToUnicode' and
'unicodeToCharMaybe'. -}
type UnicodeChar = Unicode.Char

{- $groups

ASCII characters are broadly categorized into two groups: /control codes/ and
/printable characters/.

See also: "ASCII.Group" -}

{-| Determine which group a particular character belongs to

@
charGroup CapitalLetterA == Printable

charGroup EndOfTransmission == Control
@ -}
charGroup :: CharIso char => char -> Group
charGroup :: forall char. CharIso char => char -> Group
charGroup = Char -> Group
ASCII.Group.charGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. CharIso char => char -> Char
ASCII.Isomorphism.toChar

{-| Test whether a character belongs to a particular ASCII group

@
not (inGroup Printable EndOfTransmission)

inGroup Control EndOfTransmission

map (inGroup Printable) ([-1, 5, 65, 97, 127, 130] :: [Int])
    == [False, False, True, True, False, False]
@ -}
inGroup :: CharSuperset char => Group -> char -> Bool
inGroup :: forall char. CharSuperset char => Group -> char -> Bool
inGroup Group
g = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Group -> Char -> Bool
ASCII.Group.inGroup Group
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. ToChar char => char -> Maybe Char
ASCII.Superset.toCharMaybe

{- $case

/Case/ is a property of letters. /A-Z/ are /upper case/ letters, and /a-z/ are
/lower case/ letters. No other ASCII characters have case.

See also: "ASCII.Case" -}

{-| Determines whether a character is an ASCII letter, and if so, whether it is
    upper or lower case

@
map letterCase [SmallLetterA, CapitalLetterA, ExclamationMark]
    == [Just LowerCase, Just UpperCase, Nothing]

map letterCase ([string|Hey!|] :: [ASCII Word8])
    == [Just UpperCase, Just LowerCase, Just LowerCase, Nothing]
@ -}
letterCase :: CharSuperset char => char -> Maybe Case
letterCase :: forall char. CharSuperset char => char -> Maybe Case
letterCase = forall char. ToChar char => char -> Maybe Char
ASCII.Superset.toCharMaybe forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Char -> Maybe Case
ASCII.Case.letterCase

{-| Determines whether a character is an ASCII letter of a particular case

@
map (isCase UpperCase) [SmallLetterA, CapitalLetterA, ExclamationMark]
    == [False, True, False]

map (isCase UpperCase) ([string|Hey!|] :: [ASCII Word8])
    == [True, False, False, False]

map (isCase UpperCase) ([-1, 65, 97, 150] :: [Int])
    == [False, True, False, False]
@ -}
isCase :: CharSuperset char => Case -> char -> Bool
isCase :: forall char. CharSuperset char => Case -> char -> Bool
isCase Case
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Case -> Char -> Bool
ASCII.Case.isCase Case
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. ToChar char => char -> Maybe Char
ASCII.Superset.toCharMaybe

{-| Maps a letter character to its upper/lower case equivalent

@
toCaseChar UpperCase SmallLetterA == CapitalLetterA

(                     [char|a|] :: ASCII Word8) == asciiUnsafe 97
(toCaseChar UpperCase [char|a|] :: ASCII Word8) == asciiUnsafe 65
@ -}
toCaseChar :: CharSuperset char => Case -> char -> char
toCaseChar :: forall char. CharSuperset char => Case -> char -> char
toCaseChar = forall char. CharSuperset char => Case -> char -> char
ASCII.Superset.toCaseChar

{-| Maps each of the characters in a string to its upper/lower case equivalent

@
toCaseString UpperCase [CapitalLetterH, SmallLetterE, SmallLetterY, ExclamationMark]
    == [CapitalLetterH, CapitalLetterE, CapitalLetterY, ExclamationMark]

(toCaseString UpperCase [string|Hey!|] :: ASCII Text) == asciiUnsafe "HEY!"
@ -}
toCaseString :: StringSuperset string => Case -> string -> string
toCaseString :: forall string. StringSuperset string => Case -> string -> string
toCaseString = forall string. StringSuperset string => Case -> string -> string
ASCII.Superset.toCaseString

{-| Convert from ASCII character to caseless ASCII character, discarding the
    case if the character is a letter -}
disregardCase :: Char -> CaselessChar
disregardCase :: Char -> CaselessChar
disregardCase = Char -> CaselessChar
ASCII.Caseless.disregardCase

{- $monomorphicConversions

These are a few simple monomorphic functions to convert between ASCII and types
representing some other character set.

This is not intended to be an exhaustive list of all possible conversions. For
more options, see "ASCII.Superset". -}

{- $intConversions

These functions convert between the ASCII 'Char' type and 'Int'. -}

{-|

@
map charToInt [Null, CapitalLetterA, SmallLetterA, Delete] == [0, 65, 97, 127]
@ -}
charToInt :: Char -> Int
charToInt :: Char -> Int
charToInt = forall char. FromChar char => Char -> char
ASCII.Superset.fromChar

intToCharMaybe :: Int -> Maybe Char
intToCharMaybe :: Int -> Maybe Char
intToCharMaybe = forall char. ToChar char => char -> Maybe Char
ASCII.Superset.toCharMaybe

intToCharUnsafe :: Int -> Char
intToCharUnsafe :: Int -> Char
intToCharUnsafe = forall char. ToChar char => char -> Char
ASCII.Superset.toCharUnsafe

{- $word8Conversions

These functions convert between the ASCII 'Char' type and 'Word8'. -}

{-|

@
map charToWord8 [Null, CapitalLetterA, SmallLetterA, Delete] == [0, 65, 97, 127]
@ -}
charToWord8 :: Char -> Word8
charToWord8 :: Char -> Word8
charToWord8 = forall char. FromChar char => Char -> char
ASCII.Superset.fromChar

word8ToCharMaybe :: Word8 -> Maybe Char
word8ToCharMaybe :: Word8 -> Maybe Char
word8ToCharMaybe = forall char. ToChar char => char -> Maybe Char
ASCII.Superset.toCharMaybe

word8ToCharUnsafe :: Word8 -> Char
word8ToCharUnsafe :: Word8 -> Char
word8ToCharUnsafe = forall char. ToChar char => char -> Char
ASCII.Superset.toCharUnsafe

{- $unicodeCharConversions

These functions convert between the ASCII 'Char' type and the 'UnicodeChar'
type. -}

charToUnicode :: Char -> UnicodeChar
charToUnicode :: Char -> UnicodeChar
charToUnicode = forall char. FromChar char => Char -> char
ASCII.Superset.fromChar

unicodeToCharMaybe :: UnicodeChar -> Maybe Char
unicodeToCharMaybe :: UnicodeChar -> Maybe Char
unicodeToCharMaybe = forall char. ToChar char => char -> Maybe Char
ASCII.Superset.toCharMaybe

unicodeToCharUnsafe :: UnicodeChar -> Char
unicodeToCharUnsafe :: UnicodeChar -> Char
unicodeToCharUnsafe = forall char. ToChar char => char -> Char
ASCII.Superset.toCharUnsafe

{- $digitWord8Conversions

These functions convert between the ASCII 'Digit' type and ASCII digits in their
byte encoding.

These conversions do /not/ correspond to the numeric interpretations of 'Digit'
and 'Word8'. For example, 'digitToWord8' 'ASCII.Decimal.Digit0' is 48, not 0. -}

digitToWord8 :: Digit -> Word8
digitToWord8 :: Digit -> Word8
digitToWord8 = forall char. DigitSuperset char => Digit -> char
ASCII.Decimal.fromDigit

word8ToDigitMaybe :: Word8 -> Maybe Digit
word8ToDigitMaybe :: Word8 -> Maybe Digit
word8ToDigitMaybe = forall char. DigitSuperset char => char -> Maybe Digit
ASCII.Decimal.toDigitMaybe

word8ToDigitUnsafe :: Word8 -> Digit
word8ToDigitUnsafe :: Word8 -> Digit
word8ToDigitUnsafe = forall char. DigitSuperset char => char -> Digit
ASCII.Decimal.toDigitUnsafe

{- $digitCharConversions

These functions convert between the ASCII 'Digit' type and the ASCII 'Char'
type. -}

digitToChar :: Digit -> Char
digitToChar :: Digit -> Char
digitToChar = forall char. DigitSuperset char => Digit -> char
ASCII.Decimal.fromDigit

charToDigitMaybe :: Char -> Maybe Digit
charToDigitMaybe :: Char -> Maybe Digit
charToDigitMaybe = forall char. DigitSuperset char => char -> Maybe Digit
ASCII.Decimal.toDigitMaybe

charToDigitUnsafe :: Char -> Digit
charToDigitUnsafe :: Char -> Digit
charToDigitUnsafe = forall char. DigitSuperset char => char -> Digit
ASCII.Decimal.toDigitUnsafe

{- $digitUnicodeConversions

These functions convert between the ASCII 'Digit' type and the 'UnicodeChar'
type. -}

digitToUnicode :: Digit -> UnicodeChar
digitToUnicode :: Digit -> UnicodeChar
digitToUnicode = forall char. DigitSuperset char => Digit -> char
ASCII.Decimal.fromDigit

unicodeToDigitMaybe :: UnicodeChar -> Maybe Digit
unicodeToDigitMaybe :: UnicodeChar -> Maybe Digit
unicodeToDigitMaybe = forall char. DigitSuperset char => char -> Maybe Digit
ASCII.Decimal.toDigitMaybe

unicodeToDigitUnsafe :: UnicodeChar -> Digit
unicodeToDigitUnsafe :: UnicodeChar -> Digit
unicodeToDigitUnsafe = forall char. DigitSuperset char => char -> Digit
ASCII.Decimal.toDigitUnsafe


{- $hexCharWord8Conversions

These functions convert between the ASCII 'HexChar' type and ASCII characters in
their byte encoding.

These conversions do /not/ correspond to the numeric interpretations of
'HexChar' and 'Word8'. For example, 'hexCharToWord8'
'ASCII.Hexadecimal.CapitalLetterA' is 65, not 10. -}

hexCharToWord8 :: HexChar -> Word8
hexCharToWord8 :: HexChar -> Word8
hexCharToWord8 = forall char. HexCharSuperset char => HexChar -> char
ASCII.Hexadecimal.fromHexChar

word8ToHexCharMaybe :: Word8 -> Maybe HexChar
word8ToHexCharMaybe :: Word8 -> Maybe HexChar
word8ToHexCharMaybe = forall char. HexCharSuperset char => char -> Maybe HexChar
ASCII.Hexadecimal.toHexCharMaybe

word8ToHexCharUnsafe :: Word8 -> HexChar
word8ToHexCharUnsafe :: Word8 -> HexChar
word8ToHexCharUnsafe = forall char. HexCharSuperset char => char -> HexChar
ASCII.Hexadecimal.toHexCharUnsafe

{- $hexCharCharConversions

These functions convert between the ASCII 'HexChar' type and the ASCII 'Char'
type. -}

hexCharToChar :: HexChar -> Char
hexCharToChar :: HexChar -> Char
hexCharToChar = forall char. HexCharSuperset char => HexChar -> char
ASCII.Hexadecimal.fromHexChar

charToHexCharMaybe :: Char -> Maybe HexChar
charToHexCharMaybe :: Char -> Maybe HexChar
charToHexCharMaybe = forall char. HexCharSuperset char => char -> Maybe HexChar
ASCII.Hexadecimal.toHexCharMaybe

charToHexCharUnsafe :: Char -> HexChar
charToHexCharUnsafe :: Char -> HexChar
charToHexCharUnsafe = forall char. HexCharSuperset char => char -> HexChar
ASCII.Hexadecimal.toHexCharUnsafe

{- $hexCharUnicodeConversions

These functions convert between the ASCII 'HexChar' type and the 'UnicodeChar'
type. -}

hexCharToUnicode :: HexChar -> UnicodeChar
hexCharToUnicode :: HexChar -> UnicodeChar
hexCharToUnicode = forall char. HexCharSuperset char => HexChar -> char
ASCII.Hexadecimal.fromHexChar

unicodeToHexCharMaybe :: UnicodeChar -> Maybe HexChar
unicodeToHexCharMaybe :: UnicodeChar -> Maybe HexChar
unicodeToHexCharMaybe = forall char. HexCharSuperset char => char -> Maybe HexChar
ASCII.Hexadecimal.toHexCharMaybe

unicodeToHexCharUnsafe :: UnicodeChar -> HexChar
unicodeToHexCharUnsafe :: UnicodeChar -> HexChar
unicodeToHexCharUnsafe = forall char. HexCharSuperset char => char -> HexChar
ASCII.Hexadecimal.toHexCharUnsafe

{- $unicodeStringConversions

These functions convert between @['Char']@ (a list of ASCII characters) and
'Unicode.String' (a list of Unicode characters). -}

charListToUnicodeString :: [Char] -> Unicode.String
charListToUnicodeString :: [Char] -> String
charListToUnicodeString = forall string. FromString string => [Char] -> string
ASCII.Superset.fromCharList

unicodeStringToCharListMaybe :: Unicode.String -> Maybe [Char]
unicodeStringToCharListMaybe :: String -> Maybe [Char]
unicodeStringToCharListMaybe = forall string. ToString string => string -> Maybe [Char]
ASCII.Superset.toCharListMaybe

unicodeStringToCharListUnsafe :: Unicode.String -> [Char]
unicodeStringToCharListUnsafe :: String -> [Char]
unicodeStringToCharListUnsafe = forall string. ToString string => string -> [Char]
ASCII.Superset.toCharListUnsafe

{- $textConversions

These functions convert between @['Char']@ and 'Text.Text'. -}

{-|

@
charListToText [CapitalLetterH, SmallLetterI, ExclamationMark] == "Hi!"
@ -}
charListToText :: [Char] -> Text.Text
charListToText :: [Char] -> Text
charListToText = forall string. FromString string => [Char] -> string
ASCII.Superset.fromCharList

textToCharListMaybe :: Text.Text -> Maybe [Char]
textToCharListMaybe :: Text -> Maybe [Char]
textToCharListMaybe = forall string. ToString string => string -> Maybe [Char]
ASCII.Superset.toCharListMaybe

textToCharListUnsafe :: Text.Text -> [Char]
textToCharListUnsafe :: Text -> [Char]
textToCharListUnsafe = forall string. ToString string => string -> [Char]
ASCII.Superset.toCharListUnsafe

{- $byteStringConversions

These functions convert between @['Char']@ and 'BS.ByteString'. -}

charListToByteString :: [Char] -> BS.ByteString
charListToByteString :: [Char] -> ByteString
charListToByteString = forall string. FromString string => [Char] -> string
ASCII.Superset.fromCharList

byteStringToCharListMaybe :: BS.ByteString -> Maybe [Char]
byteStringToCharListMaybe :: ByteString -> Maybe [Char]
byteStringToCharListMaybe = forall string. ToString string => string -> Maybe [Char]
ASCII.Superset.toCharListMaybe

byteStringToCharListUnsafe :: BS.ByteString -> [Char]
byteStringToCharListUnsafe :: ByteString -> [Char]
byteStringToCharListUnsafe = forall string. ToString string => string -> [Char]
ASCII.Superset.toCharListUnsafe

asciiByteStringToText :: ASCII BS.ByteString -> Text.Text
asciiByteStringToText :: ASCII ByteString -> Text
asciiByteStringToText = ByteString -> Text
Text.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
ASCII.Refinement.lift

asciiByteStringToTextLazy :: ASCII LBS.ByteString -> LText.Text
asciiByteStringToTextLazy :: ASCII ByteString -> Text
asciiByteStringToTextLazy = ByteString -> Text
LText.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
ASCII.Refinement.lift

{- $refinement

See also: "ASCII.Refinement", "ASCII.CaseRefinement" -}

{- $lift

See also: "ASCII.Refinement" -}

{- $toText

See also: "ASCII.Superset.ToText" -}

{- $fromChar

See also: "ASCII.Superset" -}

{- $fromDigit

See also: "ASCII.Decimal" -}

{- $fromHexChar

See also: "ASCII.Hexadecimal" -}

{- $forgetCase

See also: "ASCII.CaseRefinement" -}

{- $supersetConversions

These functions all convert from one ASCII-superset type to another, failing if
any of the characters in the input is outside the ASCII character set. -}

convertCharMaybe :: (CharSuperset char1, CharSuperset char2) => char1 -> Maybe char2
convertCharMaybe :: forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe = forall char1 char2.
(ToChar char1, FromChar char2) =>
char1 -> Maybe char2
ASCII.Superset.convertCharMaybe

convertCharOrFail :: (CharSuperset char1, CharSuperset char2, MonadFail context) => char1 -> context char2
convertCharOrFail :: forall char1 char2 (context :: * -> *).
(CharSuperset char1, CharSuperset char2, MonadFail context) =>
char1 -> context char2
convertCharOrFail = forall char1 char2 (context :: * -> *).
(ToChar char1, FromChar char2, MonadFail context) =>
char1 -> context char2
ASCII.Superset.convertCharOrFail

convertStringMaybe :: (StringSuperset string1, StringSuperset string2) => string1 -> Maybe string2
convertStringMaybe :: forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
convertStringMaybe = forall string1 string2.
(ToString string1, FromString string2) =>
string1 -> Maybe string2
ASCII.Superset.convertStringMaybe

convertStringOrFail :: (StringSuperset string1, StringSuperset string2, MonadFail context) => string1 -> context string2
convertStringOrFail :: forall string1 string2 (context :: * -> *).
(StringSuperset string1, StringSuperset string2,
 MonadFail context) =>
string1 -> context string2
convertStringOrFail = forall string1 string2 (context :: * -> *).
(ToString string1, FromString string2, MonadFail context) =>
string1 -> context string2
ASCII.Superset.convertStringOrFail

{- $monoSupersetConversions

These functions are all specializations of 'convertStringMaybe'.
They convert a string from one ASCII-superset type to another.

@
ASCII.byteListToUnicodeStringMaybe [0x48, 0x54, 0x54, 0x50] == Just "HTTP"
@

If any of the characters in the input is outside the ASCII character set, the
result is 'Nothing'.

@
ASCII.byteListToUnicodeStringMaybe [0x48, 0x54, 0x54, 0x80] == Nothing
@ -}
byteStringToUnicodeStringMaybe :: BS.ByteString -> Maybe Unicode.String
byteStringToUnicodeStringMaybe :: ByteString -> Maybe String
byteStringToUnicodeStringMaybe = forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
convertStringMaybe

unicodeStringToByteStringMaybe :: Unicode.String -> Maybe BS.ByteString
unicodeStringToByteStringMaybe :: String -> Maybe ByteString
unicodeStringToByteStringMaybe = forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
convertStringMaybe

byteListToUnicodeStringMaybe :: [Word8] -> Maybe Unicode.String
byteListToUnicodeStringMaybe :: [Word8] -> Maybe String
byteListToUnicodeStringMaybe = forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
convertStringMaybe

unicodeStringToByteListMaybe :: Unicode.String -> Maybe [Word8]
unicodeStringToByteListMaybe :: String -> Maybe [Word8]
unicodeStringToByteListMaybe = forall string1 string2.
(StringSuperset string1, StringSuperset string2) =>
string1 -> Maybe string2
convertStringMaybe

{-| Returns True for ASCII letters:

- 'ASCII.Char.SmallLetterA' to 'ASCII.Char.SmallLetterZ'
- 'ASCII.Char.CapitalLetterA' to 'ASCII.Char.CapitalLetterZ' -}
isLetter :: CharSuperset char => char -> Bool
isLetter :: forall char. CharSuperset char => char -> Bool
isLetter char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isLetter (forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{-| Returns True for the characters from 'ASCII.Char.Digit0' to
'ASCII.Char.Digit9'. -}
isDigit :: CharSuperset char => char -> Bool
isDigit :: forall char. CharSuperset char => char -> Bool
isDigit char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isDigit (forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{-| Returns True for the characters from 'ASCII.Char.Digit0' to
'ASCII.Char.Digit7'. -}
isOctDigit :: CharSuperset char => char -> Bool
isOctDigit :: forall char. CharSuperset char => char -> Bool
isOctDigit char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isOctDigit (forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{-| Returns True for characters in any of the following ranges:

- 'ASCII.Char.Digit0' to 'ASCII.Char.Digit9'
- 'ASCII.Char.CapitalLetterA' to 'ASCII.Char.CapitalLetterF'
- 'ASCII.Char.SmallLetterA' to 'ASCII.Char.SmallLetterF' -}
isHexDigit :: CharSuperset char => char -> Bool
isHexDigit :: forall char. CharSuperset char => char -> Bool
isHexDigit char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isHexDigit (forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{-| Returns True for the following characters:

- 'ASCII.Char.Space'
- 'ASCII.Char.HorizontalTab'
- 'ASCII.Char.LineFeed'
- 'ASCII.Char.VerticalTab'
- 'ASCII.Char.FormFeed'
- 'ASCII.Char.CarriageReturn' -}
isSpace :: CharSuperset char => char -> Bool
isSpace :: forall char. CharSuperset char => char -> Bool
isSpace char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isSpace (forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{-| Returns True if the character is either an ASCII letter ('isLetter') or an
ASCII digit ('isDigit'). -}
isAlphaNum :: CharSuperset char => char -> Bool
isAlphaNum :: forall char. CharSuperset char => char -> Bool
isAlphaNum char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isAlphaNum (forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{-| Returns True for the following characters:

- 'ASCII.Char.ExclamationMark'
- 'ASCII.Char.QuotationMark'
- 'ASCII.Char.NumberSign'
- 'ASCII.Char.PercentSign'
- 'ASCII.Char.Ampersand'
- 'ASCII.Char.Apostrophe'
- 'ASCII.Char.LeftParenthesis'
- 'ASCII.Char.RightParenthesis'
- 'ASCII.Char.Asterisk'
- 'ASCII.Char.Comma'
- 'ASCII.Char.HyphenMinus'
- 'ASCII.Char.FullStop'
- 'ASCII.Char.Slash'
- 'ASCII.Char.Colon'
- 'ASCII.Char.Semicolon'
- 'ASCII.Char.QuestionMark'
- 'ASCII.Char.AtSign'
- 'ASCII.Char.LeftSquareBracket'
- 'ASCII.Char.Backslash'
- 'ASCII.Char.RightSquareBracket'
- 'ASCII.Char.Underscore'
- 'ASCII.Char.LeftCurlyBracket'
- 'ASCII.Char.RightCurlyBracket' -}
isPunctuation :: CharSuperset char => char -> Bool
isPunctuation :: forall char. CharSuperset char => char -> Bool
isPunctuation char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isPunctuation (forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{-| Returns True for the following characters:

- 'ASCII.Char.DollarSign'
- 'ASCII.Char.PlusSign'
- 'ASCII.Char.LessThanSign'
- 'ASCII.Char.EqualsSign'
- 'ASCII.Char.GreaterThanSign'
- 'ASCII.Char.Caret'
- 'ASCII.Char.GraveAccent'
- 'ASCII.Char.VerticalLine'
- 'ASCII.Char.Tilde' -}
isSymbol :: CharSuperset char => char -> Bool
isSymbol :: forall char. CharSuperset char => char -> Bool
isSymbol char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isSymbol (forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{- |Returns True for visible characters

This includes all print characters except 'ASCII.Char.Space'. -}
isVisible :: CharSuperset char => char -> Bool
isVisible :: forall char. CharSuperset char => char -> Bool
isVisible char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
ASCII.Predicates.isVisible (forall char1 char2.
(CharSuperset char1, CharSuperset char2) =>
char1 -> Maybe char2
convertCharMaybe char
x)

{- $numbers

See also: "ASCII.Decimal" and "ASCII.Hexadecimal" -}

{-| Gives the ASCII string representation of an integer in decimal (base 10)
    notation, using digits 'ASCII.Char.Digit0' through 'ASCII.Char.Digit9',
    leading with 'ASCII.Char.HyphenMinus' for negative numbers

For example, @'showIntegralDecimal' (-512 :: 'Prelude.Integer')@ = @"-512"@. -}
showIntegralDecimal :: (Integral n, StringSuperset string) => n -> string
showIntegralDecimal :: forall n string. (Integral n, StringSuperset string) => n -> string
showIntegralDecimal = forall n string. (Integral n, StringSuperset string) => n -> string
ASCII.Decimal.showIntegral

{-| Gives the ASCII string representation of an integer in hexadecimal (base 16)
    notation

The characters 'ASCII.Char.Digit0' through 'ASCII.Char.Digit9' represent digits
0 though 9. The representation of digits 10 to 15 is determined by the value of
'Case' parameter: 'UpperCase' means 'ASCII.Char.CapitalLetterA' to
'ASCII.Char.CapitalLetterF', and 'LowerCase' means 'ASCII.Char.SmallLetterA' to
'ASCII.Char.SmallLetterF'. For negative numbers, the resulting string begins
with 'ASCII.Char.HyphenMinus'.

@
'showIntegralHexadecimal' 'UpperCase' ('Prelude.negate' (256 + 12) :: 'Prelude.Integer') == "-10C"
@ -}
showIntegralHexadecimal :: (Integral n, StringSuperset string) =>
    Case -> n -> string
showIntegralHexadecimal :: forall n string.
(Integral n, StringSuperset string) =>
Case -> n -> string
showIntegralHexadecimal = forall string number.
(StringSuperset string, Integral number) =>
Case -> number -> string
ASCII.Hexadecimal.showIntegral

{-| Roughly the inverse of 'showIntegralDecimal'

* Leading zeroes are accepted, as in @"0074"@ and @"-0074"@

Conditions where the result is 'Data.Maybe.Nothing':

* If the input is empty
* If the input contains any other extraneous characters
* If the resulting number would be outside the range supported by the 'Integral'
  (determined by its 'Bits' instance) -}
readIntegralDecimal :: (StringSuperset string, Integral number, Bits number) =>
    string -> Maybe number
readIntegralDecimal :: forall string number.
(StringSuperset string, Integral number, Bits number) =>
string -> Maybe number
readIntegralDecimal = forall string number.
(StringSuperset string, Integral number, Bits number) =>
string -> Maybe number
ASCII.Decimal.readIntegral

{-| Roughly the inverse of 'showIntegralHexadecimal'

* Upper and lower case letters are treated equally
* Leading zeroes are accepted, as in @"006a"@ and @"-006a"@

Conditions where the result is 'Data.Maybe.Nothing':

* If the input is empty
* If the input contains any other extraneous characters
* If the resulting number would be outside the range supported by the 'Integral'
  (determined by its 'Bits' instance) -}
readIntegralHexadecimal :: (StringSuperset string, Integral number, Bits number) =>
    string -> Maybe number
readIntegralHexadecimal :: forall string number.
(StringSuperset string, Integral number, Bits number) =>
string -> Maybe number
readIntegralHexadecimal = forall string number.
(StringSuperset string, Integral number, Bits number) =>
string -> Maybe number
ASCII.Hexadecimal.readIntegral

{-| Gives the ASCII string representation of an natural number in decimal
    (base 10) notation, using digits 'ASCII.Char.Digit0' through 'ASCII.Char.Digit9'

@
'showNaturalDecimal' 512 == @"512"
@ -}
showNaturalDecimal :: DigitStringSuperset string => Natural -> string
showNaturalDecimal :: forall string. DigitStringSuperset string => Natural -> string
showNaturalDecimal = forall string. DigitStringSuperset string => Natural -> string
ASCII.Decimal.showNatural

{-| Gives the ASCII string representation of an integer in hexadecimal (base 16)
    notation

Characters 'ASCII.Char.Digit0' through 'ASCII.Char.Digit9' represent digits 0
though 9. The representation of digits 10 to 15 is determined by the value of
'Case' parameter: 'UpperCase' means 'ASCII.Char.CapitalLetterA' to
'ASCII.Char.CapitalLetterF', and 'LowerCase' means 'ASCII.Char.SmallLetterA' to
'ASCII.Char.SmallLetterF'.

@
'showNaturalHexadecimal' 'UpperCase' (256 + 12) == "10C"
@ -}
showNaturalHexadecimal :: HexStringSuperset string => Case -> Natural -> string
showNaturalHexadecimal :: forall string.
HexStringSuperset string =>
Case -> Natural -> string
showNaturalHexadecimal = forall string.
HexStringSuperset string =>
Case -> Natural -> string
ASCII.Hexadecimal.showNatural

{-| Roughly the inverse of 'showNaturalDecimal'

* Leading zeroes are accepted, as in @"0074"@

Conditions where the result is 'Data.Maybe.Nothing':

* If the input is empty
* If the input contains any other extraneous characters -}
readNaturalDecimal :: DigitStringSuperset string => string -> Maybe Natural
readNaturalDecimal :: forall string.
DigitStringSuperset string =>
string -> Maybe Natural
readNaturalDecimal = forall string.
DigitStringSuperset string =>
string -> Maybe Natural
ASCII.Decimal.readNatural

{-| Roughly the inverse of 'showNaturalHexadecimal'

* Upper and lower case letters are treated equally
* Leading zeroes are accepted, as in @"006a"@

Conditions where the result is 'Data.Maybe.Nothing':

* If the input is empty
* If the input contains any other extraneous characters -}
readNaturalHexadecimal :: HexStringSuperset string => string -> Maybe Natural
readNaturalHexadecimal :: forall string. HexStringSuperset string => string -> Maybe Natural
readNaturalHexadecimal = forall string. HexStringSuperset string => string -> Maybe Natural
ASCII.Hexadecimal.readNatural

{- $digit

See also: "ASCII.Decimal" -}

{- $hexchar

See also: "ASCII.Hexadecimal" -}

{-| Specialization of 'showNaturalDecimal'

See also: 'showIntegralDecimal' -}
showNaturalDigits :: Natural -> [Digit]
showNaturalDigits :: Natural -> [Digit]
showNaturalDigits = forall string. DigitStringSuperset string => Natural -> string
showNaturalDecimal

{-| Specialization of 'readNaturalDecimal'

See also: 'readIntegralDecimal' -}
readNaturalDigits :: [Digit] -> Maybe Natural
readNaturalDigits :: [Digit] -> Maybe Natural
readNaturalDigits = forall string.
DigitStringSuperset string =>
string -> Maybe Natural
readNaturalDecimal

{-| Specialization of 'showNaturalHexadecimal'

See also: 'showIntegralHexadecimal' -}

showNaturalHexChars :: Case -> Natural -> [HexChar]
showNaturalHexChars :: Case -> Natural -> [HexChar]
showNaturalHexChars = forall string.
HexStringSuperset string =>
Case -> Natural -> string
showNaturalHexadecimal

{-| Specialization of 'readNaturalHexadecimal'

See also: 'readIntegralHexadecimal' -}
readNaturalHexChars :: [HexChar] -> Maybe Natural
readNaturalHexChars :: [HexChar] -> Maybe Natural
readNaturalHexChars = forall string. HexStringSuperset string => string -> Maybe Natural
readNaturalHexadecimal

{-| A string containing a single digit character 0-9 -}
digitString :: DigitStringSuperset string => Digit -> string
digitString :: forall string. DigitStringSuperset string => Digit -> string
digitString Digit
x = forall string. DigitStringSuperset string => [Digit] -> string
ASCII.Decimal.fromDigitList [Digit
x]

{-| A string containing a single hexadecimal digit character
    0-9, A-F, or a-f -}
hexCharString :: HexStringSuperset string => HexChar -> string
hexCharString :: forall string. HexStringSuperset string => HexChar -> string
hexCharString HexChar
x = forall string. HexStringSuperset string => [HexChar] -> string
ASCII.Hexadecimal.fromHexCharList [HexChar
x]

toDigitMaybe :: DigitSuperset char => char -> Maybe Digit
toDigitMaybe :: forall char. DigitSuperset char => char -> Maybe Digit
toDigitMaybe = forall char. DigitSuperset char => char -> Maybe Digit
ASCII.Decimal.toDigitMaybe

toHexCharMaybe :: HexCharSuperset char => char -> Maybe HexChar
toHexCharMaybe :: forall char. HexCharSuperset char => char -> Maybe HexChar
toHexCharMaybe = forall char. HexCharSuperset char => char -> Maybe HexChar
ASCII.Hexadecimal.toHexCharMaybe

{-| For example, this function can convert @ASCII ByteString@
    to @ASCII Text@ and vice versa -}
convertRefinedString ::
    StringSupersetConversion a b => ASCII a -> ASCII b
convertRefinedString :: forall a b. StringSupersetConversion a b => ASCII a -> ASCII b
convertRefinedString = forall a b. StringSupersetConversion a b => ASCII a -> ASCII b
SupersetConversion.convertRefinedString