{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Ascii.Internal where
import Control.DeepSeq (NFData)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.CaseInsensitive (FoldCase (foldCase))
import Data.Char (chr, isAscii)
import Data.Coerce (coerce)
import Data.Hashable (Hashable)
import qualified Data.List.NonEmpty as NE
import Data.Word (Word8)
import GHC.Exts (IsList (Item, fromList, fromListN, toList))
import Numeric (showHex)
import Optics.AffineTraversal (An_AffineTraversal, atraversal)
import Optics.At.Core (Index, IxValue, Ixed (IxKind, ix))
import Text.Megaparsec.Stream
( Stream
( Token,
Tokens,
chunkLength,
chunkToTokens,
take1_,
takeN_,
takeWhile_,
tokenToChunk,
tokensToChunk
),
TraversableStream (reachOffset),
VisualStream (showTokens),
)
import Type.Reflection (Typeable)
newtype AsciiChar = AsciiChar {AsciiChar -> Word8
toByte :: Word8}
deriving
(
AsciiChar -> AsciiChar -> Bool
(AsciiChar -> AsciiChar -> Bool)
-> (AsciiChar -> AsciiChar -> Bool) -> Eq AsciiChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsciiChar -> AsciiChar -> Bool
$c/= :: AsciiChar -> AsciiChar -> Bool
== :: AsciiChar -> AsciiChar -> Bool
$c== :: AsciiChar -> AsciiChar -> Bool
Eq,
Eq AsciiChar
Eq AsciiChar
-> (AsciiChar -> AsciiChar -> Ordering)
-> (AsciiChar -> AsciiChar -> Bool)
-> (AsciiChar -> AsciiChar -> Bool)
-> (AsciiChar -> AsciiChar -> Bool)
-> (AsciiChar -> AsciiChar -> Bool)
-> (AsciiChar -> AsciiChar -> AsciiChar)
-> (AsciiChar -> AsciiChar -> AsciiChar)
-> Ord AsciiChar
AsciiChar -> AsciiChar -> Bool
AsciiChar -> AsciiChar -> Ordering
AsciiChar -> AsciiChar -> AsciiChar
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
min :: AsciiChar -> AsciiChar -> AsciiChar
$cmin :: AsciiChar -> AsciiChar -> AsciiChar
max :: AsciiChar -> AsciiChar -> AsciiChar
$cmax :: AsciiChar -> AsciiChar -> AsciiChar
>= :: AsciiChar -> AsciiChar -> Bool
$c>= :: AsciiChar -> AsciiChar -> Bool
> :: AsciiChar -> AsciiChar -> Bool
$c> :: AsciiChar -> AsciiChar -> Bool
<= :: AsciiChar -> AsciiChar -> Bool
$c<= :: AsciiChar -> AsciiChar -> Bool
< :: AsciiChar -> AsciiChar -> Bool
$c< :: AsciiChar -> AsciiChar -> Bool
compare :: AsciiChar -> AsciiChar -> Ordering
$ccompare :: AsciiChar -> AsciiChar -> Ordering
Ord,
Int -> AsciiChar -> Int
AsciiChar -> Int
(Int -> AsciiChar -> Int)
-> (AsciiChar -> Int) -> Hashable AsciiChar
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: AsciiChar -> Int
$chash :: AsciiChar -> Int
hashWithSalt :: Int -> AsciiChar -> Int
$chashWithSalt :: Int -> AsciiChar -> Int
Hashable,
AsciiChar -> ()
(AsciiChar -> ()) -> NFData AsciiChar
forall a. (a -> ()) -> NFData a
rnf :: AsciiChar -> ()
$crnf :: AsciiChar -> ()
NFData
)
via Word8
deriving stock
(
Typeable
)
instance Show AsciiChar where
{-# INLINEABLE show #-}
show :: AsciiChar -> String
show (AsciiChar Word8
w8) = String
"'0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
w8 String
"'"
instance Bounded AsciiChar where
{-# INLINEABLE minBound #-}
minBound :: AsciiChar
minBound = Word8 -> AsciiChar
AsciiChar Word8
0
{-# INLINEABLE maxBound #-}
maxBound :: AsciiChar
maxBound = Word8 -> AsciiChar
AsciiChar Word8
127
instance FoldCase AsciiChar where
{-# INLINEABLE foldCase #-}
foldCase :: AsciiChar -> AsciiChar
foldCase ac :: AsciiChar
ac@(AsciiChar Word8
w8)
| Word8
65 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8 Bool -> Bool -> Bool
&& Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
90 = Word8 -> AsciiChar
AsciiChar (Word8
w8 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32)
| Bool
otherwise = AsciiChar
ac
pattern AsByte :: Word8 -> AsciiChar
pattern $mAsByte :: forall {r}. AsciiChar -> (Word8 -> r) -> ((# #) -> r) -> r
AsByte w8 <- AsciiChar w8
pattern AsChar :: Char -> AsciiChar
pattern $mAsChar :: forall {r}. AsciiChar -> (Char -> r) -> ((# #) -> r) -> r
AsChar c <- AsciiChar (isJustAscii -> Just c)
{-# COMPLETE AsByte #-}
{-# COMPLETE AsChar #-}
newtype AsciiText = AsciiText ByteString
deriving
(
AsciiText -> AsciiText -> Bool
(AsciiText -> AsciiText -> Bool)
-> (AsciiText -> AsciiText -> Bool) -> Eq AsciiText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsciiText -> AsciiText -> Bool
$c/= :: AsciiText -> AsciiText -> Bool
== :: AsciiText -> AsciiText -> Bool
$c== :: AsciiText -> AsciiText -> Bool
Eq,
Eq AsciiText
Eq AsciiText
-> (AsciiText -> AsciiText -> Ordering)
-> (AsciiText -> AsciiText -> Bool)
-> (AsciiText -> AsciiText -> Bool)
-> (AsciiText -> AsciiText -> Bool)
-> (AsciiText -> AsciiText -> Bool)
-> (AsciiText -> AsciiText -> AsciiText)
-> (AsciiText -> AsciiText -> AsciiText)
-> Ord AsciiText
AsciiText -> AsciiText -> Bool
AsciiText -> AsciiText -> Ordering
AsciiText -> AsciiText -> AsciiText
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
min :: AsciiText -> AsciiText -> AsciiText
$cmin :: AsciiText -> AsciiText -> AsciiText
max :: AsciiText -> AsciiText -> AsciiText
$cmax :: AsciiText -> AsciiText -> AsciiText
>= :: AsciiText -> AsciiText -> Bool
$c>= :: AsciiText -> AsciiText -> Bool
> :: AsciiText -> AsciiText -> Bool
$c> :: AsciiText -> AsciiText -> Bool
<= :: AsciiText -> AsciiText -> Bool
$c<= :: AsciiText -> AsciiText -> Bool
< :: AsciiText -> AsciiText -> Bool
$c< :: AsciiText -> AsciiText -> Bool
compare :: AsciiText -> AsciiText -> Ordering
$ccompare :: AsciiText -> AsciiText -> Ordering
Ord,
AsciiText -> ()
(AsciiText -> ()) -> NFData AsciiText
forall a. (a -> ()) -> NFData a
rnf :: AsciiText -> ()
$crnf :: AsciiText -> ()
NFData,
NonEmpty AsciiText -> AsciiText
AsciiText -> AsciiText -> AsciiText
(AsciiText -> AsciiText -> AsciiText)
-> (NonEmpty AsciiText -> AsciiText)
-> (forall b. Integral b => b -> AsciiText -> AsciiText)
-> Semigroup AsciiText
forall b. Integral b => b -> AsciiText -> AsciiText
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> AsciiText -> AsciiText
$cstimes :: forall b. Integral b => b -> AsciiText -> AsciiText
sconcat :: NonEmpty AsciiText -> AsciiText
$csconcat :: NonEmpty AsciiText -> AsciiText
<> :: AsciiText -> AsciiText -> AsciiText
$c<> :: AsciiText -> AsciiText -> AsciiText
Semigroup,
Semigroup AsciiText
AsciiText
Semigroup AsciiText
-> AsciiText
-> (AsciiText -> AsciiText -> AsciiText)
-> ([AsciiText] -> AsciiText)
-> Monoid AsciiText
[AsciiText] -> AsciiText
AsciiText -> AsciiText -> AsciiText
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [AsciiText] -> AsciiText
$cmconcat :: [AsciiText] -> AsciiText
mappend :: AsciiText -> AsciiText -> AsciiText
$cmappend :: AsciiText -> AsciiText -> AsciiText
mempty :: AsciiText
$cmempty :: AsciiText
Monoid,
Int -> AsciiText -> ShowS
[AsciiText] -> ShowS
AsciiText -> String
(Int -> AsciiText -> ShowS)
-> (AsciiText -> String)
-> ([AsciiText] -> ShowS)
-> Show AsciiText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsciiText] -> ShowS
$cshowList :: [AsciiText] -> ShowS
show :: AsciiText -> String
$cshow :: AsciiText -> String
showsPrec :: Int -> AsciiText -> ShowS
$cshowsPrec :: Int -> AsciiText -> ShowS
Show
)
via ByteString
instance IsList AsciiText where
type Item AsciiText = AsciiChar
{-# INLINEABLE fromList #-}
fromList :: [Item AsciiText] -> AsciiText
fromList =
forall a b. Coercible a b => a -> b
coerce @ByteString @AsciiText
(ByteString -> AsciiText)
-> ([AsciiChar] -> ByteString) -> [AsciiChar] -> AsciiText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
forall l. IsList l => [Item l] -> l
fromList
([Word8] -> ByteString)
-> ([AsciiChar] -> [Word8]) -> [AsciiChar] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
coerce @[AsciiChar] @[Word8]
{-# INLINEABLE fromListN #-}
fromListN :: Int -> [Item AsciiText] -> AsciiText
fromListN Int
n =
forall a b. Coercible a b => a -> b
coerce @ByteString @AsciiText
(ByteString -> AsciiText)
-> ([AsciiChar] -> ByteString) -> [AsciiChar] -> AsciiText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Item ByteString] -> ByteString
forall l. IsList l => Int -> [Item l] -> l
fromListN Int
n
([Word8] -> ByteString)
-> ([AsciiChar] -> [Word8]) -> [AsciiChar] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
coerce @[AsciiChar] @[Word8]
{-# INLINEABLE toList #-}
toList :: AsciiText -> [Item AsciiText]
toList = [Word8] -> [AsciiChar]
coerce ([Word8] -> [AsciiChar])
-> (AsciiText -> [Word8]) -> AsciiText -> [AsciiChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
forall l. IsList l => l -> [Item l]
toList (ByteString -> [Word8])
-> (AsciiText -> ByteString) -> AsciiText -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
coerce @AsciiText @ByteString
type instance Index AsciiText = Int
type instance IxValue AsciiText = AsciiChar
instance Ixed AsciiText where
type IxKind AsciiText = An_AffineTraversal
{-# INLINEABLE ix #-}
ix :: Index AsciiText
-> Optic' (IxKind AsciiText) NoIx AsciiText (IxValue AsciiText)
ix Index AsciiText
i = (AsciiText -> Either AsciiText AsciiChar)
-> (AsciiText -> AsciiChar -> AsciiText)
-> AffineTraversal AsciiText AsciiText AsciiChar AsciiChar
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal AsciiText -> Either AsciiText AsciiChar
get AsciiText -> AsciiChar -> AsciiText
put
where
get :: AsciiText -> Either AsciiText AsciiChar
get :: AsciiText -> Either AsciiText AsciiChar
get (AsciiText ByteString
at) = case ByteString
at ByteString -> Int -> Maybe Word8
BS.!? Int
Index AsciiText
i of
Maybe Word8
Nothing -> AsciiText -> Either AsciiText AsciiChar
forall a b. a -> Either a b
Left (AsciiText -> Either AsciiText AsciiChar)
-> (ByteString -> AsciiText)
-> ByteString
-> Either AsciiText AsciiChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AsciiText
AsciiText (ByteString -> Either AsciiText AsciiChar)
-> ByteString -> Either AsciiText AsciiChar
forall a b. (a -> b) -> a -> b
$ ByteString
at
Just Word8
w8 -> AsciiChar -> Either AsciiText AsciiChar
forall a b. b -> Either a b
Right (AsciiChar -> Either AsciiText AsciiChar)
-> (Word8 -> AsciiChar) -> Word8 -> Either AsciiText AsciiChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> AsciiChar
AsciiChar (Word8 -> Either AsciiText AsciiChar)
-> Word8 -> Either AsciiText AsciiChar
forall a b. (a -> b) -> a -> b
$ Word8
w8
put :: AsciiText -> AsciiChar -> AsciiText
put :: AsciiText -> AsciiChar -> AsciiText
put (AsciiText ByteString
at) (AsciiChar Word8
ac) = case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
Index AsciiText
i ByteString
at of
(ByteString
lead, ByteString
end) -> case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
end of
Maybe (Word8, ByteString)
Nothing -> ByteString -> AsciiText
AsciiText ByteString
at
Just (Word8
_, ByteString
end') -> ByteString -> AsciiText
AsciiText (ByteString
lead ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BS.singleton Word8
ac ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
end')
instance FoldCase AsciiText where
{-# INLINEABLE foldCase #-}
foldCase :: AsciiText -> AsciiText
foldCase (AsciiText ByteString
bs) = ByteString -> AsciiText
AsciiText (ByteString -> AsciiText)
-> (ByteString -> ByteString) -> ByteString -> AsciiText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> ByteString -> ByteString
BS.map Word8 -> Word8
go (ByteString -> AsciiText) -> ByteString -> AsciiText
forall a b. (a -> b) -> a -> b
$ ByteString
bs
where
go :: Word8 -> Word8
go :: Word8 -> Word8
go Word8
w8
| Word8
65 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8 Bool -> Bool -> Bool
&& Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
90 = Word8
w8 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32
| Bool
otherwise = Word8
w8
instance Stream AsciiText where
type Token AsciiText = AsciiChar
type Tokens AsciiText = AsciiText
{-# INLINEABLE tokenToChunk #-}
tokenToChunk :: Proxy AsciiText -> Token AsciiText -> Tokens AsciiText
tokenToChunk Proxy AsciiText
_ = (Word8 -> ByteString) -> AsciiChar -> AsciiText
coerce Word8 -> ByteString
BS.singleton
{-# INLINEABLE tokensToChunk #-}
tokensToChunk :: Proxy AsciiText -> [Token AsciiText] -> Tokens AsciiText
tokensToChunk Proxy AsciiText
_ = [Token AsciiText] -> Tokens AsciiText
forall l. IsList l => [Item l] -> l
fromList
{-# INLINEABLE chunkToTokens #-}
chunkToTokens :: Proxy AsciiText -> Tokens AsciiText -> [Token AsciiText]
chunkToTokens Proxy AsciiText
_ = Tokens AsciiText -> [Token AsciiText]
forall l. IsList l => l -> [Item l]
toList
{-# INLINEABLE chunkLength #-}
chunkLength :: Proxy AsciiText -> Tokens AsciiText -> Int
chunkLength Proxy AsciiText
_ = (ByteString -> Int) -> AsciiText -> Int
coerce ByteString -> Int
BS.length
{-# INLINEABLE take1_ #-}
take1_ :: AsciiText -> Maybe (Token AsciiText, AsciiText)
take1_ = (ByteString -> Maybe (Word8, ByteString))
-> AsciiText -> Maybe (AsciiChar, AsciiText)
coerce ByteString -> Maybe (Word8, ByteString)
BS.uncons
{-# INLINEABLE takeN_ #-}
takeN_ :: Int -> AsciiText -> Maybe (Tokens AsciiText, AsciiText)
takeN_ Int
n at :: AsciiText
at@(AsciiText ByteString
bs)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (AsciiText, AsciiText) -> Maybe (AsciiText, AsciiText)
forall a. a -> Maybe a
Just (ByteString -> AsciiText
coerce ByteString
BS.empty, AsciiText
at)
| ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe (Tokens AsciiText, AsciiText)
forall a. Maybe a
Nothing
| Bool
otherwise = (AsciiText, AsciiText) -> Maybe (Tokens AsciiText, AsciiText)
forall a. a -> Maybe a
Just ((AsciiText, AsciiText) -> Maybe (Tokens AsciiText, AsciiText))
-> (ByteString -> (AsciiText, AsciiText))
-> ByteString
-> Maybe (Tokens AsciiText, AsciiText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> (AsciiText, AsciiText)
coerce ((ByteString, ByteString) -> (AsciiText, AsciiText))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (AsciiText, AsciiText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
n (ByteString -> Maybe (Tokens AsciiText, AsciiText))
-> ByteString -> Maybe (Tokens AsciiText, AsciiText)
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINEABLE takeWhile_ #-}
takeWhile_ :: (Token AsciiText -> Bool)
-> AsciiText -> (Tokens AsciiText, AsciiText)
takeWhile_ = ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString))
-> (AsciiChar -> Bool) -> AsciiText -> (AsciiText, AsciiText)
coerce (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span
instance VisualStream AsciiText where
{-# INLINEABLE showTokens #-}
showTokens :: Proxy AsciiText -> NonEmpty (Token AsciiText) -> String
showTokens Proxy AsciiText
_ = (Word8 -> Char) -> [Word8] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String)
-> (NonEmpty AsciiChar -> [Word8]) -> NonEmpty AsciiChar -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
coerce @_ @[Word8] ([AsciiChar] -> [Word8])
-> (NonEmpty AsciiChar -> [AsciiChar])
-> NonEmpty AsciiChar
-> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty AsciiChar -> [AsciiChar]
forall a. NonEmpty a -> [a]
NE.toList
instance TraversableStream AsciiText where
{-# INLINEABLE reachOffset #-}
reachOffset :: Int -> PosState AsciiText -> (Maybe String, PosState AsciiText)
reachOffset Int
o PosState AsciiText
ps = (Maybe String, PosState AsciiText)
-> (Maybe String, PosState AsciiText)
coerce (Int -> PosState AsciiText -> (Maybe String, PosState AsciiText)
forall s.
TraversableStream s =>
Int -> PosState s -> (Maybe String, PosState s)
reachOffset Int
o PosState AsciiText
ps)
isJustAscii :: Word8 -> Maybe Char
isJustAscii :: Word8 -> Maybe Char
isJustAscii Word8
w8 =
if Char -> Bool
isAscii Char
asChar
then Char -> Maybe Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
asChar
else Maybe Char
forall a. Maybe a
Nothing
where
asChar :: Char
asChar :: Char
asChar = Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ Word8
w8