{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Text.Megaparsec.Stream
( Stream (..),
ShareInput (..),
NoShareInput (..),
VisualStream (..),
TraversableStream (..),
)
where
import Data.Bifunctor (second)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Char (chr)
import Data.Foldable (foldl', toList)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import Data.Proxy
import qualified Data.Sequence as S
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Word (Word8)
import Text.Megaparsec.Pos
import Text.Megaparsec.State
class (Ord (Token s), Ord (Tokens s)) => Stream s where
type Token s :: Type
type Tokens s :: Type
tokenToChunk :: Proxy s -> Token s -> Tokens s
tokenToChunk Proxy s
pxy = forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk Proxy s
pxy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
tokensToChunk :: Proxy s -> [Token s] -> Tokens s
chunkToTokens :: Proxy s -> Tokens s -> [Token s]
chunkLength :: Proxy s -> Tokens s -> Int
chunkEmpty :: Proxy s -> Tokens s -> Bool
chunkEmpty Proxy s
pxy Tokens s
ts = forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength Proxy s
pxy Tokens s
ts forall a. Ord a => a -> a -> Bool
<= Int
0
take1_ :: s -> Maybe (Token s, s)
takeN_ :: Int -> s -> Maybe (Tokens s, s)
takeWhile_ :: (Token s -> Bool) -> s -> (Tokens s, s)
instance (Ord a) => Stream [a] where
type Token [a] = a
type Tokens [a] = [a]
tokenToChunk :: Proxy [a] -> Token [a] -> Tokens [a]
tokenToChunk Proxy [a]
Proxy = forall (f :: * -> *) a. Applicative f => a -> f a
pure
tokensToChunk :: Proxy [a] -> [Token [a]] -> Tokens [a]
tokensToChunk Proxy [a]
Proxy = forall a. a -> a
id
chunkToTokens :: Proxy [a] -> Tokens [a] -> [Token [a]]
chunkToTokens Proxy [a]
Proxy = forall a. a -> a
id
chunkLength :: Proxy [a] -> Tokens [a] -> Int
chunkLength Proxy [a]
Proxy = forall (t :: * -> *) a. Foldable t => t a -> Int
length
chunkEmpty :: Proxy [a] -> Tokens [a] -> Bool
chunkEmpty Proxy [a]
Proxy = forall (t :: * -> *) a. Foldable t => t a -> Bool
null
take1_ :: [a] -> Maybe (Token [a], [a])
take1_ [] = forall a. Maybe a
Nothing
take1_ (a
t : [a]
ts) = forall a. a -> Maybe a
Just (a
t, [a]
ts)
takeN_ :: Int -> [a] -> Maybe (Tokens [a], [a])
takeN_ Int
n [a]
s
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just ([], [a]
s)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
s = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
s)
takeWhile_ :: (Token [a] -> Bool) -> [a] -> (Tokens [a], [a])
takeWhile_ = forall a. (a -> Bool) -> [a] -> ([a], [a])
span
instance (Ord a) => Stream (S.Seq a) where
type Token (S.Seq a) = a
type Tokens (S.Seq a) = S.Seq a
tokenToChunk :: Proxy (Seq a) -> Token (Seq a) -> Tokens (Seq a)
tokenToChunk Proxy (Seq a)
Proxy = forall (f :: * -> *) a. Applicative f => a -> f a
pure
tokensToChunk :: Proxy (Seq a) -> [Token (Seq a)] -> Tokens (Seq a)
tokensToChunk Proxy (Seq a)
Proxy = forall a. [a] -> Seq a
S.fromList
chunkToTokens :: Proxy (Seq a) -> Tokens (Seq a) -> [Token (Seq a)]
chunkToTokens Proxy (Seq a)
Proxy = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
chunkLength :: Proxy (Seq a) -> Tokens (Seq a) -> Int
chunkLength Proxy (Seq a)
Proxy = forall (t :: * -> *) a. Foldable t => t a -> Int
length
chunkEmpty :: Proxy (Seq a) -> Tokens (Seq a) -> Bool
chunkEmpty Proxy (Seq a)
Proxy = forall (t :: * -> *) a. Foldable t => t a -> Bool
null
take1_ :: Seq a -> Maybe (Token (Seq a), Seq a)
take1_ Seq a
S.Empty = forall a. Maybe a
Nothing
take1_ (a
t S.:<| Seq a
ts) = forall a. a -> Maybe a
Just (a
t, Seq a
ts)
takeN_ :: Int -> Seq a -> Maybe (Tokens (Seq a), Seq a)
takeN_ Int
n Seq a
s
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (forall a. Seq a
S.empty, Seq a
s)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
s = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt Int
n Seq a
s)
takeWhile_ :: (Token (Seq a) -> Bool) -> Seq a -> (Tokens (Seq a), Seq a)
takeWhile_ = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
S.spanl
newtype ShareInput a = ShareInput {forall a. ShareInput a -> a
unShareInput :: a}
instance Stream (ShareInput B.ByteString) where
type Token (ShareInput B.ByteString) = Word8
type Tokens (ShareInput B.ByteString) = B.ByteString
tokenToChunk :: Proxy (ShareInput ByteString)
-> Token (ShareInput ByteString) -> Tokens (ShareInput ByteString)
tokenToChunk Proxy (ShareInput ByteString)
Proxy = Word8 -> ByteString
B.singleton
tokensToChunk :: Proxy (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
-> Tokens (ShareInput ByteString)
tokensToChunk Proxy (ShareInput ByteString)
Proxy = [Word8] -> ByteString
B.pack
chunkToTokens :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
chunkToTokens Proxy (ShareInput ByteString)
Proxy = ByteString -> [Word8]
B.unpack
chunkLength :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Int
chunkLength Proxy (ShareInput ByteString)
Proxy = ByteString -> Int
B.length
chunkEmpty :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Bool
chunkEmpty Proxy (ShareInput ByteString)
Proxy = ByteString -> Bool
B.null
take1_ :: ShareInput ByteString
-> Maybe (Token (ShareInput ByteString), ShareInput ByteString)
take1_ (ShareInput ByteString
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
s
takeN_ :: Int
-> ShareInput ByteString
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
takeN_ Int
n (ShareInput ByteString
s)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (ByteString
B.empty, forall a. a -> ShareInput a
ShareInput ByteString
s)
| ByteString -> Bool
B.null ByteString
s = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
s
takeWhile_ :: (Token (ShareInput ByteString) -> Bool)
-> ShareInput ByteString
-> (Tokens (ShareInput ByteString), ShareInput ByteString)
takeWhile_ Token (ShareInput ByteString) -> Bool
p (ShareInput ByteString
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Token (ShareInput ByteString) -> Bool
p ByteString
s
instance Stream (ShareInput BL.ByteString) where
type Token (ShareInput BL.ByteString) = Word8
type Tokens (ShareInput BL.ByteString) = BL.ByteString
tokenToChunk :: Proxy (ShareInput ByteString)
-> Token (ShareInput ByteString) -> Tokens (ShareInput ByteString)
tokenToChunk Proxy (ShareInput ByteString)
Proxy = Word8 -> ByteString
BL.singleton
tokensToChunk :: Proxy (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
-> Tokens (ShareInput ByteString)
tokensToChunk Proxy (ShareInput ByteString)
Proxy = [Word8] -> ByteString
BL.pack
chunkToTokens :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
chunkToTokens Proxy (ShareInput ByteString)
Proxy = ByteString -> [Word8]
BL.unpack
chunkLength :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Int
chunkLength Proxy (ShareInput ByteString)
Proxy = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length
chunkEmpty :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Bool
chunkEmpty Proxy (ShareInput ByteString)
Proxy = ByteString -> Bool
BL.null
take1_ :: ShareInput ByteString
-> Maybe (Token (ShareInput ByteString), ShareInput ByteString)
take1_ (ShareInput ByteString
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Word8, ByteString)
BL.uncons ByteString
s
takeN_ :: Int
-> ShareInput ByteString
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
takeN_ Int
n (ShareInput ByteString
s)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (ByteString
BL.empty, forall a. a -> ShareInput a
ShareInput ByteString
s)
| ByteString -> Bool
BL.null ByteString
s = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ByteString
s
takeWhile_ :: (Token (ShareInput ByteString) -> Bool)
-> ShareInput ByteString
-> (Tokens (ShareInput ByteString), ShareInput ByteString)
takeWhile_ Token (ShareInput ByteString) -> Bool
p (ShareInput ByteString
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BL.span Token (ShareInput ByteString) -> Bool
p ByteString
s
instance Stream (ShareInput T.Text) where
type Token (ShareInput T.Text) = Char
type Tokens (ShareInput T.Text) = T.Text
tokenToChunk :: Proxy (ShareInput Text)
-> Token (ShareInput Text) -> Tokens (ShareInput Text)
tokenToChunk Proxy (ShareInput Text)
Proxy = Char -> Text
T.singleton
tokensToChunk :: Proxy (ShareInput Text)
-> [Token (ShareInput Text)] -> Tokens (ShareInput Text)
tokensToChunk Proxy (ShareInput Text)
Proxy = String -> Text
T.pack
chunkToTokens :: Proxy (ShareInput Text)
-> Tokens (ShareInput Text) -> [Token (ShareInput Text)]
chunkToTokens Proxy (ShareInput Text)
Proxy = Text -> String
T.unpack
chunkLength :: Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Int
chunkLength Proxy (ShareInput Text)
Proxy = Text -> Int
T.length
chunkEmpty :: Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Bool
chunkEmpty Proxy (ShareInput Text)
Proxy = Text -> Bool
T.null
take1_ :: ShareInput Text -> Maybe (Token (ShareInput Text), ShareInput Text)
take1_ (ShareInput Text
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
T.uncons Text
s
takeN_ :: Int
-> ShareInput Text
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
takeN_ Int
n (ShareInput Text
s)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (Text
T.empty, forall a. a -> ShareInput a
ShareInput Text
s)
| Text -> Bool
T.null Text
s = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall a b. (a -> b) -> a -> b
$ Int -> Text -> (Text, Text)
T.splitAt Int
n Text
s
takeWhile_ :: (Token (ShareInput Text) -> Bool)
-> ShareInput Text -> (Tokens (ShareInput Text), ShareInput Text)
takeWhile_ Token (ShareInput Text) -> Bool
p (ShareInput Text
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
T.span Token (ShareInput Text) -> Bool
p Text
s
instance Stream (ShareInput TL.Text) where
type Token (ShareInput TL.Text) = Char
type Tokens (ShareInput TL.Text) = TL.Text
tokenToChunk :: Proxy (ShareInput Text)
-> Token (ShareInput Text) -> Tokens (ShareInput Text)
tokenToChunk Proxy (ShareInput Text)
Proxy = Char -> Text
TL.singleton
tokensToChunk :: Proxy (ShareInput Text)
-> [Token (ShareInput Text)] -> Tokens (ShareInput Text)
tokensToChunk Proxy (ShareInput Text)
Proxy = String -> Text
TL.pack
chunkToTokens :: Proxy (ShareInput Text)
-> Tokens (ShareInput Text) -> [Token (ShareInput Text)]
chunkToTokens Proxy (ShareInput Text)
Proxy = Text -> String
TL.unpack
chunkLength :: Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Int
chunkLength Proxy (ShareInput Text)
Proxy = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
TL.length
chunkEmpty :: Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Bool
chunkEmpty Proxy (ShareInput Text)
Proxy = Text -> Bool
TL.null
take1_ :: ShareInput Text -> Maybe (Token (ShareInput Text), ShareInput Text)
take1_ (ShareInput Text
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
TL.uncons Text
s
takeN_ :: Int
-> ShareInput Text
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
takeN_ Int
n (ShareInput Text
s)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (Text
TL.empty, forall a. a -> ShareInput a
ShareInput Text
s)
| Text -> Bool
TL.null Text
s = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> (Text, Text)
TL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Text
s
takeWhile_ :: (Token (ShareInput Text) -> Bool)
-> ShareInput Text -> (Tokens (ShareInput Text), ShareInput Text)
takeWhile_ Token (ShareInput Text) -> Bool
p (ShareInput Text
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> ShareInput a
ShareInput forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
TL.span Token (ShareInput Text) -> Bool
p Text
s
newtype NoShareInput a = NoShareInput {forall a. NoShareInput a -> a
unNoShareInput :: a}
instance Stream (NoShareInput B.ByteString) where
type Token (NoShareInput B.ByteString) = Word8
type Tokens (NoShareInput B.ByteString) = B.ByteString
tokenToChunk :: Proxy (NoShareInput ByteString)
-> Token (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString)
tokenToChunk Proxy (NoShareInput ByteString)
Proxy = Word8 -> ByteString
B.singleton
tokensToChunk :: Proxy (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
-> Tokens (NoShareInput ByteString)
tokensToChunk Proxy (NoShareInput ByteString)
Proxy = [Word8] -> ByteString
B.pack
chunkToTokens :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
chunkToTokens Proxy (NoShareInput ByteString)
Proxy = ByteString -> [Word8]
B.unpack
chunkLength :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString) -> Int
chunkLength Proxy (NoShareInput ByteString)
Proxy = ByteString -> Int
B.length
chunkEmpty :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString) -> Bool
chunkEmpty Proxy (NoShareInput ByteString)
Proxy = ByteString -> Bool
B.null
take1_ :: NoShareInput ByteString
-> Maybe (Token (NoShareInput ByteString), NoShareInput ByteString)
take1_ (NoShareInput ByteString
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> NoShareInput a
NoShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
s
takeN_ :: Int
-> NoShareInput ByteString
-> Maybe
(Tokens (NoShareInput ByteString), NoShareInput ByteString)
takeN_ Int
n (NoShareInput ByteString
s)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (ByteString
B.empty, forall a. a -> NoShareInput a
NoShareInput ByteString
s)
| ByteString -> Bool
B.null ByteString
s = forall a. Maybe a
Nothing
| Bool
otherwise =
let (ByteString
result, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
s
unSharedResult :: ByteString
unSharedResult = ByteString -> ByteString
B.copy ByteString
result
in forall a. a -> Maybe a
Just (ByteString
unSharedResult, forall a. a -> NoShareInput a
NoShareInput ByteString
rest)
takeWhile_ :: (Token (NoShareInput ByteString) -> Bool)
-> NoShareInput ByteString
-> (Tokens (NoShareInput ByteString), NoShareInput ByteString)
takeWhile_ Token (NoShareInput ByteString) -> Bool
p (NoShareInput ByteString
s) =
let (ByteString
result, ByteString
rest) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Token (NoShareInput ByteString) -> Bool
p ByteString
s
unSharedResult :: ByteString
unSharedResult = ByteString -> ByteString
B.copy ByteString
result
in (ByteString
unSharedResult, forall a. a -> NoShareInput a
NoShareInput ByteString
rest)
instance Stream (NoShareInput BL.ByteString) where
type Token (NoShareInput BL.ByteString) = Word8
type Tokens (NoShareInput BL.ByteString) = BL.ByteString
tokenToChunk :: Proxy (NoShareInput ByteString)
-> Token (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString)
tokenToChunk Proxy (NoShareInput ByteString)
Proxy = Word8 -> ByteString
BL.singleton
tokensToChunk :: Proxy (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
-> Tokens (NoShareInput ByteString)
tokensToChunk Proxy (NoShareInput ByteString)
Proxy = [Word8] -> ByteString
BL.pack
chunkToTokens :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
chunkToTokens Proxy (NoShareInput ByteString)
Proxy = ByteString -> [Word8]
BL.unpack
chunkLength :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString) -> Int
chunkLength Proxy (NoShareInput ByteString)
Proxy = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length
chunkEmpty :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString) -> Bool
chunkEmpty Proxy (NoShareInput ByteString)
Proxy = ByteString -> Bool
BL.null
take1_ :: NoShareInput ByteString
-> Maybe (Token (NoShareInput ByteString), NoShareInput ByteString)
take1_ (NoShareInput ByteString
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> NoShareInput a
NoShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Word8, ByteString)
BL.uncons ByteString
s
takeN_ :: Int
-> NoShareInput ByteString
-> Maybe
(Tokens (NoShareInput ByteString), NoShareInput ByteString)
takeN_ Int
n (NoShareInput ByteString
s)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (ByteString
BL.empty, forall a. a -> NoShareInput a
NoShareInput ByteString
s)
| ByteString -> Bool
BL.null ByteString
s = forall a. Maybe a
Nothing
| Bool
otherwise =
let (ByteString
result, ByteString
rest) = Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ByteString
s
unSharedResult :: ByteString
unSharedResult = ByteString -> ByteString
BL.copy ByteString
result
in forall a. a -> Maybe a
Just (ByteString
unSharedResult, forall a. a -> NoShareInput a
NoShareInput ByteString
rest)
takeWhile_ :: (Token (NoShareInput ByteString) -> Bool)
-> NoShareInput ByteString
-> (Tokens (NoShareInput ByteString), NoShareInput ByteString)
takeWhile_ Token (NoShareInput ByteString) -> Bool
p (NoShareInput ByteString
s) =
let (ByteString
result, ByteString
rest) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BL.span Token (NoShareInput ByteString) -> Bool
p ByteString
s
unSharedResult :: ByteString
unSharedResult = ByteString -> ByteString
BL.copy ByteString
result
in (ByteString
unSharedResult, forall a. a -> NoShareInput a
NoShareInput ByteString
rest)
instance Stream (NoShareInput T.Text) where
type Token (NoShareInput T.Text) = Char
type Tokens (NoShareInput T.Text) = T.Text
tokenToChunk :: Proxy (NoShareInput Text)
-> Token (NoShareInput Text) -> Tokens (NoShareInput Text)
tokenToChunk Proxy (NoShareInput Text)
Proxy = Char -> Text
T.singleton
tokensToChunk :: Proxy (NoShareInput Text)
-> [Token (NoShareInput Text)] -> Tokens (NoShareInput Text)
tokensToChunk Proxy (NoShareInput Text)
Proxy = String -> Text
T.pack
chunkToTokens :: Proxy (NoShareInput Text)
-> Tokens (NoShareInput Text) -> [Token (NoShareInput Text)]
chunkToTokens Proxy (NoShareInput Text)
Proxy = Text -> String
T.unpack
chunkLength :: Proxy (NoShareInput Text) -> Tokens (NoShareInput Text) -> Int
chunkLength Proxy (NoShareInput Text)
Proxy = Text -> Int
T.length
chunkEmpty :: Proxy (NoShareInput Text) -> Tokens (NoShareInput Text) -> Bool
chunkEmpty Proxy (NoShareInput Text)
Proxy = Text -> Bool
T.null
take1_ :: NoShareInput Text
-> Maybe (Token (NoShareInput Text), NoShareInput Text)
take1_ (NoShareInput Text
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> NoShareInput a
NoShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
T.uncons Text
s
takeN_ :: Int
-> NoShareInput Text
-> Maybe (Tokens (NoShareInput Text), NoShareInput Text)
takeN_ Int
n (NoShareInput Text
s)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (Text
T.empty, forall a. a -> NoShareInput a
NoShareInput Text
s)
| Text -> Bool
T.null Text
s = forall a. Maybe a
Nothing
| Bool
otherwise =
let (Text
result, Text
rest) = Int -> Text -> (Text, Text)
T.splitAt Int
n Text
s
unSharedResult :: Text
unSharedResult = Text -> Text
T.copy Text
result
in forall a. a -> Maybe a
Just (Text
unSharedResult, forall a. a -> NoShareInput a
NoShareInput Text
rest)
takeWhile_ :: (Token (NoShareInput Text) -> Bool)
-> NoShareInput Text
-> (Tokens (NoShareInput Text), NoShareInput Text)
takeWhile_ Token (NoShareInput Text) -> Bool
p (NoShareInput Text
s) =
let (Text
result, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Token (NoShareInput Text) -> Bool
p Text
s
unSharedResult :: Text
unSharedResult = Text -> Text
T.copy Text
result
in (Text
unSharedResult, forall a. a -> NoShareInput a
NoShareInput Text
rest)
instance Stream (NoShareInput TL.Text) where
type Token (NoShareInput TL.Text) = Char
type Tokens (NoShareInput TL.Text) = TL.Text
tokenToChunk :: Proxy (NoShareInput Text)
-> Token (NoShareInput Text) -> Tokens (NoShareInput Text)
tokenToChunk Proxy (NoShareInput Text)
Proxy = Char -> Text
TL.singleton
tokensToChunk :: Proxy (NoShareInput Text)
-> [Token (NoShareInput Text)] -> Tokens (NoShareInput Text)
tokensToChunk Proxy (NoShareInput Text)
Proxy = String -> Text
TL.pack
chunkToTokens :: Proxy (NoShareInput Text)
-> Tokens (NoShareInput Text) -> [Token (NoShareInput Text)]
chunkToTokens Proxy (NoShareInput Text)
Proxy = Text -> String
TL.unpack
chunkLength :: Proxy (NoShareInput Text) -> Tokens (NoShareInput Text) -> Int
chunkLength Proxy (NoShareInput Text)
Proxy = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
TL.length
chunkEmpty :: Proxy (NoShareInput Text) -> Tokens (NoShareInput Text) -> Bool
chunkEmpty Proxy (NoShareInput Text)
Proxy = Text -> Bool
TL.null
take1_ :: NoShareInput Text
-> Maybe (Token (NoShareInput Text), NoShareInput Text)
take1_ (NoShareInput Text
s) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. a -> NoShareInput a
NoShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
TL.uncons Text
s
takeN_ :: Int
-> NoShareInput Text
-> Maybe (Tokens (NoShareInput Text), NoShareInput Text)
takeN_ Int
n (NoShareInput Text
s)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (Text
TL.empty, forall a. a -> NoShareInput a
NoShareInput Text
s)
| Text -> Bool
TL.null Text
s = forall a. Maybe a
Nothing
| Bool
otherwise =
let (Text
result, Text
rest) = Int64 -> Text -> (Text, Text)
TL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Text
s
unSharedResult :: Text
unSharedResult = Text -> Text
tlCopy Text
result
in forall a. a -> Maybe a
Just (Text
unSharedResult, forall a. a -> NoShareInput a
NoShareInput Text
rest)
takeWhile_ :: (Token (NoShareInput Text) -> Bool)
-> NoShareInput Text
-> (Tokens (NoShareInput Text), NoShareInput Text)
takeWhile_ Token (NoShareInput Text) -> Bool
p (NoShareInput Text
s) =
let (Text
result, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
TL.span Token (NoShareInput Text) -> Bool
p Text
s
unSharedResult :: Text
unSharedResult = Text -> Text
tlCopy Text
result
in (Text
unSharedResult, forall a. a -> NoShareInput a
NoShareInput Text
rest)
tlCopy :: TL.Text -> TL.Text
tlCopy :: Text -> Text
tlCopy = Text -> Text
TL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.copy forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
{-# INLINE tlCopy #-}
instance Stream B.ByteString where
type Token B.ByteString = Token (ShareInput B.ByteString)
type Tokens B.ByteString = Tokens (ShareInput B.ByteString)
tokenToChunk :: Proxy ByteString -> Token ByteString -> Tokens ByteString
tokenToChunk Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> Token s -> Tokens s
tokenToChunk (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
tokensToChunk :: Proxy ByteString -> [Token ByteString] -> Tokens ByteString
tokensToChunk Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
chunkToTokens :: Proxy ByteString -> Tokens ByteString -> [Token ByteString]
chunkToTokens Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
chunkLength :: Proxy ByteString -> Tokens ByteString -> Int
chunkLength Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
chunkEmpty :: Proxy ByteString -> Tokens ByteString -> Bool
chunkEmpty Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> Tokens s -> Bool
chunkEmpty (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
take1_ :: ByteString -> Maybe (Token ByteString, ByteString)
take1_ ByteString
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s => s -> Maybe (Token s, s)
take1_ (forall a. a -> ShareInput a
ShareInput ByteString
s)
takeN_ :: Int -> ByteString -> Maybe (Tokens ByteString, ByteString)
takeN_ Int
n ByteString
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ Int
n (forall a. a -> ShareInput a
ShareInput ByteString
s)
takeWhile_ :: (Token ByteString -> Bool)
-> ByteString -> (Tokens ByteString, ByteString)
takeWhile_ Token ByteString -> Bool
p ByteString
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall a b. (a -> b) -> a -> b
$ forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ Token ByteString -> Bool
p (forall a. a -> ShareInput a
ShareInput ByteString
s)
instance Stream BL.ByteString where
type Token BL.ByteString = Token (ShareInput BL.ByteString)
type Tokens BL.ByteString = Tokens (ShareInput BL.ByteString)
tokenToChunk :: Proxy ByteString -> Token ByteString -> Tokens ByteString
tokenToChunk Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> Token s -> Tokens s
tokenToChunk (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
tokensToChunk :: Proxy ByteString -> [Token ByteString] -> Tokens ByteString
tokensToChunk Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
chunkToTokens :: Proxy ByteString -> Tokens ByteString -> [Token ByteString]
chunkToTokens Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
chunkLength :: Proxy ByteString -> Tokens ByteString -> Int
chunkLength Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
chunkEmpty :: Proxy ByteString -> Tokens ByteString -> Bool
chunkEmpty Proxy ByteString
Proxy = forall s. Stream s => Proxy s -> Tokens s -> Bool
chunkEmpty (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
take1_ :: ByteString -> Maybe (Token ByteString, ByteString)
take1_ ByteString
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s => s -> Maybe (Token s, s)
take1_ (forall a. a -> ShareInput a
ShareInput ByteString
s)
takeN_ :: Int -> ByteString -> Maybe (Tokens ByteString, ByteString)
takeN_ Int
n ByteString
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ Int
n (forall a. a -> ShareInput a
ShareInput ByteString
s)
takeWhile_ :: (Token ByteString -> Bool)
-> ByteString -> (Tokens ByteString, ByteString)
takeWhile_ Token ByteString -> Bool
p ByteString
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall a b. (a -> b) -> a -> b
$ forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ Token ByteString -> Bool
p (forall a. a -> ShareInput a
ShareInput ByteString
s)
instance Stream T.Text where
type Token T.Text = Token (ShareInput T.Text)
type Tokens T.Text = Tokens (ShareInput T.Text)
tokenToChunk :: Proxy Text -> Token Text -> Tokens Text
tokenToChunk Proxy Text
Proxy = forall s. Stream s => Proxy s -> Token s -> Tokens s
tokenToChunk (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
tokensToChunk :: Proxy Text -> [Token Text] -> Tokens Text
tokensToChunk Proxy Text
Proxy = forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
chunkToTokens :: Proxy Text -> Tokens Text -> [Token Text]
chunkToTokens Proxy Text
Proxy = forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
chunkLength :: Proxy Text -> Tokens Text -> Int
chunkLength Proxy Text
Proxy = forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
chunkEmpty :: Proxy Text -> Tokens Text -> Bool
chunkEmpty Proxy Text
Proxy = forall s. Stream s => Proxy s -> Tokens s -> Bool
chunkEmpty (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
take1_ :: Text -> Maybe (Token Text, Text)
take1_ Text
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s => s -> Maybe (Token s, s)
take1_ (forall a. a -> ShareInput a
ShareInput Text
s)
takeN_ :: Int -> Text -> Maybe (Tokens Text, Text)
takeN_ Int
n Text
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ Int
n (forall a. a -> ShareInput a
ShareInput Text
s)
takeWhile_ :: (Token Text -> Bool) -> Text -> (Tokens Text, Text)
takeWhile_ Token Text -> Bool
p Text
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall a b. (a -> b) -> a -> b
$ forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ Token Text -> Bool
p (forall a. a -> ShareInput a
ShareInput Text
s)
instance Stream TL.Text where
type Token TL.Text = Token (ShareInput TL.Text)
type Tokens TL.Text = Tokens (ShareInput TL.Text)
tokenToChunk :: Proxy Text -> Token Text -> Tokens Text
tokenToChunk Proxy Text
Proxy = forall s. Stream s => Proxy s -> Token s -> Tokens s
tokenToChunk (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
tokensToChunk :: Proxy Text -> [Token Text] -> Tokens Text
tokensToChunk Proxy Text
Proxy = forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
chunkToTokens :: Proxy Text -> Tokens Text -> [Token Text]
chunkToTokens Proxy Text
Proxy = forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
chunkLength :: Proxy Text -> Tokens Text -> Int
chunkLength Proxy Text
Proxy = forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
chunkEmpty :: Proxy Text -> Tokens Text -> Bool
chunkEmpty Proxy Text
Proxy = forall s. Stream s => Proxy s -> Tokens s -> Bool
chunkEmpty (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
take1_ :: Text -> Maybe (Token Text, Text)
take1_ Text
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s => s -> Maybe (Token s, s)
take1_ (forall a. a -> ShareInput a
ShareInput Text
s)
takeN_ :: Int -> Text -> Maybe (Tokens Text, Text)
takeN_ Int
n Text
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ Int
n (forall a. a -> ShareInput a
ShareInput Text
s)
takeWhile_ :: (Token Text -> Bool) -> Text -> (Tokens Text, Text)
takeWhile_ Token Text -> Bool
p Text
s = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. ShareInput a -> a
unShareInput forall a b. (a -> b) -> a -> b
$ forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ Token Text -> Bool
p (forall a. a -> ShareInput a
ShareInput Text
s)
class (Stream s) => VisualStream s where
showTokens :: Proxy s -> NonEmpty (Token s) -> String
tokensLength :: Proxy s -> NonEmpty (Token s) -> Int
tokensLength Proxy s
Proxy = forall a. NonEmpty a -> Int
NE.length
instance VisualStream String where
showTokens :: Proxy String -> NonEmpty (Token String) -> String
showTokens Proxy String
Proxy = NonEmpty Char -> String
stringPretty
instance VisualStream B.ByteString where
showTokens :: Proxy ByteString -> NonEmpty (Token ByteString) -> String
showTokens Proxy ByteString
Proxy = NonEmpty Char -> String
stringPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance VisualStream BL.ByteString where
showTokens :: Proxy ByteString -> NonEmpty (Token ByteString) -> String
showTokens Proxy ByteString
Proxy = NonEmpty Char -> String
stringPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance VisualStream T.Text where
showTokens :: Proxy Text -> NonEmpty (Token Text) -> String
showTokens Proxy Text
Proxy = NonEmpty Char -> String
stringPretty
instance VisualStream TL.Text where
showTokens :: Proxy Text -> NonEmpty (Token Text) -> String
showTokens Proxy Text
Proxy = NonEmpty Char -> String
stringPretty
class (Stream s) => TraversableStream s where
{-# MINIMAL reachOffset | reachOffsetNoLine #-}
reachOffset ::
Int ->
PosState s ->
(Maybe String, PosState s)
reachOffset Int
o PosState s
pst =
(forall a. Maybe a
Nothing, forall s. TraversableStream s => Int -> PosState s -> PosState s
reachOffsetNoLine Int
o PosState s
pst)
reachOffsetNoLine ::
Int ->
PosState s ->
PosState s
reachOffsetNoLine Int
o PosState s
pst =
forall a b. (a, b) -> b
snd (forall s.
TraversableStream s =>
Int -> PosState s -> (Maybe String, PosState s)
reachOffset Int
o PosState s
pst)
instance TraversableStream String where
reachOffset :: Int -> PosState String -> (Maybe String, PosState String)
reachOffset Int
o PosState String
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Tokens s -> String)
-> (Token s -> Char)
-> (Token s, Token s)
-> Int
-> PosState s
-> (Maybe String, PosState s)
reachOffset' forall a. Int -> [a] -> ([a], [a])
splitAt forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. a -> a
id forall a. a -> a
id (Char
'\n', Char
'\t') Int
o PosState String
pst
reachOffsetNoLine :: Int -> PosState String -> PosState String
reachOffsetNoLine Int
o PosState String
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Token s, Token s)
-> Int
-> PosState s
-> PosState s
reachOffsetNoLine' forall a. Int -> [a] -> ([a], [a])
splitAt forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Char
'\n', Char
'\t') Int
o PosState String
pst
instance TraversableStream B.ByteString where
reachOffset :: Int -> PosState ByteString -> (Maybe String, PosState ByteString)
reachOffset Int
o PosState ByteString
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Tokens s -> String)
-> (Token s -> Char)
-> (Token s, Token s)
-> Int
-> PosState s
-> (Maybe String, PosState s)
reachOffset' Int -> ByteString -> (ByteString, ByteString)
B.splitAt forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' ByteString -> String
B8.unpack (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word8
10, Word8
9) Int
o PosState ByteString
pst
reachOffsetNoLine :: Int -> PosState ByteString -> PosState ByteString
reachOffsetNoLine Int
o PosState ByteString
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Token s, Token s)
-> Int
-> PosState s
-> PosState s
reachOffsetNoLine' Int -> ByteString -> (ByteString, ByteString)
B.splitAt forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (Word8
10, Word8
9) Int
o PosState ByteString
pst
instance TraversableStream BL.ByteString where
reachOffset :: Int -> PosState ByteString -> (Maybe String, PosState ByteString)
reachOffset Int
o PosState ByteString
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Tokens s -> String)
-> (Token s -> Char)
-> (Token s, Token s)
-> Int
-> PosState s
-> (Maybe String, PosState s)
reachOffset' Int -> ByteString -> (ByteString, ByteString)
splitAtBL forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BL.foldl' ByteString -> String
BL8.unpack (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word8
10, Word8
9) Int
o PosState ByteString
pst
reachOffsetNoLine :: Int -> PosState ByteString -> PosState ByteString
reachOffsetNoLine Int
o PosState ByteString
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Token s, Token s)
-> Int
-> PosState s
-> PosState s
reachOffsetNoLine' Int -> ByteString -> (ByteString, ByteString)
splitAtBL forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BL.foldl' (Word8
10, Word8
9) Int
o PosState ByteString
pst
instance TraversableStream T.Text where
reachOffset :: Int -> PosState Text -> (Maybe String, PosState Text)
reachOffset Int
o PosState Text
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Tokens s -> String)
-> (Token s -> Char)
-> (Token s, Token s)
-> Int
-> PosState s
-> (Maybe String, PosState s)
reachOffset' Int -> Text -> (Text, Text)
T.splitAt forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Text -> String
T.unpack forall a. a -> a
id (Char
'\n', Char
'\t') Int
o PosState Text
pst
reachOffsetNoLine :: Int -> PosState Text -> PosState Text
reachOffsetNoLine Int
o PosState Text
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Token s, Token s)
-> Int
-> PosState s
-> PosState s
reachOffsetNoLine' Int -> Text -> (Text, Text)
T.splitAt forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (Char
'\n', Char
'\t') Int
o PosState Text
pst
instance TraversableStream TL.Text where
reachOffset :: Int -> PosState Text -> (Maybe String, PosState Text)
reachOffset Int
o PosState Text
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Tokens s -> String)
-> (Token s -> Char)
-> (Token s, Token s)
-> Int
-> PosState s
-> (Maybe String, PosState s)
reachOffset' Int -> Text -> (Text, Text)
splitAtTL forall a. (a -> Char -> a) -> a -> Text -> a
TL.foldl' Text -> String
TL.unpack forall a. a -> a
id (Char
'\n', Char
'\t') Int
o PosState Text
pst
reachOffsetNoLine :: Int -> PosState Text -> PosState Text
reachOffsetNoLine Int
o PosState Text
pst =
forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Token s, Token s)
-> Int
-> PosState s
-> PosState s
reachOffsetNoLine' Int -> Text -> (Text, Text)
splitAtTL forall a. (a -> Char -> a) -> a -> Text -> a
TL.foldl' (Char
'\n', Char
'\t') Int
o PosState Text
pst
data St = St {-# UNPACK #-} !SourcePos ShowS
reachOffset' ::
forall s.
(Stream s) =>
(Int -> s -> (Tokens s, s)) ->
(forall b. (b -> Token s -> b) -> b -> Tokens s -> b) ->
(Tokens s -> String) ->
(Token s -> Char) ->
(Token s, Token s) ->
Int ->
PosState s ->
(Maybe String, PosState s)
reachOffset' :: forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Tokens s -> String)
-> (Token s -> Char)
-> (Token s, Token s)
-> Int
-> PosState s
-> (Maybe String, PosState s)
reachOffset'
Int -> s -> (Tokens s, s)
splitAt'
forall b. (b -> Token s -> b) -> b -> Tokens s -> b
foldl''
Tokens s -> String
fromToks
Token s -> Char
fromTok
(Token s
newlineTok, Token s
tabTok)
Int
o
PosState {s
Int
String
SourcePos
Pos
pstateLinePrefix :: forall s. PosState s -> String
pstateTabWidth :: forall s. PosState s -> Pos
pstateSourcePos :: forall s. PosState s -> SourcePos
pstateOffset :: forall s. PosState s -> Int
pstateInput :: forall s. PosState s -> s
pstateLinePrefix :: String
pstateTabWidth :: Pos
pstateSourcePos :: SourcePos
pstateOffset :: Int
pstateInput :: s
..} =
( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Pos -> String -> String
expandTab Pos
pstateTabWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addPrefix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tokens s -> String
fromToks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
forall a b. (a -> b) -> a -> b
$ forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ (forall a. Eq a => a -> a -> Bool
/= Token s
newlineTok) s
post of
String
"" -> String
"<empty line>"
String
xs -> String
xs,
PosState
{ pstateInput :: s
pstateInput = s
post,
pstateOffset :: Int
pstateOffset = forall a. Ord a => a -> a -> a
max Int
pstateOffset Int
o,
pstateSourcePos :: SourcePos
pstateSourcePos = SourcePos
spos,
pstateTabWidth :: Pos
pstateTabWidth = Pos
pstateTabWidth,
pstateLinePrefix :: String
pstateLinePrefix =
if Bool
sameLine
then
String
pstateLinePrefix forall a. [a] -> [a] -> [a]
++ String -> String
f String
""
else String -> String
f String
""
}
)
where
addPrefix :: String -> String
addPrefix String
xs =
if Bool
sameLine
then String
pstateLinePrefix forall a. [a] -> [a] -> [a]
++ String
xs
else String
xs
sameLine :: Bool
sameLine = SourcePos -> Pos
sourceLine SourcePos
spos forall a. Eq a => a -> a -> Bool
== SourcePos -> Pos
sourceLine SourcePos
pstateSourcePos
(Tokens s
pre, s
post) = Int -> s -> (Tokens s, s)
splitAt' (Int
o forall a. Num a => a -> a -> a
- Int
pstateOffset) s
pstateInput
St SourcePos
spos String -> String
f = forall b. (b -> Token s -> b) -> b -> Tokens s -> b
foldl'' St -> Token s -> St
go (SourcePos -> (String -> String) -> St
St SourcePos
pstateSourcePos forall a. a -> a
id) Tokens s
pre
go :: St -> Token s -> St
go (St SourcePos
apos String -> String
g) Token s
ch =
let SourcePos String
n Pos
l Pos
c = SourcePos
apos
c' :: Int
c' = Pos -> Int
unPos Pos
c
w :: Int
w = Pos -> Int
unPos Pos
pstateTabWidth
in if
| Token s
ch forall a. Eq a => a -> a -> Bool
== Token s
newlineTok ->
SourcePos -> (String -> String) -> St
St
(String -> Pos -> Pos -> SourcePos
SourcePos String
n (Pos
l forall a. Semigroup a => a -> a -> a
<> Pos
pos1) Pos
pos1)
forall a. a -> a
id
| Token s
ch forall a. Eq a => a -> a -> Bool
== Token s
tabTok ->
SourcePos -> (String -> String) -> St
St
(String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Int -> Pos
mkPos forall a b. (a -> b) -> a -> b
$ Int
c' forall a. Num a => a -> a -> a
+ Int
w forall a. Num a => a -> a -> a
- ((Int
c' forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`rem` Int
w)))
(String -> String
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token s -> Char
fromTok Token s
ch forall a. a -> [a] -> [a]
:))
| Bool
otherwise ->
SourcePos -> (String -> String) -> St
St
(String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Pos
c forall a. Semigroup a => a -> a -> a
<> Pos
pos1))
(String -> String
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token s -> Char
fromTok Token s
ch forall a. a -> [a] -> [a]
:))
{-# INLINE reachOffset' #-}
reachOffsetNoLine' ::
forall s.
(Stream s) =>
(Int -> s -> (Tokens s, s)) ->
(forall b. (b -> Token s -> b) -> b -> Tokens s -> b) ->
(Token s, Token s) ->
Int ->
PosState s ->
PosState s
reachOffsetNoLine' :: forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Token s, Token s)
-> Int
-> PosState s
-> PosState s
reachOffsetNoLine'
Int -> s -> (Tokens s, s)
splitAt'
forall b. (b -> Token s -> b) -> b -> Tokens s -> b
foldl''
(Token s
newlineTok, Token s
tabTok)
Int
o
PosState {s
Int
String
SourcePos
Pos
pstateLinePrefix :: String
pstateTabWidth :: Pos
pstateSourcePos :: SourcePos
pstateOffset :: Int
pstateInput :: s
pstateLinePrefix :: forall s. PosState s -> String
pstateTabWidth :: forall s. PosState s -> Pos
pstateSourcePos :: forall s. PosState s -> SourcePos
pstateOffset :: forall s. PosState s -> Int
pstateInput :: forall s. PosState s -> s
..} =
( PosState
{ pstateInput :: s
pstateInput = s
post,
pstateOffset :: Int
pstateOffset = forall a. Ord a => a -> a -> a
max Int
pstateOffset Int
o,
pstateSourcePos :: SourcePos
pstateSourcePos = SourcePos
spos,
pstateTabWidth :: Pos
pstateTabWidth = Pos
pstateTabWidth,
pstateLinePrefix :: String
pstateLinePrefix = String
pstateLinePrefix
}
)
where
spos :: SourcePos
spos = forall b. (b -> Token s -> b) -> b -> Tokens s -> b
foldl'' SourcePos -> Token s -> SourcePos
go SourcePos
pstateSourcePos Tokens s
pre
(Tokens s
pre, s
post) = Int -> s -> (Tokens s, s)
splitAt' (Int
o forall a. Num a => a -> a -> a
- Int
pstateOffset) s
pstateInput
go :: SourcePos -> Token s -> SourcePos
go (SourcePos String
n Pos
l Pos
c) Token s
ch =
let c' :: Int
c' = Pos -> Int
unPos Pos
c
w :: Int
w = Pos -> Int
unPos Pos
pstateTabWidth
in if
| Token s
ch forall a. Eq a => a -> a -> Bool
== Token s
newlineTok ->
String -> Pos -> Pos -> SourcePos
SourcePos String
n (Pos
l forall a. Semigroup a => a -> a -> a
<> Pos
pos1) Pos
pos1
| Token s
ch forall a. Eq a => a -> a -> Bool
== Token s
tabTok ->
String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Int -> Pos
mkPos forall a b. (a -> b) -> a -> b
$ Int
c' forall a. Num a => a -> a -> a
+ Int
w forall a. Num a => a -> a -> a
- ((Int
c' forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`rem` Int
w))
| Bool
otherwise ->
String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Pos
c forall a. Semigroup a => a -> a -> a
<> Pos
pos1)
{-# INLINE reachOffsetNoLine' #-}
splitAtBL :: Int -> BL.ByteString -> (BL.ByteString, BL.ByteString)
splitAtBL :: Int -> ByteString -> (ByteString, ByteString)
splitAtBL Int
n = Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
{-# INLINE splitAtBL #-}
splitAtTL :: Int -> TL.Text -> (TL.Text, TL.Text)
splitAtTL :: Int -> Text -> (Text, Text)
splitAtTL Int
n = Int64 -> Text -> (Text, Text)
TL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
{-# INLINE splitAtTL #-}
stringPretty :: NonEmpty Char -> String
stringPretty :: NonEmpty Char -> String
stringPretty (Char
x :| []) = Char -> String
charPretty Char
x
stringPretty (Char
'\r' :| String
"\n") = String
"crlf newline"
stringPretty NonEmpty Char
xs = String
"\"" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f (forall a. NonEmpty a -> [a]
NE.toList NonEmpty Char
xs) forall a. Semigroup a => a -> a -> a
<> String
"\""
where
f :: Char -> String
f Char
ch =
case Char -> Maybe String
charPretty' Char
ch of
Maybe String
Nothing -> [Char
ch]
Just String
pretty -> String
"<" forall a. Semigroup a => a -> a -> a
<> String
pretty forall a. Semigroup a => a -> a -> a
<> String
">"
charPretty :: Char -> String
charPretty :: Char -> String
charPretty Char
' ' = String
"space"
charPretty Char
ch = forall a. a -> Maybe a -> a
fromMaybe (String
"'" forall a. Semigroup a => a -> a -> a
<> [Char
ch] forall a. Semigroup a => a -> a -> a
<> String
"'") (Char -> Maybe String
charPretty' Char
ch)
charPretty' :: Char -> Maybe String
charPretty' :: Char -> Maybe String
charPretty' = \case
Char
'\NUL' -> forall a. a -> Maybe a
Just String
"null"
Char
'\SOH' -> forall a. a -> Maybe a
Just String
"start of heading"
Char
'\STX' -> forall a. a -> Maybe a
Just String
"start of text"
Char
'\ETX' -> forall a. a -> Maybe a
Just String
"end of text"
Char
'\EOT' -> forall a. a -> Maybe a
Just String
"end of transmission"
Char
'\ENQ' -> forall a. a -> Maybe a
Just String
"enquiry"
Char
'\ACK' -> forall a. a -> Maybe a
Just String
"acknowledge"
Char
'\BEL' -> forall a. a -> Maybe a
Just String
"bell"
Char
'\BS' -> forall a. a -> Maybe a
Just String
"backspace"
Char
'\t' -> forall a. a -> Maybe a
Just String
"tab"
Char
'\n' -> forall a. a -> Maybe a
Just String
"newline"
Char
'\v' -> forall a. a -> Maybe a
Just String
"vertical tab"
Char
'\f' -> forall a. a -> Maybe a
Just String
"form feed"
Char
'\r' -> forall a. a -> Maybe a
Just String
"carriage return"
Char
'\SO' -> forall a. a -> Maybe a
Just String
"shift out"
Char
'\SI' -> forall a. a -> Maybe a
Just String
"shift in"
Char
'\DLE' -> forall a. a -> Maybe a
Just String
"data link escape"
Char
'\DC1' -> forall a. a -> Maybe a
Just String
"device control one"
Char
'\DC2' -> forall a. a -> Maybe a
Just String
"device control two"
Char
'\DC3' -> forall a. a -> Maybe a
Just String
"device control three"
Char
'\DC4' -> forall a. a -> Maybe a
Just String
"device control four"
Char
'\NAK' -> forall a. a -> Maybe a
Just String
"negative acknowledge"
Char
'\SYN' -> forall a. a -> Maybe a
Just String
"synchronous idle"
Char
'\ETB' -> forall a. a -> Maybe a
Just String
"end of transmission block"
Char
'\CAN' -> forall a. a -> Maybe a
Just String
"cancel"
Char
'\EM' -> forall a. a -> Maybe a
Just String
"end of medium"
Char
'\SUB' -> forall a. a -> Maybe a
Just String
"substitute"
Char
'\ESC' -> forall a. a -> Maybe a
Just String
"escape"
Char
'\FS' -> forall a. a -> Maybe a
Just String
"file separator"
Char
'\GS' -> forall a. a -> Maybe a
Just String
"group separator"
Char
'\RS' -> forall a. a -> Maybe a
Just String
"record separator"
Char
'\US' -> forall a. a -> Maybe a
Just String
"unit separator"
Char
'\DEL' -> forall a. a -> Maybe a
Just String
"delete"
Char
'\160' -> forall a. a -> Maybe a
Just String
"non-breaking space"
Char
_ -> forall a. Maybe a
Nothing
expandTab ::
Pos ->
String ->
String
expandTab :: Pos -> String -> String
expandTab Pos
w' = Int -> Int -> String -> String
go Int
0 Int
0
where
go :: Int -> Int -> String -> String
go Int
_ Int
0 [] = []
go !Int
i Int
0 (Char
'\t' : String
xs) = Int -> Int -> String -> String
go Int
i (Int
w forall a. Num a => a -> a -> a
- (Int
i forall a. Integral a => a -> a -> a
`rem` Int
w)) String
xs
go !Int
i Int
0 (Char
x : String
xs) = Char
x forall a. a -> [a] -> [a]
: Int -> Int -> String -> String
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) Int
0 String
xs
go !Int
i Int
n String
xs = Char
' ' forall a. a -> [a] -> [a]
: Int -> Int -> String -> String
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Int
n forall a. Num a => a -> a -> a
- Int
1) String
xs
w :: Int
w = Pos -> Int
unPos Pos
w'