{-# language BangPatterns #-}
{-# language BinaryLiterals #-}
{-# language DataKinds #-}
{-# language DeriveFunctor #-}
{-# language DerivingStrategies #-}
{-# language GADTSyntax #-}
{-# language KindSignatures #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language MultiWayIf #-}
{-# language PolyKinds #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language TypeApplications #-}
{-# language UnboxedSums #-}
{-# language UnboxedTuples #-}
module Data.Bytes.Parser
(
Parser(..)
, Result(..)
, parseByteArray
, parseBytes
, parseBytesST
, fail
, peekAnyAscii
, ascii
, ascii3
, ascii4
, any
, anyAscii
, anyAscii#
, anyUtf8#
, anyAsciiOpt
, decWord
, decWord8
, decWord16
, decWord32
, hexWord16
, decPositiveInteger
, endOfInput
, isEndOfInput
, skipUntilAsciiConsume
, skipWhile
, skipAscii
, skipAscii1
, skipAlphaAscii
, skipAlphaAscii1
, skipDigitsAscii
, skipDigitsAscii1
, effect
, cursor
, expose
, unconsume
, unboxWord32
, boxWord32
, bindChar
, orElse
) where
import Prelude hiding (length,any,fail)
import Data.Char (ord)
import Data.Bits ((.&.),(.|.),unsafeShiftL,xor)
import Data.Kind (Type)
import GHC.ST (ST(..),runST)
import GHC.Exts (Word(W#),Word#,TYPE,State#,Int#,ByteArray#)
import GHC.Exts (Int(I#),Char(C#),chr#,RuntimeRep)
import GHC.Exts (Char#,(+#),(-#),(<#),(>#),word2Int#)
import GHC.Exts (indexCharArray#,indexWord8Array#,ord#)
import GHC.Exts (timesWord#,plusWord#)
import GHC.Word (Word16(W16#),Word8(W8#),Word32(W32#))
import Data.Bytes.Types (Bytes(..))
import Data.Primitive (ByteArray(..))
import qualified Data.Primitive as PM
import qualified Control.Monad
type Bytes# = (# ByteArray#, Int#, Int# #)
type ST# s (a :: TYPE r) = State# s -> (# State# s, a #)
type Result# e (a :: TYPE r) =
(# e
| (# a, Int#, Int# #) #)
newtype Parser :: forall (r :: RuntimeRep). Type -> Type -> TYPE r -> Type where
Parser :: forall (r :: RuntimeRep) (e :: Type) (s :: Type) (a :: TYPE r).
{ runParser :: (# ByteArray#, Int#, Int# #) -> ST# s (Result# e a) } -> Parser e s a
data Result e a
= Failure e
| Success !a !Int !Int
parseBytes :: forall e a. (forall s. Parser e s a) -> Bytes -> Result e a
parseBytes p !b = runST action
where
action :: forall s. ST s (Result e a)
action = case p @s of
Parser f -> ST
(\s0 -> case f (unboxBytes b) s0 of
(# s1, r #) -> (# s1, boxResult r #)
)
parseByteArray :: (forall s. Parser e s a) -> ByteArray -> Result e a
parseByteArray p b =
parseBytes p (Bytes b 0 (PM.sizeofByteArray b))
parseBytesST :: Parser e s a -> Bytes -> ST s (Result e a)
parseBytesST (Parser f) !b = ST
(\s0 -> case f (unboxBytes b) s0 of
(# s1, r #) -> (# s1, boxResult r #)
)
instance Functor (Parser e s) where
{-# inline fmap #-}
fmap f (Parser g) = Parser
(\x s0 -> case g x s0 of
(# s1, r #) -> case r of
(# e | #) -> (# s1, (# e | #) #)
(# | (# a, b, c #) #) -> (# s1, (# | (# f a, b, c #) #) #)
)
instance Applicative (Parser e s) where
pure = pureParser
(<*>) = Control.Monad.ap
instance Monad (Parser e s) where
{-# inline return #-}
{-# inline (>>=) #-}
return = pureParser
Parser f >>= g = Parser
(\x@(# arr, _, _ #) s0 -> case f x s0 of
(# s1, r0 #) -> case r0 of
(# e | #) -> (# s1, (# e | #) #)
(# | (# y, b, c #) #) ->
runParser (g y) (# arr, b, c #) s1
)
pureParser :: a -> Parser e s a
pureParser a = Parser
(\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))
upcastUnitSuccess :: (# Int#, Int# #) -> Result# e ()
upcastUnitSuccess (# b, c #) = (# | (# (), b, c #) #)
upcastWordResult :: Result# e Word# -> Result# e Word
upcastWordResult (# e | #) = (# e | #)
upcastWordResult (# | (# a, b, c #) #) = (# | (# W# a, b, c #) #)
upcastWord16Result :: Result# e Word# -> Result# e Word16
upcastWord16Result (# e | #) = (# e | #)
upcastWord16Result (# | (# a, b, c #) #) = (# | (# W16# a, b, c #) #)
upcastWord32Result :: Result# e Word# -> Result# e Word32
upcastWord32Result (# e | #) = (# e | #)
upcastWord32Result (# | (# a, b, c #) #) = (# | (# W32# a, b, c #) #)
upcastWord8Result :: Result# e Word# -> Result# e Word8
upcastWord8Result (# e | #) = (# e | #)
upcastWord8Result (# | (# a, b, c #) #) = (# | (# W8# a, b, c #) #)
c2w :: Char -> Word8
c2w = fromIntegral . ord
cursor :: Parser e s Int
cursor = uneffectful $ \chunk ->
Success (offset chunk) (offset chunk) (length chunk)
expose :: Parser e s ByteArray
expose = uneffectful $ \chunk ->
Success (array chunk) (offset chunk) (length chunk)
unconsume :: Int -> Parser e s ()
unconsume n = uneffectful $ \chunk ->
Success () (offset chunk - n) (length chunk + n)
uneffectful :: (Bytes -> Result e a) -> Parser e s a
{-# inline uneffectful #-}
uneffectful f = Parser
( \b s0 -> (# s0, unboxResult (f (boxBytes b)) #) )
uneffectful# :: (Bytes -> Result# e a) -> Parser e s a
uneffectful# f = Parser
( \b s0 -> (# s0, (f (boxBytes b)) #) )
uneffectfulWord# :: (Bytes -> Result# e Word#) -> Parser e s Word#
uneffectfulWord# f = Parser
( \b s0 -> (# s0, (f (boxBytes b)) #) )
effect :: ST s a -> Parser e s a
effect (ST f) = Parser
( \(# _, off, len #) s0 -> case f s0 of
(# s1, a #) -> (# s1, (# | (# a, off, len #) #) #)
)
ascii :: e -> Char -> Parser e s ()
ascii e !c = uneffectful $ \chunk -> if length chunk > 0
then if PM.indexByteArray (array chunk) (offset chunk) == c2w c
then Success () (offset chunk + 1) (length chunk - 1)
else Failure e
else Failure e
ascii3 :: e -> Char -> Char -> Char -> Parser e s ()
ascii3 e !c0 !c1 !c2 = uneffectful $ \chunk ->
if | length chunk > 2
, PM.indexByteArray (array chunk) (offset chunk) == c2w c0
, PM.indexByteArray (array chunk) (offset chunk + 1) == c2w c1
, PM.indexByteArray (array chunk) (offset chunk + 2) == c2w c2
-> Success () (offset chunk + 3) (length chunk - 3)
| otherwise -> Failure e
ascii4 :: e -> Char -> Char -> Char -> Char -> Parser e s ()
ascii4 e !c0 !c1 !c2 !c3 = uneffectful $ \chunk ->
if | length chunk > 3
, PM.indexByteArray (array chunk) (offset chunk) == c2w c0
, PM.indexByteArray (array chunk) (offset chunk + 1) == c2w c1
, PM.indexByteArray (array chunk) (offset chunk + 2) == c2w c2
, PM.indexByteArray (array chunk) (offset chunk + 3) == c2w c3
-> Success () (offset chunk + 4) (length chunk - 4)
| otherwise -> Failure e
fail ::
e
-> Parser e s a
fail e = uneffectful $ \_ -> Failure e
peekAnyAscii :: e -> Parser e s Char
peekAnyAscii e = uneffectful $ \chunk -> if length chunk > 0
then
let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8
in if w < 128
then Success
(C# (chr# (unI (fromIntegral w))))
(offset chunk)
(length chunk)
else Failure e
else Failure e
any :: e -> Parser e s Word8
{-# inline any #-}
any e = uneffectful $ \chunk -> if length chunk > 0
then
let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8
in Success w (offset chunk + 1) (length chunk - 1)
else Failure e
anyUnsafe :: Parser e s Word8
{-# inline anyUnsafe #-}
anyUnsafe = uneffectful $ \chunk ->
let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8
in Success w (offset chunk + 1) (length chunk - 1)
anyAscii :: e -> Parser e s Char
{-# inline anyAscii #-}
anyAscii e = uneffectful $ \chunk -> if length chunk > 0
then
let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8
in if w < 128
then Success
(C# (chr# (unI (fromIntegral w))))
(offset chunk + 1)
(length chunk - 1)
else Failure e
else Failure e
anyAscii# :: e -> Parser e s Char#
{-# inline anyAscii# #-}
anyAscii# e = Parser
(\(# arr, off, len #) s0 -> case len of
0# -> (# s0, (# e | #) #)
_ ->
let !w = indexCharArray# arr off
in case ord# w <# 128# of
1# -> (# s0, (# | (# w, off +# 1#, len -# 1# #) #) #)
_ -> (# s0, (# e | #) #)
)
anyUtf8# :: e -> Parser e s Char#
{-# noinline anyUtf8# #-}
anyUtf8# e = Parser
(\(# arr, off, len #) s0 -> case len ># 0# of
1# ->
let !w0 = indexWord8Array# arr off
in if | oneByteChar (W8# w0) ->
(# s0, (# | (# chr# (word2Int# w0), off +# 1#, len -# 1# #) #) #)
| twoByteChar (W8# w0) ->
if | I# len > 1
, w1 <- indexWord8Array# arr (off +# 1#)
, followingByte (W8# w1)
, C# c <- codepointFromTwoBytes (W8# w0) (W8# w1)
-> (# s0, (# | (# c, off +# 2#, len -# 2# #) #) #)
| otherwise -> (# s0, (# e | #) #)
| threeByteChar (W8# w0) ->
if | I# len > 2
, w1 <- indexWord8Array# arr (off +# 1# )
, w2 <- indexWord8Array# arr (off +# 2# )
, followingByte (W8# w1)
, !c@(C# c#) <- codepointFromThreeBytes (W8# w0) (W8# w1) (W8# w2)
, c < '\xD800' || c > '\xDFFF'
-> (# s0, (# | (# c#, off +# 3#, len -# 3# #) #) #)
| otherwise -> (# s0, (# e | #) #)
| fourByteChar (W8# w0) ->
if | I# len > 3
, w1 <- indexWord8Array# arr (off +# 1# )
, w2 <- indexWord8Array# arr (off +# 2# )
, w3 <- indexWord8Array# arr (off +# 3# )
, followingByte (W8# w1)
, !(C# c#) <- codepointFromFourBytes (W8# w0) (W8# w1) (W8# w2) (W8# w3)
-> (# s0, (# | (# c#, off +# 4#, len -# 4# #) #) #)
| otherwise -> (# s0, (# e | #) #)
| otherwise -> (# s0, (# e | #) #)
_ -> (# s0, (# e | #) #)
)
anyAsciiOpt :: e -> Parser e s (Maybe Char)
{-# inline anyAsciiOpt #-}
anyAsciiOpt e = uneffectful $ \chunk -> if length chunk > 0
then
let w = PM.indexByteArray (array chunk) (offset chunk) :: Word8
in if w < 128
then Success
(Just (C# (chr# (unI (fromIntegral w)))))
(offset chunk + 1)
(length chunk - 1)
else Failure e
else Success Nothing (offset chunk) (length chunk)
skipWhile :: (Word8 -> Bool) -> Parser e s ()
{-# inline skipWhile #-}
skipWhile f = go where
go = isEndOfInput >>= \case
True -> pure ()
False -> do
w <- anyUnsafe
if f w
then go
else unconsume 1
hexWord16 :: e -> Parser e s Word16
{-# inline hexWord16 #-}
hexWord16 e = Parser
(\x s0 -> case runParser (hexWord16# e) x s0 of
(# s1, r #) -> case r of
(# err | #) -> (# s1, (# err | #) #)
(# | (# a, b, c #) #) -> (# s1, (# | (# W16# a, b, c #) #) #)
)
hexWord16# :: e -> Parser e s Word#
{-# noinline hexWord16# #-}
hexWord16# e = uneffectfulWord# $ \chunk -> if length chunk >= 4
then
let !w0@(W# n0) = oneHex $ PM.indexByteArray (array chunk) (offset chunk)
!w1@(W# n1) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 1)
!w2@(W# n2) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 2)
!w3@(W# n3) = oneHex $ PM.indexByteArray (array chunk) (offset chunk + 3)
in if | w0 .|. w1 .|. w2 .|. w3 /= maxBound ->
(# |
(# (n0 `timesWord#` 4096##) `plusWord#`
(n1 `timesWord#` 256##) `plusWord#`
(n2 `timesWord#` 16##) `plusWord#`
n3
, unI (offset chunk) +# 4#
, unI (length chunk) -# 4# #) #)
| otherwise -> (# e | #)
else (# e | #)
oneHex :: Word8 -> Word
oneHex w
| w >= 48 && w < 58 = (fromIntegral w - 48)
| w >= 65 && w < 71 = (fromIntegral w - 55)
| w >= 97 && w < 103 = (fromIntegral w - 87)
| otherwise = maxBound
skipDigitsAscii :: Parser e s ()
skipDigitsAscii = uneffectful# $ \c ->
upcastUnitSuccess (skipDigitsAsciiLoop c)
skipDigitsAscii1 :: e -> Parser e s ()
skipDigitsAscii1 e = uneffectful# $ \c ->
skipDigitsAscii1LoopStart e c
skipAlphaAscii :: Parser e s ()
skipAlphaAscii = uneffectful# $ \c ->
upcastUnitSuccess (skipAlphaAsciiLoop c)
skipAlphaAscii1 :: e -> Parser e s ()
skipAlphaAscii1 e = uneffectful# $ \c ->
skipAlphaAsciiLoop1Start e c
skipAscii :: Char -> Parser e s ()
skipAscii !w = uneffectful# $ \c ->
upcastUnitSuccess (skipLoop (c2w w) c)
skipAscii1 :: e -> Char -> Parser e s ()
skipAscii1 e !w = uneffectful# $ \c ->
skipLoop1Start e (c2w w) c
skipDigitsAsciiLoop ::
Bytes
-> (# Int#, Int# #)
skipDigitsAsciiLoop !c = if length c > 0
then
let w = PM.indexByteArray (array c) (offset c) :: Word8
in if w >= c2w '0' && w <= c2w '9'
then skipDigitsAsciiLoop (advance 1 c)
else (# unI (offset c), unI (length c) #)
else (# unI (offset c), unI (length c) #)
skipAlphaAsciiLoop ::
Bytes
-> (# Int#, Int# #)
skipAlphaAsciiLoop !c = if length c > 0
then
let w = PM.indexByteArray (array c) (offset c) :: Word8
in if (w >= c2w 'a' && w <= c2w 'z') || (w >= c2w 'A' && w <= c2w 'Z')
then skipAlphaAsciiLoop (advance 1 c)
else (# unI (offset c), unI (length c) #)
else (# unI (offset c), unI (length c) #)
skipAlphaAsciiLoop1Start ::
e
-> Bytes
-> Result# e ()
skipAlphaAsciiLoop1Start e !c = if length c > 0
then
let w = PM.indexByteArray (array c) (offset c) :: Word8
in if (w >= c2w 'a' && w <= c2w 'z') || (w >= c2w 'A' && w <= c2w 'Z')
then upcastUnitSuccess (skipAlphaAsciiLoop (advance 1 c))
else (# e | #)
else (# e | #)
skipDigitsAscii1LoopStart ::
e
-> Bytes
-> Result# e ()
skipDigitsAscii1LoopStart e !c = if length c > 0
then
let w = PM.indexByteArray (array c) (offset c) :: Word8
in if w >= c2w '0' && w <= c2w '9'
then upcastUnitSuccess (skipDigitsAsciiLoop (advance 1 c))
else (# e | #)
else (# e | #)
skipLoop ::
Word8
-> Bytes
-> (# Int#, Int# #)
skipLoop !w !c = if length c > 0
then if PM.indexByteArray (array c) (offset c) == w
then skipLoop w (advance 1 c)
else (# unI (offset c), unI (length c) #)
else (# unI (offset c), unI (length c) #)
skipLoop1Start ::
e
-> Word8
-> Bytes
-> Result# e ()
skipLoop1Start e !w !chunk0 = if length chunk0 > 0
then if PM.indexByteArray (array chunk0) (offset chunk0) == w
then upcastUnitSuccess (skipLoop w (advance 1 chunk0))
else (# e | #)
else (# e | #)
skipUntilAsciiConsume :: e -> Char -> Parser e s ()
skipUntilAsciiConsume e !w = uneffectful# $ \c ->
skipUntilConsumeLoop e (c2w w) c
skipUntilConsumeLoop ::
e
-> Word8
-> Bytes
-> Result# e ()
skipUntilConsumeLoop e !w !c = if length c > 0
then if PM.indexByteArray (array c) (offset c) /= w
then skipUntilConsumeLoop e w (advance 1 c)
else (# | (# (), unI (offset c + 1), unI (length c - 1) #) #)
else (# e | #)
endOfInput :: e -> Parser e s ()
endOfInput e = uneffectful $ \chunk -> if length chunk == 0
then Success () (offset chunk) 0
else Failure e
isEndOfInput :: Parser e s Bool
isEndOfInput = uneffectful $ \chunk ->
Success (length chunk == 0) (offset chunk) (length chunk)
decWord8 :: e -> Parser e s Word8
decWord8 e = Parser
(\chunk0 s0 -> case decSmallWordStart e 256 (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWord8Result r #)
)
decWord16 :: e -> Parser e s Word16
decWord16 e = Parser
(\chunk0 s0 -> case decSmallWordStart e 65536 (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWord16Result r #)
)
decWord32 :: e -> Parser e s Word32
decWord32 e = Parser
(\chunk0 s0 -> case decSmallWordStart e 4294967296 (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWord32Result r #)
)
decWord :: e -> Parser e s Word
decWord e = Parser
(\chunk0 s0 -> case decWordStart e (boxBytes chunk0) s0 of
(# s1, r #) -> (# s1, upcastWordResult r #)
)
decPositiveInteger :: e -> Parser e s Integer
decPositiveInteger e = Parser
(\chunk0 s0 -> decPositiveIntegerStart e (boxBytes chunk0) s0)
decWordStart ::
e
-> Bytes
-> ST# s (Result# e Word# )
decWordStart e !chunk0 s0 = if length chunk0 > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then (# s0, decWordMore e w (advance 1 chunk0) #)
else (# s0, (# e | #) #)
else (# s0, (# e | #) #)
decPositiveIntegerStart ::
e
-> Bytes
-> ST# s (Result# e Integer)
decPositiveIntegerStart e !chunk0 s0 = if length chunk0 > 0
then
let !w = (PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < (10 :: Word8)
then (# s0, decIntegerMore e (fromIntegral w) (advance 1 chunk0) #)
else (# s0, (# e | #) #)
else (# s0, (# e | #) #)
decSmallWordStart ::
e
-> Word
-> Bytes
-> ST# s (Result# e Word# )
decSmallWordStart e !limit !chunk0 s0 = if length chunk0 > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then (# s0, decSmallWordMore e w limit (advance 1 chunk0) #)
else (# s0, (# e | #) #)
else (# s0, (# e | #) #)
decWordMore ::
e
-> Word
-> Bytes
-> Result# e Word#
decWordMore e !acc !chunk0 = if length chunk0 > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then decWordMore e (acc * 10 + w)
(advance 1 chunk0)
else (# | (# unW acc, unI (offset chunk0), unI (length chunk0) #) #)
else (# | (# unW acc, unI (offset chunk0), 0# #) #)
decSmallWordMore ::
e
-> Word
-> Word
-> Bytes
-> Result# e Word#
decSmallWordMore e !acc !limit !chunk0 = if length chunk0 > 0
then
let !w = fromIntegral @Word8 @Word
(PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then
let w' = acc * 10 + w
in if w' < limit
then decSmallWordMore e w' limit (advance 1 chunk0)
else (# e | #)
else (# | (# unW acc, unI (offset chunk0), unI (length chunk0) #) #)
else (# | (# unW acc, unI (offset chunk0), 0# #) #)
decIntegerMore ::
e
-> Integer
-> Bytes
-> Result# e Integer
decIntegerMore e !acc !chunk0 = if length chunk0 > 0
then
let w :: Word8
!w = (PM.indexByteArray (array chunk0) (offset chunk0)) - 48
in if w < 10
then
let w' = acc * 10 + fromIntegral w
in decIntegerMore e w' (advance 1 chunk0)
else (# | (# acc, unI (offset chunk0), unI (length chunk0) #) #)
else (# | (# acc, unI (offset chunk0), 0# #) #)
advance :: Int -> Bytes -> Bytes
advance n (Bytes arr off len) = Bytes arr (off + n) (len - n)
unW :: Word -> Word#
unW (W# w) = w
unI :: Int -> Int#
unI (I# w) = w
boxBytes :: Bytes# -> Bytes
boxBytes (# a, b, c #) = Bytes (ByteArray a) (I# b) (I# c)
unboxBytes :: Bytes -> Bytes#
unboxBytes (Bytes (ByteArray a) (I# b) (I# c)) = (# a,b,c #)
unboxResult :: Result e a -> Result# e a
unboxResult (Success a (I# b) (I# c)) = (# | (# a, b, c #) #)
unboxResult (Failure e) = (# e | #)
boxResult :: Result# e a -> Result e a
boxResult (# | (# a, b, c #) #) = Success a (I# b) (I# c)
boxResult (# e | #) = Failure e
unboxWord32 :: Parser s e Word32 -> Parser s e Word#
unboxWord32 (Parser f) = Parser
(\x s0 -> case f x s0 of
(# s1, r #) -> case r of
(# e | #) -> (# s1, (# e | #) #)
(# | (# W32# a, b, c #) #) -> (# s1, (# | (# a, b, c #) #) #)
)
boxWord32 :: Parser s e Word# -> Parser s e Word32
boxWord32 (Parser f) = Parser
(\x s0 -> case f x s0 of
(# s1, r #) -> case r of
(# e | #) -> (# s1, (# e | #) #)
(# | (# a, b, c #) #) -> (# s1, (# | (# W32# a, b, c #) #) #)
)
orElse :: Parser s e a -> Parser s e a -> Parser s e a
orElse (Parser f) (Parser g) = Parser
(\x s0 -> case f x s0 of
(# s1, r0 #) -> case r0 of
(# _ | #) -> g x s1
(# | r #) -> (# s1, (# | r #) #)
)
codepointFromFourBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Char
codepointFromFourBytes w1 w2 w3 w4 = C#
( chr#
( unI $ fromIntegral
( unsafeShiftL (word8ToWord w1 .&. 0b00001111) 18 .|.
unsafeShiftL (word8ToWord w2 .&. 0b00111111) 12 .|.
unsafeShiftL (word8ToWord w3 .&. 0b00111111) 6 .|.
(word8ToWord w4 .&. 0b00111111)
)
)
)
codepointFromThreeBytes :: Word8 -> Word8 -> Word8 -> Char
codepointFromThreeBytes w1 w2 w3 = C#
( chr#
( unI $ fromIntegral
( unsafeShiftL (word8ToWord w1 .&. 0b00001111) 12 .|.
unsafeShiftL (word8ToWord w2 .&. 0b00111111) 6 .|.
(word8ToWord w3 .&. 0b00111111)
)
)
)
codepointFromTwoBytes :: Word8 -> Word8 -> Char
codepointFromTwoBytes w1 w2 = C#
( chr#
( unI $ fromIntegral @Word @Int
( unsafeShiftL (word8ToWord w1 .&. 0b00011111) 6 .|.
(word8ToWord w2 .&. 0b00111111)
)
)
)
oneByteChar :: Word8 -> Bool
oneByteChar !w = w .&. 0b10000000 == 0
twoByteChar :: Word8 -> Bool
twoByteChar !w = w .&. 0b11100000 == 0b11000000
threeByteChar :: Word8 -> Bool
threeByteChar !w = w .&. 0b11110000 == 0b11100000
fourByteChar :: Word8 -> Bool
fourByteChar !w = w .&. 0b11111000 == 0b11110000
word8ToWord :: Word8 -> Word
word8ToWord = fromIntegral
followingByte :: Word8 -> Bool
followingByte !w = xor w 0b01000000 .&. 0b11000000 == 0b11000000
bindChar :: Parser s e Char# -> (Char# -> Parser s e a) -> Parser s e a
{-# inline bindChar #-}
bindChar (Parser f) g = Parser
(\x@(# arr, _, _ #) s0 -> case f x s0 of
(# s1, r0 #) -> case r0 of
(# e | #) -> (# s1, (# e | #) #)
(# | (# y, b, c #) #) ->
runParser (g y) (# arr, b, c #) s1
)