{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module: Text.Ascii.Unsafe
-- Copyright: (C) 2021 Koz Ross
-- License: Apache 2.0
-- Maintainer: Koz Ross <koz.ross@retro-freedom.nz>
-- Stability: stable
-- Portability: GHC only
--
-- A wrapper for partial type class instances and functions.
--
-- This module is designed for qualified importing:
--
-- > import qualified Text.Ascii.Unsafe as Unsafe
module Text.Ascii.Unsafe
  ( -- * Types
    Unsafe (..),

    -- * Text functions
    head,
    last,
    tail,
    init,
    foldl1,
    foldl1',
    foldr1,
    foldr1',
    maximum,
    minimum,
    scanl1,
    scanr1,
    index,
  )
where

import Control.DeepSeq (NFData)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.CaseInsensitive (FoldCase)
import Data.Coerce (coerce)
import Data.Hashable (Hashable)
import Data.Kind (Type)
import Data.Word (Word8)
import GHC.Exts (IsList)
import GHC.Read (expectP, lexP, parens, readPrec)
import Text.Ascii.Internal (AsciiChar (AsciiChar), AsciiText (AsciiText))
import Text.Megaparsec.Stream (Stream, TraversableStream, VisualStream)
import Text.ParserCombinators.ReadPrec (ReadPrec)
import Text.Read (Lexeme (Char))
import Type.Reflection (Typeable)
import Prelude hiding
  ( foldl1,
    foldr1,
    head,
    init,
    last,
    maximum,
    minimum,
    scanl1,
    scanr1,
    tail,
  )

-- | A wrapper for a type, designating that partial type class methods or other
-- functions are available for it.
--
-- We set the role of the type argument of 'Unsafe' to nominal. Among other
-- things, it means that this type can't be coerced or derived through. This
-- ensures clear indication when (and to what extent) non-total operations occur
-- in any code using them.
--
-- @since 1.0.1
newtype Unsafe (a :: Type) = Unsafe {forall a. Unsafe a -> a
safe :: a}
  deriving
    ( -- | @since 1.0.1
      Unsafe a -> Unsafe a -> Bool
(Unsafe a -> Unsafe a -> Bool)
-> (Unsafe a -> Unsafe a -> Bool) -> Eq (Unsafe a)
forall a. Eq a => Unsafe a -> Unsafe a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unsafe a -> Unsafe a -> Bool
$c/= :: forall a. Eq a => Unsafe a -> Unsafe a -> Bool
== :: Unsafe a -> Unsafe a -> Bool
$c== :: forall a. Eq a => Unsafe a -> Unsafe a -> Bool
Eq,
      -- | @since 1.0.1
      Eq (Unsafe a)
Eq (Unsafe a)
-> (Unsafe a -> Unsafe a -> Ordering)
-> (Unsafe a -> Unsafe a -> Bool)
-> (Unsafe a -> Unsafe a -> Bool)
-> (Unsafe a -> Unsafe a -> Bool)
-> (Unsafe a -> Unsafe a -> Bool)
-> (Unsafe a -> Unsafe a -> Unsafe a)
-> (Unsafe a -> Unsafe a -> Unsafe a)
-> Ord (Unsafe a)
Unsafe a -> Unsafe a -> Bool
Unsafe a -> Unsafe a -> Ordering
Unsafe a -> Unsafe a -> Unsafe a
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
forall {a}. Ord a => Eq (Unsafe a)
forall a. Ord a => Unsafe a -> Unsafe a -> Bool
forall a. Ord a => Unsafe a -> Unsafe a -> Ordering
forall a. Ord a => Unsafe a -> Unsafe a -> Unsafe a
min :: Unsafe a -> Unsafe a -> Unsafe a
$cmin :: forall a. Ord a => Unsafe a -> Unsafe a -> Unsafe a
max :: Unsafe a -> Unsafe a -> Unsafe a
$cmax :: forall a. Ord a => Unsafe a -> Unsafe a -> Unsafe a
>= :: Unsafe a -> Unsafe a -> Bool
$c>= :: forall a. Ord a => Unsafe a -> Unsafe a -> Bool
> :: Unsafe a -> Unsafe a -> Bool
$c> :: forall a. Ord a => Unsafe a -> Unsafe a -> Bool
<= :: Unsafe a -> Unsafe a -> Bool
$c<= :: forall a. Ord a => Unsafe a -> Unsafe a -> Bool
< :: Unsafe a -> Unsafe a -> Bool
$c< :: forall a. Ord a => Unsafe a -> Unsafe a -> Bool
compare :: Unsafe a -> Unsafe a -> Ordering
$ccompare :: forall a. Ord a => Unsafe a -> Unsafe a -> Ordering
Ord,
      -- | @since 1.0.1
      Unsafe a
Unsafe a -> Unsafe a -> Bounded (Unsafe a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Unsafe a
maxBound :: Unsafe a
$cmaxBound :: forall a. Bounded a => Unsafe a
minBound :: Unsafe a
$cminBound :: forall a. Bounded a => Unsafe a
Bounded,
      -- | @since 1.0.1
      Int -> Unsafe a -> Int
Unsafe a -> Int
(Int -> Unsafe a -> Int)
-> (Unsafe a -> Int) -> Hashable (Unsafe a)
forall a. Hashable a => Int -> Unsafe a -> Int
forall a. Hashable a => Unsafe a -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Unsafe a -> Int
$chash :: forall a. Hashable a => Unsafe a -> Int
hashWithSalt :: Int -> Unsafe a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Unsafe a -> Int
Hashable,
      -- | @since 1.0.1
      Unsafe a -> ()
(Unsafe a -> ()) -> NFData (Unsafe a)
forall a. NFData a => Unsafe a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Unsafe a -> ()
$crnf :: forall a. NFData a => Unsafe a -> ()
NFData,
      -- | @since 1.0.1
      [Unsafe a] -> [Unsafe a]
Unsafe a -> Unsafe a
(Unsafe a -> Unsafe a)
-> ([Unsafe a] -> [Unsafe a]) -> FoldCase (Unsafe a)
forall a. FoldCase a => [Unsafe a] -> [Unsafe a]
forall a. FoldCase a => Unsafe a -> Unsafe a
forall s. (s -> s) -> ([s] -> [s]) -> FoldCase s
foldCaseList :: [Unsafe a] -> [Unsafe a]
$cfoldCaseList :: forall a. FoldCase a => [Unsafe a] -> [Unsafe a]
foldCase :: Unsafe a -> Unsafe a
$cfoldCase :: forall a. FoldCase a => Unsafe a -> Unsafe a
FoldCase,
      -- | @since 1.0.1
      NonEmpty (Unsafe a) -> Unsafe a
Unsafe a -> Unsafe a -> Unsafe a
(Unsafe a -> Unsafe a -> Unsafe a)
-> (NonEmpty (Unsafe a) -> Unsafe a)
-> (forall b. Integral b => b -> Unsafe a -> Unsafe a)
-> Semigroup (Unsafe a)
forall b. Integral b => b -> Unsafe a -> Unsafe a
forall a. Semigroup a => NonEmpty (Unsafe a) -> Unsafe a
forall a. Semigroup a => Unsafe a -> Unsafe a -> Unsafe a
forall a b. (Semigroup a, Integral b) => b -> Unsafe a -> Unsafe a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Unsafe a -> Unsafe a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Unsafe a -> Unsafe a
sconcat :: NonEmpty (Unsafe a) -> Unsafe a
$csconcat :: forall a. Semigroup a => NonEmpty (Unsafe a) -> Unsafe a
<> :: Unsafe a -> Unsafe a -> Unsafe a
$c<> :: forall a. Semigroup a => Unsafe a -> Unsafe a -> Unsafe a
Semigroup,
      -- | @since 1.0.1
      Semigroup (Unsafe a)
Unsafe a
Semigroup (Unsafe a)
-> Unsafe a
-> (Unsafe a -> Unsafe a -> Unsafe a)
-> ([Unsafe a] -> Unsafe a)
-> Monoid (Unsafe a)
[Unsafe a] -> Unsafe a
Unsafe a -> Unsafe a -> Unsafe a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (Unsafe a)
forall a. Monoid a => Unsafe a
forall a. Monoid a => [Unsafe a] -> Unsafe a
forall a. Monoid a => Unsafe a -> Unsafe a -> Unsafe a
mconcat :: [Unsafe a] -> Unsafe a
$cmconcat :: forall a. Monoid a => [Unsafe a] -> Unsafe a
mappend :: Unsafe a -> Unsafe a -> Unsafe a
$cmappend :: forall a. Monoid a => Unsafe a -> Unsafe a -> Unsafe a
mempty :: Unsafe a
$cmempty :: forall a. Monoid a => Unsafe a
Monoid,
      -- | @since 1.0.1
      Int -> [Item (Unsafe a)] -> Unsafe a
[Item (Unsafe a)] -> Unsafe a
Unsafe a -> [Item (Unsafe a)]
([Item (Unsafe a)] -> Unsafe a)
-> (Int -> [Item (Unsafe a)] -> Unsafe a)
-> (Unsafe a -> [Item (Unsafe a)])
-> IsList (Unsafe a)
forall a. IsList a => Int -> [Item (Unsafe a)] -> Unsafe a
forall a. IsList a => [Item (Unsafe a)] -> Unsafe a
forall a. IsList a => Unsafe a -> [Item (Unsafe a)]
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
toList :: Unsafe a -> [Item (Unsafe a)]
$ctoList :: forall a. IsList a => Unsafe a -> [Item (Unsafe a)]
fromListN :: Int -> [Item (Unsafe a)] -> Unsafe a
$cfromListN :: forall a. IsList a => Int -> [Item (Unsafe a)] -> Unsafe a
fromList :: [Item (Unsafe a)] -> Unsafe a
$cfromList :: forall a. IsList a => [Item (Unsafe a)] -> Unsafe a
IsList,
      -- | @since 1.0.1
      Ord (Tokens (Unsafe a))
Ord (Token (Unsafe a))
Ord (Token (Unsafe a))
-> Ord (Tokens (Unsafe a))
-> (Proxy (Unsafe a) -> Token (Unsafe a) -> Tokens (Unsafe a))
-> (Proxy (Unsafe a) -> [Token (Unsafe a)] -> Tokens (Unsafe a))
-> (Proxy (Unsafe a) -> Tokens (Unsafe a) -> [Token (Unsafe a)])
-> (Proxy (Unsafe a) -> Tokens (Unsafe a) -> Int)
-> (Proxy (Unsafe a) -> Tokens (Unsafe a) -> Bool)
-> (Unsafe a -> Maybe (Token (Unsafe a), Unsafe a))
-> (Int -> Unsafe a -> Maybe (Tokens (Unsafe a), Unsafe a))
-> ((Token (Unsafe a) -> Bool)
    -> Unsafe a -> (Tokens (Unsafe a), Unsafe a))
-> Stream (Unsafe a)
Int -> Unsafe a -> Maybe (Tokens (Unsafe a), Unsafe a)
Proxy (Unsafe a) -> [Token (Unsafe a)] -> Tokens (Unsafe a)
Proxy (Unsafe a) -> Tokens (Unsafe a) -> Bool
Proxy (Unsafe a) -> Tokens (Unsafe a) -> Int
Proxy (Unsafe a) -> Tokens (Unsafe a) -> [Token (Unsafe a)]
Proxy (Unsafe a) -> Token (Unsafe a) -> Tokens (Unsafe a)
Unsafe a -> Maybe (Token (Unsafe a), Unsafe a)
(Token (Unsafe a) -> Bool)
-> Unsafe a -> (Tokens (Unsafe a), Unsafe a)
forall s.
Ord (Token s)
-> Ord (Tokens s)
-> (Proxy s -> Token s -> Tokens s)
-> (Proxy s -> [Token s] -> Tokens s)
-> (Proxy s -> Tokens s -> [Token s])
-> (Proxy s -> Tokens s -> Int)
-> (Proxy s -> Tokens s -> Bool)
-> (s -> Maybe (Token s, s))
-> (Int -> s -> Maybe (Tokens s, s))
-> ((Token s -> Bool) -> s -> (Tokens s, s))
-> Stream s
forall {a}. Stream a => Ord (Tokens (Unsafe a))
forall {a}. Stream a => Ord (Token (Unsafe a))
forall a.
Stream a =>
Int -> Unsafe a -> Maybe (Tokens (Unsafe a), Unsafe a)
forall a.
Stream a =>
Proxy (Unsafe a) -> [Token (Unsafe a)] -> Tokens (Unsafe a)
forall a. Stream a => Proxy (Unsafe a) -> Tokens (Unsafe a) -> Bool
forall a. Stream a => Proxy (Unsafe a) -> Tokens (Unsafe a) -> Int
forall a.
Stream a =>
Proxy (Unsafe a) -> Tokens (Unsafe a) -> [Token (Unsafe a)]
forall a.
Stream a =>
Proxy (Unsafe a) -> Token (Unsafe a) -> Tokens (Unsafe a)
forall a.
Stream a =>
Unsafe a -> Maybe (Token (Unsafe a), Unsafe a)
forall a.
Stream a =>
(Token (Unsafe a) -> Bool)
-> Unsafe a -> (Tokens (Unsafe a), Unsafe a)
takeWhile_ :: (Token (Unsafe a) -> Bool)
-> Unsafe a -> (Tokens (Unsafe a), Unsafe a)
$ctakeWhile_ :: forall a.
Stream a =>
(Token (Unsafe a) -> Bool)
-> Unsafe a -> (Tokens (Unsafe a), Unsafe a)
takeN_ :: Int -> Unsafe a -> Maybe (Tokens (Unsafe a), Unsafe a)
$ctakeN_ :: forall a.
Stream a =>
Int -> Unsafe a -> Maybe (Tokens (Unsafe a), Unsafe a)
take1_ :: Unsafe a -> Maybe (Token (Unsafe a), Unsafe a)
$ctake1_ :: forall a.
Stream a =>
Unsafe a -> Maybe (Token (Unsafe a), Unsafe a)
chunkEmpty :: Proxy (Unsafe a) -> Tokens (Unsafe a) -> Bool
$cchunkEmpty :: forall a. Stream a => Proxy (Unsafe a) -> Tokens (Unsafe a) -> Bool
chunkLength :: Proxy (Unsafe a) -> Tokens (Unsafe a) -> Int
$cchunkLength :: forall a. Stream a => Proxy (Unsafe a) -> Tokens (Unsafe a) -> Int
chunkToTokens :: Proxy (Unsafe a) -> Tokens (Unsafe a) -> [Token (Unsafe a)]
$cchunkToTokens :: forall a.
Stream a =>
Proxy (Unsafe a) -> Tokens (Unsafe a) -> [Token (Unsafe a)]
tokensToChunk :: Proxy (Unsafe a) -> [Token (Unsafe a)] -> Tokens (Unsafe a)
$ctokensToChunk :: forall a.
Stream a =>
Proxy (Unsafe a) -> [Token (Unsafe a)] -> Tokens (Unsafe a)
tokenToChunk :: Proxy (Unsafe a) -> Token (Unsafe a) -> Tokens (Unsafe a)
$ctokenToChunk :: forall a.
Stream a =>
Proxy (Unsafe a) -> Token (Unsafe a) -> Tokens (Unsafe a)
Stream,
      -- | @since 1.0.1
      Stream (Unsafe a)
Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> Int
Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> String
Stream (Unsafe a)
-> (Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> String)
-> (Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> Int)
-> VisualStream (Unsafe a)
forall s.
Stream s
-> (Proxy s -> NonEmpty (Token s) -> String)
-> (Proxy s -> NonEmpty (Token s) -> Int)
-> VisualStream s
forall {a}. VisualStream a => Stream (Unsafe a)
forall a.
VisualStream a =>
Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> Int
forall a.
VisualStream a =>
Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> String
tokensLength :: Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> Int
$ctokensLength :: forall a.
VisualStream a =>
Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> Int
showTokens :: Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> String
$cshowTokens :: forall a.
VisualStream a =>
Proxy (Unsafe a) -> NonEmpty (Token (Unsafe a)) -> String
VisualStream,
      -- | @since 1.0.1
      Stream (Unsafe a)
Int -> PosState (Unsafe a) -> (Maybe String, PosState (Unsafe a))
Int -> PosState (Unsafe a) -> PosState (Unsafe a)
Stream (Unsafe a)
-> (Int
    -> PosState (Unsafe a) -> (Maybe String, PosState (Unsafe a)))
-> (Int -> PosState (Unsafe a) -> PosState (Unsafe a))
-> TraversableStream (Unsafe a)
forall s.
Stream s
-> (Int -> PosState s -> (Maybe String, PosState s))
-> (Int -> PosState s -> PosState s)
-> TraversableStream s
forall {a}. TraversableStream a => Stream (Unsafe a)
forall a.
TraversableStream a =>
Int -> PosState (Unsafe a) -> (Maybe String, PosState (Unsafe a))
forall a.
TraversableStream a =>
Int -> PosState (Unsafe a) -> PosState (Unsafe a)
reachOffsetNoLine :: Int -> PosState (Unsafe a) -> PosState (Unsafe a)
$creachOffsetNoLine :: forall a.
TraversableStream a =>
Int -> PosState (Unsafe a) -> PosState (Unsafe a)
reachOffset :: Int -> PosState (Unsafe a) -> (Maybe String, PosState (Unsafe a))
$creachOffset :: forall a.
TraversableStream a =>
Int -> PosState (Unsafe a) -> (Maybe String, PosState (Unsafe a))
TraversableStream,
      -- | @since 1.0.1
      Int -> Unsafe a -> ShowS
[Unsafe a] -> ShowS
Unsafe a -> String
(Int -> Unsafe a -> ShowS)
-> (Unsafe a -> String) -> ([Unsafe a] -> ShowS) -> Show (Unsafe a)
forall a. Show a => Int -> Unsafe a -> ShowS
forall a. Show a => [Unsafe a] -> ShowS
forall a. Show a => Unsafe a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unsafe a] -> ShowS
$cshowList :: forall a. Show a => [Unsafe a] -> ShowS
show :: Unsafe a -> String
$cshow :: forall a. Show a => Unsafe a -> String
showsPrec :: Int -> Unsafe a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Unsafe a -> ShowS
Show
    )
    via a
  deriving stock
    ( -- | @since 1.0.1
      Typeable,
      -- | @since 1.0.1
      (forall a b. (a -> b) -> Unsafe a -> Unsafe b)
-> (forall a b. a -> Unsafe b -> Unsafe a) -> Functor Unsafe
forall a b. a -> Unsafe b -> Unsafe a
forall a b. (a -> b) -> Unsafe a -> Unsafe b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Unsafe b -> Unsafe a
$c<$ :: forall a b. a -> Unsafe b -> Unsafe a
fmap :: forall a b. (a -> b) -> Unsafe a -> Unsafe b
$cfmap :: forall a b. (a -> b) -> Unsafe a -> Unsafe b
Functor
    )

type role Unsafe nominal

-- | @since 1.0.1
instance Read (Unsafe AsciiChar) where
  {-# INLINEABLE readPrec #-}
  readPrec :: ReadPrec (Unsafe AsciiChar)
readPrec = ReadPrec (Unsafe AsciiChar) -> ReadPrec (Unsafe AsciiChar)
forall a. ReadPrec a -> ReadPrec a
parens ReadPrec (Unsafe AsciiChar)
go
    where
      go :: ReadPrec (Unsafe AsciiChar)
      go :: ReadPrec (Unsafe AsciiChar)
go =
        AsciiChar -> Unsafe AsciiChar
forall a. a -> Unsafe a
Unsafe (AsciiChar -> Unsafe AsciiChar)
-> (Word8 -> AsciiChar) -> Word8 -> Unsafe AsciiChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> AsciiChar
AsciiChar (Word8 -> Unsafe AsciiChar)
-> ReadPrec Word8 -> ReadPrec (Unsafe AsciiChar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
          Lexeme -> ReadPrec ()
expectP (Char -> Lexeme
Char Char
'\'')
          Lexeme -> ReadPrec ()
expectP (Char -> Lexeme
Char Char
'0')
          Lexeme -> ReadPrec ()
expectP (Char -> Lexeme
Char Char
'x')
          Char Char
d1 <- ReadPrec Lexeme
lexP
          Char Char
d2 <- ReadPrec Lexeme
lexP
          Lexeme -> ReadPrec ()
expectP (Char -> Lexeme
Char Char
'\'')
          case Char
d1 of
            Char
'0' -> Char -> ReadPrec Word8
fromSecondDigit Char
d2
            Char
'1' -> (Word8
16 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+) (Word8 -> Word8) -> ReadPrec Word8 -> ReadPrec Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ReadPrec Word8
fromSecondDigit Char
d2
            Char
'2' -> (Word8
32 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+) (Word8 -> Word8) -> ReadPrec Word8 -> ReadPrec Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ReadPrec Word8
fromSecondDigit Char
d2
            Char
'3' -> (Word8
48 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+) (Word8 -> Word8) -> ReadPrec Word8 -> ReadPrec Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ReadPrec Word8
fromSecondDigit Char
d2
            Char
'4' -> (Word8
64 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+) (Word8 -> Word8) -> ReadPrec Word8 -> ReadPrec Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ReadPrec Word8
fromSecondDigit Char
d2
            Char
'5' -> (Word8
80 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+) (Word8 -> Word8) -> ReadPrec Word8 -> ReadPrec Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ReadPrec Word8
fromSecondDigit Char
d2
            Char
'6' -> (Word8
96 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+) (Word8 -> Word8) -> ReadPrec Word8 -> ReadPrec Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ReadPrec Word8
fromSecondDigit Char
d2
            Char
'7' -> (Word8
112 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+) (Word8 -> Word8) -> ReadPrec Word8 -> ReadPrec Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ReadPrec Word8
fromSecondDigit Char
d2
            Char
_ -> String -> ReadPrec Word8
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadPrec Word8) -> String -> ReadPrec Word8
forall a b. (a -> b) -> a -> b
$ String
"Expected digit from 0 to 7, instead got '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
d1] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"

-- | @since 1.0.1
instance Enum (Unsafe AsciiChar) where
  {-# INLINEABLE succ #-}
  succ :: Unsafe AsciiChar -> Unsafe AsciiChar
succ (Unsafe (AsciiChar Word8
w8))
    | Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
127 = AsciiChar -> Unsafe AsciiChar
forall a. a -> Unsafe a
Unsafe (AsciiChar -> Unsafe AsciiChar)
-> (Word8 -> AsciiChar) -> Word8 -> Unsafe AsciiChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> AsciiChar
AsciiChar (Word8 -> Unsafe AsciiChar) -> Word8 -> Unsafe AsciiChar
forall a b. (a -> b) -> a -> b
$ Word8
w8 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1
    | Bool
otherwise = String -> Unsafe AsciiChar
forall a. HasCallStack => String -> a
error String
"Out of range for ASCII character"
  {-# INLINEABLE pred #-}
  pred :: Unsafe AsciiChar -> Unsafe AsciiChar
pred (Unsafe (AsciiChar Word8
w8))
    | Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0 = AsciiChar -> Unsafe AsciiChar
forall a. a -> Unsafe a
Unsafe (AsciiChar -> Unsafe AsciiChar)
-> (Word8 -> AsciiChar) -> Word8 -> Unsafe AsciiChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> AsciiChar
AsciiChar (Word8 -> Unsafe AsciiChar) -> Word8 -> Unsafe AsciiChar
forall a b. (a -> b) -> a -> b
$ Word8
w8 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1
    | Bool
otherwise = String -> Unsafe AsciiChar
forall a. HasCallStack => String -> a
error String
"Out of range for ASCII character"
  {-# INLINEABLE toEnum #-}
  toEnum :: Int -> Unsafe AsciiChar
toEnum Int
n
    | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
127 = AsciiChar -> Unsafe AsciiChar
forall a. a -> Unsafe a
Unsafe (AsciiChar -> Unsafe AsciiChar)
-> (Int -> AsciiChar) -> Int -> Unsafe AsciiChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> AsciiChar
AsciiChar (Word8 -> AsciiChar) -> (Int -> Word8) -> Int -> AsciiChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Unsafe AsciiChar) -> Int -> Unsafe AsciiChar
forall a b. (a -> b) -> a -> b
$ Int
n
    | Bool
otherwise = String -> Unsafe AsciiChar
forall a. HasCallStack => String -> a
error String
"Out of range for ASCII character"
  {-# INLINEABLE fromEnum #-}
  fromEnum :: Unsafe AsciiChar -> Int
fromEnum (Unsafe (AsciiChar Word8
w8)) = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
  {-# INLINEABLE enumFrom #-}
  enumFrom :: Unsafe AsciiChar -> [Unsafe AsciiChar]
enumFrom (Unsafe (AsciiChar Word8
w8)) = [Word8] -> [Unsafe AsciiChar]
coerce [Word8
w | Word8
w <- [Word8
w8 ..], Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
127]
  {-# INLINEABLE enumFromThen #-}
  enumFromThen :: Unsafe AsciiChar -> Unsafe AsciiChar -> [Unsafe AsciiChar]
enumFromThen (Unsafe (AsciiChar Word8
start)) (Unsafe (AsciiChar Word8
step)) =
    [Word8] -> [Unsafe AsciiChar]
coerce [Word8
w | Word8
w <- [Word8
start, Word8
step ..], Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
127]
  {-# INLINEABLE enumFromTo #-}
  enumFromTo :: Unsafe AsciiChar -> Unsafe AsciiChar -> [Unsafe AsciiChar]
enumFromTo (Unsafe (AsciiChar Word8
start)) (Unsafe (AsciiChar Word8
end)) =
    [Word8] -> [Unsafe AsciiChar]
coerce [Word8
w | Word8
w <- [Word8
start .. Word8
end], Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
127]
  {-# INLINEABLE enumFromThenTo #-}
  enumFromThenTo :: Unsafe AsciiChar
-> Unsafe AsciiChar -> Unsafe AsciiChar -> [Unsafe AsciiChar]
enumFromThenTo (Unsafe (AsciiChar Word8
start)) (Unsafe (AsciiChar Word8
step)) (Unsafe (AsciiChar Word8
end)) =
    [Word8] -> [Unsafe AsciiChar]
coerce [Word8
w | Word8
w <- [Word8
start, Word8
step .. Word8
end], Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
127]

-- | @since 1.0.1
instance Read (Unsafe AsciiText) where
  {-# INLINEABLE readPrec #-}
  readPrec :: ReadPrec (Unsafe AsciiText)
readPrec = AsciiText -> Unsafe AsciiText
forall a. a -> Unsafe a
Unsafe (AsciiText -> Unsafe AsciiText)
-> (ByteString -> AsciiText) -> ByteString -> Unsafe AsciiText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AsciiText
AsciiText (ByteString -> Unsafe AsciiText)
-> ReadPrec ByteString -> ReadPrec (Unsafe AsciiText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec ByteString
go
    where
      go :: ReadPrec ByteString
      go :: ReadPrec ByteString
go = do
        ByteString
bs :: ByteString <- ReadPrec ByteString
forall a. Read a => ReadPrec a
readPrec
        case (Word8 -> Bool) -> ByteString -> Maybe Int
BS.findIndex (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
128) ByteString
bs of
          Maybe Int
Nothing -> ByteString -> ReadPrec ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
          Just Int
i -> String -> ReadPrec ByteString
forall a. HasCallStack => String -> a
error (String -> ReadPrec ByteString) -> String -> ReadPrec ByteString
forall a b. (a -> b) -> a -> b
$ String
"Non-ASCII byte at index " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i

-- Functions

-- $setup
-- >>> :set -XNoImplicitPrelude
-- >>> :set -XQuasiQuotes
-- >>> import Text.Ascii.Unsafe
-- >>> import Text.Ascii (ascii)
-- >>> import Prelude ((.), ($))

-- | Yield the first character of the text.
--
-- /Requirements:/ Text is not empty.
--
-- >>> head . Unsafe $ [ascii| "catboy" |]
-- '0x63'
--
-- /Complexity:/ \(\Theta(1)\)
--
-- @since 1.0.1
head :: Unsafe AsciiText -> AsciiChar
head :: Unsafe AsciiText -> AsciiChar
head = (ByteString -> Word8) -> Unsafe AsciiText -> AsciiChar
coerce ByteString -> Word8
BS.head

-- | Yield the last character of the text.
--
-- /Requirements:/ Text is not empty.
--
-- >>> last . Unsafe $ [ascii| "catboy" |]
-- '0x79'
--
-- /Complexity:/ \(\Theta(1)\)
--
-- @since 1.0.1
last :: Unsafe AsciiText -> AsciiChar
last :: Unsafe AsciiText -> AsciiChar
last = (ByteString -> Word8) -> Unsafe AsciiText -> AsciiChar
coerce ByteString -> Word8
BS.last

-- | Yield the text without its first character.
--
-- /Requirements:/ Text is not empty.
--
-- >>> tail . Unsafe $ [ascii| "catboy" |]
-- "atboy"
--
-- /Complexity:/ \(\Theta(1)\)
--
-- @since 1.0.1
tail :: Unsafe AsciiText -> Unsafe AsciiText
tail :: Unsafe AsciiText -> Unsafe AsciiText
tail = (ByteString -> ByteString) -> Unsafe AsciiText -> Unsafe AsciiText
coerce ByteString -> ByteString
BS.tail

-- | Yield the text without its last character.
--
-- /Requirements:/ Text is not empty.
--
-- >>> init . Unsafe $ [ascii| "catboy" |]
-- "catbo"
--
-- /Complexity:/ \(\Theta(1)\)
--
-- @since 1.0.1
init :: Unsafe AsciiText -> Unsafe AsciiText
init :: Unsafe AsciiText -> Unsafe AsciiText
init = (ByteString -> ByteString) -> Unsafe AsciiText -> Unsafe AsciiText
coerce ByteString -> ByteString
BS.init

-- | Left-associative fold of a text without a base case.
--
-- /Requirements:/ Text is not empty.
--
-- /Complexity:/ \(\Theta(n)\)
--
-- @since 1.0.1
foldl1 :: (AsciiChar -> AsciiChar -> AsciiChar) -> Unsafe AsciiText -> AsciiChar
foldl1 :: (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText -> AsciiChar
foldl1 = ((Word8 -> Word8 -> Word8) -> ByteString -> Word8)
-> (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText
-> AsciiChar
coerce (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BS.foldl1

-- | Left-associative fold of a text without a base case, strict in the
-- accumulator.
--
-- /Requirements:/ Text is not empty.
--
-- /Complexity:/ \(\Theta(n)\)
--
-- @since 1.0.1
foldl1' :: (AsciiChar -> AsciiChar -> AsciiChar) -> Unsafe AsciiText -> AsciiChar
foldl1' :: (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText -> AsciiChar
foldl1' = ((Word8 -> Word8 -> Word8) -> ByteString -> Word8)
-> (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText
-> AsciiChar
coerce (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BS.foldl1'

-- | Right-associative fold of a text without a base case.
--
-- /Requirements:/ Text is not empty.
--
-- /Complexity:/ \(\Theta(n)\)
--
-- @since 1.0.1
foldr1 :: (AsciiChar -> AsciiChar -> AsciiChar) -> Unsafe AsciiText -> AsciiChar
foldr1 :: (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText -> AsciiChar
foldr1 = ((Word8 -> Word8 -> Word8) -> ByteString -> Word8)
-> (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText
-> AsciiChar
coerce (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BS.foldr1

-- | Right-associative fold of a text without a base case, strict in the
-- accumulator.
--
-- /Requirements:/ Text is not empty.
--
-- /Complexity:/ \(\Theta(n)\)
--
-- @since 1.0.1
foldr1' :: (AsciiChar -> AsciiChar -> AsciiChar) -> Unsafe AsciiText -> AsciiChar
foldr1' :: (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText -> AsciiChar
foldr1' = ((Word8 -> Word8 -> Word8) -> ByteString -> Word8)
-> (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText
-> AsciiChar
coerce (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BS.foldr1'

-- | Yield the character in the text whose byte representation is numerically
-- the largest.
--
-- /Requirements:/ Text is not empty.
--
-- >>> maximum . Unsafe $ [ascii| "catboy" |]
-- '0x79'
-- >>> maximum . Unsafe $ [ascii| "nyan~" |]
-- '0x7e'
--
-- /Complexity:/ \(\Theta(n)\)
--
-- @since 1.0.1
maximum :: Unsafe AsciiText -> AsciiChar
maximum :: Unsafe AsciiText -> AsciiChar
maximum = (ByteString -> Word8) -> Unsafe AsciiText -> AsciiChar
coerce ByteString -> Word8
BS.maximum

-- | Yield the character in the text whose byte representation is numerically
-- the smallest.
--
-- /Requirements:/ Text is not empty.
--
-- >>> minimum . Unsafe $ [ascii| "catboy" |]
-- '0x61'
-- >>> minimum . Unsafe $ [ascii| " nyan" |]
-- '0x20'
--
-- /Complexity:/ \(\Theta(n)\)
--
-- @since 1.0.1
minimum :: Unsafe AsciiText -> AsciiChar
minimum :: Unsafe AsciiText -> AsciiChar
minimum = (ByteString -> Word8) -> Unsafe AsciiText -> AsciiChar
coerce ByteString -> Word8
BS.minimum

-- | 'scanl1' is similar to 'foldl1', but returns a list of successive values
-- from the left.
--
-- /Requirements:/ Text is not empty.
--
-- /Complexity:/ \(\Theta(n)\)
--
-- @since 1.0.1
scanl1 ::
  -- | accumulator -> element -> new accumulator
  (AsciiChar -> AsciiChar -> AsciiChar) ->
  -- | Input of length \(n\)
  Unsafe AsciiText ->
  -- | Output of length \(n - 1\)
  Unsafe AsciiText
scanl1 :: (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText -> Unsafe AsciiText
scanl1 = ((Word8 -> Word8 -> Word8) -> ByteString -> ByteString)
-> (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText
-> Unsafe AsciiText
coerce (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
BS.scanl1

-- | 'scanr1' is similar to 'foldr1', but returns a list of successive values
-- from the right.
--
-- /Requirements:/ Text is not empty.
--
-- /Complexity:/ \(\Theta(n)\)
--
-- @since 1.0.1
scanr1 ::
  -- | element -> accumulator -> new accumulator
  (AsciiChar -> AsciiChar -> AsciiChar) ->
  -- | Input of length \(n\)
  Unsafe AsciiText ->
  -- | Output of length \(n - 1\)
  Unsafe AsciiText
scanr1 :: (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText -> Unsafe AsciiText
scanr1 = ((Word8 -> Word8 -> Word8) -> ByteString -> ByteString)
-> (AsciiChar -> AsciiChar -> AsciiChar)
-> Unsafe AsciiText
-> Unsafe AsciiText
coerce (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
BS.scanr1

-- | Yield the character at the given position.
--
-- /Requirements:/ The position must be at least 0, and at most the length of
-- the text - 1.
--
-- >>> index (Unsafe [ascii| "catboy" |]) 0
-- '0x63'
-- >>> index (Unsafe $ [ascii| "catboy" |]) 4
-- '0x6f'
--
-- /Complexity:/ \(\Theta(1)\)
--
-- @since 1.0.1
index :: Unsafe AsciiText -> Int -> AsciiChar
index :: Unsafe AsciiText -> Int -> AsciiChar
index = (ByteString -> Int -> Word8)
-> Unsafe AsciiText -> Int -> AsciiChar
coerce ByteString -> Int -> Word8
BS.index

-- Helpers

fromSecondDigit :: Char -> ReadPrec Word8
fromSecondDigit :: Char -> ReadPrec Word8
fromSecondDigit = \case
  Char
'0' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
0
  Char
'1' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
1
  Char
'2' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
2
  Char
'3' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
3
  Char
'4' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
4
  Char
'5' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
5
  Char
'6' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
6
  Char
'7' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
7
  Char
'8' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
8
  Char
'9' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
9
  Char
'a' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
10
  Char
'b' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
11
  Char
'c' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
12
  Char
'd' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
13
  Char
'e' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
14
  Char
'f' -> Word8 -> ReadPrec Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
15
  Char
d -> String -> ReadPrec Word8
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadPrec Word8) -> String -> ReadPrec Word8
forall a b. (a -> b) -> a -> b
$ String
"Expected hex digit, instead got '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
d] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"