{-# LANGUAGE TypeApplications #-}

-- | This module treats 'Bytes' data as holding ASCII text. Providing bytes
-- outside the ASCII range (@U+0000@ -- @U+007F@) may cause a failure or
-- unspecified results, but such bytes will never be inspected.
--
-- For functions that can operate on ASCII-compatible encodings, see
-- 'Data.Bytes.Text.AsciiExt'.
module Data.Bytes.Text.Ascii
  ( fromString
  , decodeDecWord
  ) where

import Data.Bytes.Types (Bytes)
import Data.Char (ord)
import Data.Word (Word8)
import Data.Bytes.Text.Latin1 (decodeDecWord)

import qualified Data.Bytes.Pure as Bytes
import qualified GHC.Exts as Exts


-- | Convert a 'String' consisting of only characters in the ASCII block
-- to a byte sequence. Any character with a codepoint above @U+007F@ is
-- replaced by @U+0000@.
fromString :: String -> Bytes
fromString :: String -> Bytes
fromString = ByteArray -> Bytes
Bytes.fromByteArray
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
Exts.fromList
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> let i :: Int
i = Char -> Int
ord Char
c in if Int
i forall a. Ord a => a -> a -> Bool
< Int
128 then forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word8 Int
i else Word8
0)

-- TODO presumably also fromText and fromShortText