{-# 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
-- Copyright   :  © 2015–present Megaparsec contributors
-- License     :  FreeBSD
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Megaparsec's input stream facilities.
--
-- You probably do not want to import this module directly because
-- "Text.Megaparsec" re-exports it anyway.
--
-- @since 6.0.0
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

-- | Type class for inputs that can be consumed by the library.
--
-- Note that the 'Stream' instances for 'Text' and 'ByteString' (strict and
-- lazy) default to "input sharing" (see 'ShareInput', 'NoShareInput'). We plan
-- to move away from input sharing in a future major release; if you want to
-- retain the current behaviour and are concerned with maximum performance you
-- should consider using the 'ShareInput' wrapper explicitly.
--
-- __Note__: before the version /9.0.0/ the class included the methods from
-- 'VisualStream' and 'TraversableStream'.
class (Ord (Token s), Ord (Tokens s)) => Stream s where
  -- | Type of token in the stream.
  type Token s :: Type

  -- | Type of “chunk” of the stream.
  type Tokens s :: Type

  -- | Lift a single token to chunk of the stream. The default
  -- implementation is:
  --
  -- > tokenToChunk pxy = tokensToChunk pxy . pure
  --
  -- However for some types of stream there may be a more efficient way to
  -- lift.
  tokenToChunk :: Proxy s -> Token s -> Tokens s
  tokenToChunk Proxy s
pxy = Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk Proxy s
pxy ([Token s] -> Tokens s)
-> (Token s -> [Token s]) -> Token s -> Tokens s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token s -> [Token s]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  -- | The first method that establishes isomorphism between list of tokens
  -- and chunk of the stream. Valid implementation should satisfy:
  --
  -- > chunkToTokens pxy (tokensToChunk pxy ts) == ts
  tokensToChunk :: Proxy s -> [Token s] -> Tokens s

  -- | The second method that establishes isomorphism between list of tokens
  -- and chunk of the stream. Valid implementation should satisfy:
  --
  -- > tokensToChunk pxy (chunkToTokens pxy chunk) == chunk
  chunkToTokens :: Proxy s -> Tokens s -> [Token s]

  -- | Return length of a chunk of the stream.
  chunkLength :: Proxy s -> Tokens s -> Int

  -- | Check if a chunk of the stream is empty. The default implementation
  -- is in terms of the more general 'chunkLength':
  --
  -- > chunkEmpty pxy ts = chunkLength pxy ts <= 0
  --
  -- However for many streams there may be a more efficient implementation.
  chunkEmpty :: Proxy s -> Tokens s -> Bool
  chunkEmpty Proxy s
pxy Tokens s
ts = Proxy s -> Tokens s -> Int
forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength Proxy s
pxy Tokens s
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0

  -- | Extract a single token form the stream. Return 'Nothing' if the
  -- stream is empty.
  take1_ :: s -> Maybe (Token s, s)

  -- | @'takeN_' n s@ should try to extract a chunk of length @n@, or if the
  -- stream is too short, the rest of the stream. Valid implementation
  -- should follow the rules:
  --
  --     * If the requested length @n@ is 0 (or less), 'Nothing' should
  --       never be returned, instead @'Just' (\"\", s)@ should be returned,
  --       where @\"\"@ stands for the empty chunk, and @s@ is the original
  --       stream (second argument).
  --     * If the requested length is greater than 0 and the stream is
  --       empty, 'Nothing' should be returned indicating end of input.
  --     * In other cases, take chunk of length @n@ (or shorter if the
  --       stream is not long enough) from the input stream and return the
  --       chunk along with the rest of the stream.
  takeN_ :: Int -> s -> Maybe (Tokens s, s)

  -- | Extract chunk of the stream taking tokens while the supplied
  -- predicate returns 'True'. Return the chunk and the rest of the stream.
  --
  -- For many types of streams, the method allows for significant
  -- performance improvements, although it is not strictly necessary from
  -- conceptual point of view.
  takeWhile_ :: (Token s -> Bool) -> s -> (Tokens s, s)

-- | @since 9.0.0
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 = a -> [a]
Token [a] -> Tokens [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  tokensToChunk :: Proxy [a] -> [Token [a]] -> Tokens [a]
tokensToChunk Proxy [a]
Proxy = [a] -> [a]
[Token [a]] -> Tokens [a]
forall a. a -> a
id
  chunkToTokens :: Proxy [a] -> Tokens [a] -> [Token [a]]
chunkToTokens Proxy [a]
Proxy = [a] -> [a]
Tokens [a] -> [Token [a]]
forall a. a -> a
id
  chunkLength :: Proxy [a] -> Tokens [a] -> Int
chunkLength Proxy [a]
Proxy = [a] -> Int
Tokens [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
  chunkEmpty :: Proxy [a] -> Tokens [a] -> Bool
chunkEmpty Proxy [a]
Proxy = [a] -> Bool
Tokens [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  take1_ :: [a] -> Maybe (Token [a], [a])
take1_ [] = Maybe (a, [a])
Maybe (Token [a], [a])
forall a. Maybe a
Nothing
  take1_ (a
t : [a]
ts) = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
t, [a]
ts)
  takeN_ :: Int -> [a] -> Maybe (Tokens [a], [a])
takeN_ Int
n [a]
s
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just ([], [a]
s)
    | [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
s = Maybe ([a], [a])
Maybe (Tokens [a], [a])
forall a. Maybe a
Nothing
    | Bool
otherwise = ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
s)
  takeWhile_ :: (Token [a] -> Bool) -> [a] -> (Tokens [a], [a])
takeWhile_ = (a -> Bool) -> [a] -> ([a], [a])
(Token [a] -> Bool) -> [a] -> (Tokens [a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span

-- | @since 9.0.0
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 = a -> Seq a
Token (Seq a) -> Tokens (Seq a)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  tokensToChunk :: Proxy (Seq a) -> [Token (Seq a)] -> Tokens (Seq a)
tokensToChunk Proxy (Seq a)
Proxy = [a] -> Seq a
[Token (Seq a)] -> Tokens (Seq a)
forall a. [a] -> Seq a
S.fromList
  chunkToTokens :: Proxy (Seq a) -> Tokens (Seq a) -> [Token (Seq a)]
chunkToTokens Proxy (Seq a)
Proxy = Seq a -> [a]
Tokens (Seq a) -> [Token (Seq a)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  chunkLength :: Proxy (Seq a) -> Tokens (Seq a) -> Int
chunkLength Proxy (Seq a)
Proxy = Seq a -> Int
Tokens (Seq a) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
  chunkEmpty :: Proxy (Seq a) -> Tokens (Seq a) -> Bool
chunkEmpty Proxy (Seq a)
Proxy = Seq a -> Bool
Tokens (Seq a) -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  take1_ :: Seq a -> Maybe (Token (Seq a), Seq a)
take1_ Seq a
S.Empty = Maybe (a, Seq a)
Maybe (Token (Seq a), Seq a)
forall a. Maybe a
Nothing
  take1_ (a
t S.:<| Seq a
ts) = (a, Seq a) -> Maybe (a, Seq a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Seq a, Seq a) -> Maybe (Seq a, Seq a)
forall a. a -> Maybe a
Just (Seq a
forall a. Seq a
S.empty, Seq a
s)
    | Seq a -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
s = Maybe (Seq a, Seq a)
Maybe (Tokens (Seq a), Seq a)
forall a. Maybe a
Nothing
    | Bool
otherwise = (Seq a, Seq a) -> Maybe (Seq a, Seq a)
forall a. a -> Maybe a
Just (Int -> Seq a -> (Seq a, Seq a)
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_ = (a -> Bool) -> Seq a -> (Seq a, Seq a)
(Token (Seq a) -> Bool) -> Seq a -> (Tokens (Seq a), Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
S.spanl

-- | This wrapper selects the input-sharing 'Stream' implementation for
-- 'T.Text' ('TL.Text') and 'B.ByteString' ('BL.ByteString'). By input
-- sharing we mean that our parsers will use slices whenever possible to
-- avoid having to copy parts of the input. See also the documentation of
-- 'T.split'.
--
-- Note that using slices is in general faster than copying; on the other
-- hand it also has the potential for causing surprising memory leaks: if
-- any slice of the input survives in the output, holding on to the output
-- will force the entire input 'T.Text'/'B.ByteString' to stay in memory!
-- Even when using lazy 'TL.Text'/'BL.ByteString' we will hold on to whole
-- chunks at a time leading to to significantly worse memory residency in
-- some cases.
--
-- See 'NoShareInput' for a somewhat slower implementation that avoids this
-- memory leak scenario.
--
-- @since 9.3.0
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
Token (ShareInput ByteString) -> Tokens (ShareInput ByteString)
B.singleton
  tokensToChunk :: Proxy (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
-> Tokens (ShareInput ByteString)
tokensToChunk Proxy (ShareInput ByteString)
Proxy = [Word8] -> ByteString
[Token (ShareInput ByteString)] -> Tokens (ShareInput ByteString)
B.pack
  chunkToTokens :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
chunkToTokens Proxy (ShareInput ByteString)
Proxy = ByteString -> [Word8]
Tokens (ShareInput ByteString) -> [Token (ShareInput ByteString)]
B.unpack
  chunkLength :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Int
chunkLength Proxy (ShareInput ByteString)
Proxy = ByteString -> Int
Tokens (ShareInput ByteString) -> Int
B.length
  chunkEmpty :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Bool
chunkEmpty Proxy (ShareInput ByteString)
Proxy = ByteString -> Bool
Tokens (ShareInput ByteString) -> Bool
B.null
  take1_ :: ShareInput ByteString
-> Maybe (Token (ShareInput ByteString), ShareInput ByteString)
take1_ (ShareInput ByteString
s) = (ByteString -> ShareInput ByteString)
-> (Word8, ByteString) -> (Word8, ShareInput ByteString)
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 ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ((Word8, ByteString) -> (Word8, ShareInput ByteString))
-> Maybe (Word8, ByteString)
-> Maybe (Word8, ShareInput ByteString)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (ByteString, ShareInput ByteString)
-> Maybe (ByteString, ShareInput ByteString)
forall a. a -> Maybe a
Just (ByteString
B.empty, ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ByteString
s)
    | ByteString -> Bool
B.null ByteString
s = Maybe (ByteString, ShareInput ByteString)
Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
forall a. Maybe a
Nothing
    | Bool
otherwise = (ByteString, ShareInput ByteString)
-> Maybe (ByteString, ShareInput ByteString)
(ByteString, ShareInput ByteString)
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
forall a. a -> Maybe a
Just ((ByteString, ShareInput ByteString)
 -> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString))
-> ((ByteString, ByteString)
    -> (ByteString, ShareInput ByteString))
-> (ByteString, ByteString)
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ShareInput ByteString)
-> (ByteString, ByteString) -> (ByteString, ShareInput ByteString)
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 ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ((ByteString, ByteString)
 -> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString))
-> (ByteString, ByteString)
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
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) = (ByteString -> ShareInput ByteString)
-> (ByteString, ByteString) -> (ByteString, ShareInput ByteString)
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 ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ((ByteString, ByteString) -> (ByteString, ShareInput ByteString))
-> (ByteString, ByteString) -> (ByteString, ShareInput ByteString)
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Word8 -> Bool
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
Token (ShareInput ByteString) -> Tokens (ShareInput ByteString)
BL.singleton
  tokensToChunk :: Proxy (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
-> Tokens (ShareInput ByteString)
tokensToChunk Proxy (ShareInput ByteString)
Proxy = [Word8] -> ByteString
[Token (ShareInput ByteString)] -> Tokens (ShareInput ByteString)
BL.pack
  chunkToTokens :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
chunkToTokens Proxy (ShareInput ByteString)
Proxy = ByteString -> [Word8]
Tokens (ShareInput ByteString) -> [Token (ShareInput ByteString)]
BL.unpack
  chunkLength :: Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Int
chunkLength Proxy (ShareInput ByteString)
Proxy = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (ByteString -> Int64) -> ByteString -> Int
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
Tokens (ShareInput ByteString) -> Bool
BL.null
  take1_ :: ShareInput ByteString
-> Maybe (Token (ShareInput ByteString), ShareInput ByteString)
take1_ (ShareInput ByteString
s) = (ByteString -> ShareInput ByteString)
-> (Word8, ByteString) -> (Word8, ShareInput ByteString)
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 ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ((Word8, ByteString) -> (Word8, ShareInput ByteString))
-> Maybe (Word8, ByteString)
-> Maybe (Word8, ShareInput ByteString)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (ByteString, ShareInput ByteString)
-> Maybe (ByteString, ShareInput ByteString)
forall a. a -> Maybe a
Just (ByteString
BL.empty, ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ByteString
s)
    | ByteString -> Bool
BL.null ByteString
s = Maybe (ByteString, ShareInput ByteString)
Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
forall a. Maybe a
Nothing
    | Bool
otherwise = (ByteString, ShareInput ByteString)
-> Maybe (ByteString, ShareInput ByteString)
(ByteString, ShareInput ByteString)
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
forall a. a -> Maybe a
Just ((ByteString, ShareInput ByteString)
 -> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString))
-> ((ByteString, ByteString)
    -> (ByteString, ShareInput ByteString))
-> (ByteString, ByteString)
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ShareInput ByteString)
-> (ByteString, ByteString) -> (ByteString, ShareInput ByteString)
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 ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ((ByteString, ByteString)
 -> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString))
-> (ByteString, ByteString)
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt (Int -> Int64
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) = (ByteString -> ShareInput ByteString)
-> (ByteString, ByteString) -> (ByteString, ShareInput ByteString)
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 ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ((ByteString, ByteString) -> (ByteString, ShareInput ByteString))
-> (ByteString, ByteString) -> (ByteString, ShareInput ByteString)
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BL.span Word8 -> Bool
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
Token (ShareInput Text) -> Tokens (ShareInput Text)
T.singleton
  tokensToChunk :: Proxy (ShareInput Text)
-> [Token (ShareInput Text)] -> Tokens (ShareInput Text)
tokensToChunk Proxy (ShareInput Text)
Proxy = String -> Text
[Token (ShareInput Text)] -> Tokens (ShareInput Text)
T.pack
  chunkToTokens :: Proxy (ShareInput Text)
-> Tokens (ShareInput Text) -> [Token (ShareInput Text)]
chunkToTokens Proxy (ShareInput Text)
Proxy = Text -> String
Tokens (ShareInput Text) -> [Token (ShareInput Text)]
T.unpack
  chunkLength :: Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Int
chunkLength Proxy (ShareInput Text)
Proxy = Text -> Int
Tokens (ShareInput Text) -> Int
T.length
  chunkEmpty :: Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Bool
chunkEmpty Proxy (ShareInput Text)
Proxy = Text -> Bool
Tokens (ShareInput Text) -> Bool
T.null
  take1_ :: ShareInput Text -> Maybe (Token (ShareInput Text), ShareInput Text)
take1_ (ShareInput Text
s) = (Text -> ShareInput Text)
-> (Char, Text) -> (Char, ShareInput Text)
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 Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput ((Char, Text) -> (Char, ShareInput Text))
-> Maybe (Char, Text) -> Maybe (Char, ShareInput Text)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Text, ShareInput Text) -> Maybe (Text, ShareInput Text)
forall a. a -> Maybe a
Just (Text
T.empty, Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput Text
s)
    | Text -> Bool
T.null Text
s = Maybe (Text, ShareInput Text)
Maybe (Tokens (ShareInput Text), ShareInput Text)
forall a. Maybe a
Nothing
    | Bool
otherwise = (Text, ShareInput Text) -> Maybe (Text, ShareInput Text)
(Text, ShareInput Text)
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
forall a. a -> Maybe a
Just ((Text, ShareInput Text)
 -> Maybe (Tokens (ShareInput Text), ShareInput Text))
-> ((Text, Text) -> (Text, ShareInput Text))
-> (Text, Text)
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> ShareInput Text)
-> (Text, Text) -> (Text, ShareInput Text)
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 Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput ((Text, Text) -> Maybe (Tokens (ShareInput Text), ShareInput Text))
-> (Text, Text)
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
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) = (Text -> ShareInput Text)
-> (Text, Text) -> (Text, ShareInput Text)
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 Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput ((Text, Text) -> (Text, ShareInput Text))
-> (Text, Text) -> (Text, ShareInput Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
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
Token (ShareInput Text) -> Tokens (ShareInput Text)
TL.singleton
  tokensToChunk :: Proxy (ShareInput Text)
-> [Token (ShareInput Text)] -> Tokens (ShareInput Text)
tokensToChunk Proxy (ShareInput Text)
Proxy = String -> Text
[Token (ShareInput Text)] -> Tokens (ShareInput Text)
TL.pack
  chunkToTokens :: Proxy (ShareInput Text)
-> Tokens (ShareInput Text) -> [Token (ShareInput Text)]
chunkToTokens Proxy (ShareInput Text)
Proxy = Text -> String
Tokens (ShareInput Text) -> [Token (ShareInput Text)]
TL.unpack
  chunkLength :: Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Int
chunkLength Proxy (ShareInput Text)
Proxy = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Text -> Int64) -> Text -> Int
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
Tokens (ShareInput Text) -> Bool
TL.null
  take1_ :: ShareInput Text -> Maybe (Token (ShareInput Text), ShareInput Text)
take1_ (ShareInput Text
s) = (Text -> ShareInput Text)
-> (Char, Text) -> (Char, ShareInput Text)
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 Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput ((Char, Text) -> (Char, ShareInput Text))
-> Maybe (Char, Text) -> Maybe (Char, ShareInput Text)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Text, ShareInput Text) -> Maybe (Text, ShareInput Text)
forall a. a -> Maybe a
Just (Text
TL.empty, Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput Text
s)
    | Text -> Bool
TL.null Text
s = Maybe (Text, ShareInput Text)
Maybe (Tokens (ShareInput Text), ShareInput Text)
forall a. Maybe a
Nothing
    | Bool
otherwise = (Text, ShareInput Text) -> Maybe (Text, ShareInput Text)
(Text, ShareInput Text)
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
forall a. a -> Maybe a
Just ((Text, ShareInput Text)
 -> Maybe (Tokens (ShareInput Text), ShareInput Text))
-> ((Text, Text) -> (Text, ShareInput Text))
-> (Text, Text)
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> ShareInput Text)
-> (Text, Text) -> (Text, ShareInput Text)
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 Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput ((Text, Text) -> Maybe (Tokens (ShareInput Text), ShareInput Text))
-> (Text, Text)
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> (Text, Text)
TL.splitAt (Int -> Int64
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) = (Text -> ShareInput Text)
-> (Text, Text) -> (Text, ShareInput Text)
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 Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput ((Text, Text) -> (Text, ShareInput Text))
-> (Text, Text) -> (Text, ShareInput Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
TL.span Char -> Bool
Token (ShareInput Text) -> Bool
p Text
s

-- | This wrapper selects the no-input-sharing 'Stream' implementation for
-- 'T.Text' ('TL.Text') and 'B.ByteString' ('BL.ByteString'). This means
-- that our parsers will create independent copies rather than using slices
-- of the input. See also the documentation of 'T.copy'.
--
-- More importantly, any parser output will be independent of the input, and
-- holding on to parts of the output will never prevent the input from being
-- garbage collected.
--
-- For maximum performance you might consider using 'ShareInput' instead,
-- but beware of its pitfalls!
--
-- @since 9.3.0
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
Token (NoShareInput ByteString) -> Tokens (NoShareInput ByteString)
B.singleton
  tokensToChunk :: Proxy (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
-> Tokens (NoShareInput ByteString)
tokensToChunk Proxy (NoShareInput ByteString)
Proxy = [Word8] -> ByteString
[Token (NoShareInput ByteString)]
-> Tokens (NoShareInput ByteString)
B.pack
  chunkToTokens :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
chunkToTokens Proxy (NoShareInput ByteString)
Proxy = ByteString -> [Word8]
Tokens (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
B.unpack
  chunkLength :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString) -> Int
chunkLength Proxy (NoShareInput ByteString)
Proxy = ByteString -> Int
Tokens (NoShareInput ByteString) -> Int
B.length
  chunkEmpty :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString) -> Bool
chunkEmpty Proxy (NoShareInput ByteString)
Proxy = ByteString -> Bool
Tokens (NoShareInput ByteString) -> Bool
B.null
  take1_ :: NoShareInput ByteString
-> Maybe (Token (NoShareInput ByteString), NoShareInput ByteString)
take1_ (NoShareInput ByteString
s) = (ByteString -> NoShareInput ByteString)
-> (Word8, ByteString) -> (Word8, NoShareInput ByteString)
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 ByteString -> NoShareInput ByteString
forall a. a -> NoShareInput a
NoShareInput ((Word8, ByteString) -> (Word8, NoShareInput ByteString))
-> Maybe (Word8, ByteString)
-> Maybe (Word8, NoShareInput ByteString)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (ByteString, NoShareInput ByteString)
-> Maybe (ByteString, NoShareInput ByteString)
forall a. a -> Maybe a
Just (ByteString
B.empty, ByteString -> NoShareInput ByteString
forall a. a -> NoShareInput a
NoShareInput ByteString
s)
    | ByteString -> Bool
B.null ByteString
s = Maybe (ByteString, NoShareInput ByteString)
Maybe (Tokens (NoShareInput ByteString), NoShareInput ByteString)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let (ByteString
result, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
s
            -- To avoid sharing the entire input we create a clean copy of the result.
            unSharedResult :: ByteString
unSharedResult = ByteString -> ByteString
B.copy ByteString
result
         in (ByteString, NoShareInput ByteString)
-> Maybe (ByteString, NoShareInput ByteString)
forall a. a -> Maybe a
Just (ByteString
unSharedResult, ByteString -> NoShareInput ByteString
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 Word8 -> Bool
Token (NoShareInput ByteString) -> Bool
p ByteString
s
        -- Ditto.
        unSharedResult :: ByteString
unSharedResult = ByteString -> ByteString
B.copy ByteString
result
     in (ByteString
Tokens (NoShareInput ByteString)
unSharedResult, ByteString -> NoShareInput ByteString
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
Token (NoShareInput ByteString) -> Tokens (NoShareInput ByteString)
BL.singleton
  tokensToChunk :: Proxy (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
-> Tokens (NoShareInput ByteString)
tokensToChunk Proxy (NoShareInput ByteString)
Proxy = [Word8] -> ByteString
[Token (NoShareInput ByteString)]
-> Tokens (NoShareInput ByteString)
BL.pack
  chunkToTokens :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
chunkToTokens Proxy (NoShareInput ByteString)
Proxy = ByteString -> [Word8]
Tokens (NoShareInput ByteString)
-> [Token (NoShareInput ByteString)]
BL.unpack
  chunkLength :: Proxy (NoShareInput ByteString)
-> Tokens (NoShareInput ByteString) -> Int
chunkLength Proxy (NoShareInput ByteString)
Proxy = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (ByteString -> Int64) -> ByteString -> Int
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
Tokens (NoShareInput ByteString) -> Bool
BL.null
  take1_ :: NoShareInput ByteString
-> Maybe (Token (NoShareInput ByteString), NoShareInput ByteString)
take1_ (NoShareInput ByteString
s) = (ByteString -> NoShareInput ByteString)
-> (Word8, ByteString) -> (Word8, NoShareInput ByteString)
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 ByteString -> NoShareInput ByteString
forall a. a -> NoShareInput a
NoShareInput ((Word8, ByteString) -> (Word8, NoShareInput ByteString))
-> Maybe (Word8, ByteString)
-> Maybe (Word8, NoShareInput ByteString)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (ByteString, NoShareInput ByteString)
-> Maybe (ByteString, NoShareInput ByteString)
forall a. a -> Maybe a
Just (ByteString
BL.empty, ByteString -> NoShareInput ByteString
forall a. a -> NoShareInput a
NoShareInput ByteString
s)
    | ByteString -> Bool
BL.null ByteString
s = Maybe (ByteString, NoShareInput ByteString)
Maybe (Tokens (NoShareInput ByteString), NoShareInput ByteString)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let (ByteString
result, ByteString
rest) = Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ByteString
s
            -- To avoid sharing the entire input we create a clean copy of the result.
            unSharedResult :: ByteString
unSharedResult = ByteString -> ByteString
BL.copy ByteString
result
         in (ByteString, NoShareInput ByteString)
-> Maybe (ByteString, NoShareInput ByteString)
forall a. a -> Maybe a
Just (ByteString
unSharedResult, ByteString -> NoShareInput ByteString
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 Word8 -> Bool
Token (NoShareInput ByteString) -> Bool
p ByteString
s
        -- Ditto.
        unSharedResult :: ByteString
unSharedResult = ByteString -> ByteString
BL.copy ByteString
result
     in (ByteString
Tokens (NoShareInput ByteString)
unSharedResult, ByteString -> NoShareInput ByteString
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
Token (NoShareInput Text) -> Tokens (NoShareInput Text)
T.singleton
  tokensToChunk :: Proxy (NoShareInput Text)
-> [Token (NoShareInput Text)] -> Tokens (NoShareInput Text)
tokensToChunk Proxy (NoShareInput Text)
Proxy = String -> Text
[Token (NoShareInput Text)] -> Tokens (NoShareInput Text)
T.pack
  chunkToTokens :: Proxy (NoShareInput Text)
-> Tokens (NoShareInput Text) -> [Token (NoShareInput Text)]
chunkToTokens Proxy (NoShareInput Text)
Proxy = Text -> String
Tokens (NoShareInput Text) -> [Token (NoShareInput Text)]
T.unpack
  chunkLength :: Proxy (NoShareInput Text) -> Tokens (NoShareInput Text) -> Int
chunkLength Proxy (NoShareInput Text)
Proxy = Text -> Int
Tokens (NoShareInput Text) -> Int
T.length
  chunkEmpty :: Proxy (NoShareInput Text) -> Tokens (NoShareInput Text) -> Bool
chunkEmpty Proxy (NoShareInput Text)
Proxy = Text -> Bool
Tokens (NoShareInput Text) -> Bool
T.null
  take1_ :: NoShareInput Text
-> Maybe (Token (NoShareInput Text), NoShareInput Text)
take1_ (NoShareInput Text
s) = (Text -> NoShareInput Text)
-> (Char, Text) -> (Char, NoShareInput Text)
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 Text -> NoShareInput Text
forall a. a -> NoShareInput a
NoShareInput ((Char, Text) -> (Char, NoShareInput Text))
-> Maybe (Char, Text) -> Maybe (Char, NoShareInput Text)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Text, NoShareInput Text) -> Maybe (Text, NoShareInput Text)
forall a. a -> Maybe a
Just (Text
T.empty, Text -> NoShareInput Text
forall a. a -> NoShareInput a
NoShareInput Text
s)
    | Text -> Bool
T.null Text
s = Maybe (Text, NoShareInput Text)
Maybe (Tokens (NoShareInput Text), NoShareInput Text)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let (Text
result, Text
rest) = Int -> Text -> (Text, Text)
T.splitAt Int
n Text
s
            -- To avoid sharing the entire input we create a clean copy of the result.
            unSharedResult :: Text
unSharedResult = Text -> Text
T.copy Text
result
         in (Text, NoShareInput Text) -> Maybe (Text, NoShareInput Text)
forall a. a -> Maybe a
Just (Text
unSharedResult, Text -> NoShareInput Text
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 Char -> Bool
Token (NoShareInput Text) -> Bool
p Text
s
        unSharedResult :: Text
unSharedResult = Text -> Text
T.copy Text
result
     in (Text
Tokens (NoShareInput Text)
unSharedResult, Text -> NoShareInput Text
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
Token (NoShareInput Text) -> Tokens (NoShareInput Text)
TL.singleton
  tokensToChunk :: Proxy (NoShareInput Text)
-> [Token (NoShareInput Text)] -> Tokens (NoShareInput Text)
tokensToChunk Proxy (NoShareInput Text)
Proxy = String -> Text
[Token (NoShareInput Text)] -> Tokens (NoShareInput Text)
TL.pack
  chunkToTokens :: Proxy (NoShareInput Text)
-> Tokens (NoShareInput Text) -> [Token (NoShareInput Text)]
chunkToTokens Proxy (NoShareInput Text)
Proxy = Text -> String
Tokens (NoShareInput Text) -> [Token (NoShareInput Text)]
TL.unpack
  chunkLength :: Proxy (NoShareInput Text) -> Tokens (NoShareInput Text) -> Int
chunkLength Proxy (NoShareInput Text)
Proxy = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Text -> Int64) -> Text -> Int
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
Tokens (NoShareInput Text) -> Bool
TL.null
  take1_ :: NoShareInput Text
-> Maybe (Token (NoShareInput Text), NoShareInput Text)
take1_ (NoShareInput Text
s) = (Text -> NoShareInput Text)
-> (Char, Text) -> (Char, NoShareInput Text)
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 Text -> NoShareInput Text
forall a. a -> NoShareInput a
NoShareInput ((Char, Text) -> (Char, NoShareInput Text))
-> Maybe (Char, Text) -> Maybe (Char, NoShareInput Text)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Text, NoShareInput Text) -> Maybe (Text, NoShareInput Text)
forall a. a -> Maybe a
Just (Text
TL.empty, Text -> NoShareInput Text
forall a. a -> NoShareInput a
NoShareInput Text
s)
    | Text -> Bool
TL.null Text
s = Maybe (Text, NoShareInput Text)
Maybe (Tokens (NoShareInput Text), NoShareInput Text)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let (Text
result, Text
rest) = Int64 -> Text -> (Text, Text)
TL.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Text
s
            -- To avoid sharing the entire input we create a clean copy of the result.
            unSharedResult :: Text
unSharedResult = Text -> Text
tlCopy Text
result
         in (Text, NoShareInput Text) -> Maybe (Text, NoShareInput Text)
forall a. a -> Maybe a
Just (Text
unSharedResult, Text -> NoShareInput Text
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 Char -> Bool
Token (NoShareInput Text) -> Bool
p Text
s
        unSharedResult :: Text
unSharedResult = Text -> Text
tlCopy Text
result
     in (Text
Tokens (NoShareInput Text)
unSharedResult, Text -> NoShareInput Text
forall a. a -> NoShareInput a
NoShareInput Text
rest)

-- | Create an independent copy of a TL.Text, akin to BL.copy.
tlCopy :: TL.Text -> TL.Text
tlCopy :: Text -> Text
tlCopy = Text -> Text
TL.fromStrict (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.copy (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
{-# INLINE tlCopy #-}

-- Since we are using @{-# LANGUAGE Safe #-}@ we can't use deriving via in
-- these cases.

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 = Proxy (ShareInput ByteString)
-> Token (ShareInput ByteString) -> Tokens (ShareInput ByteString)
forall s. Stream s => Proxy s -> Token s -> Tokens s
tokenToChunk (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
  tokensToChunk :: Proxy ByteString -> [Token ByteString] -> Tokens ByteString
tokensToChunk Proxy ByteString
Proxy = Proxy (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
-> Tokens (ShareInput ByteString)
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
  chunkToTokens :: Proxy ByteString -> Tokens ByteString -> [Token ByteString]
chunkToTokens Proxy ByteString
Proxy = Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
  chunkLength :: Proxy ByteString -> Tokens ByteString -> Int
chunkLength Proxy ByteString
Proxy = Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Int
forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
  chunkEmpty :: Proxy ByteString -> Tokens ByteString -> Bool
chunkEmpty Proxy ByteString
Proxy = Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Bool
forall s. Stream s => Proxy s -> Tokens s -> Bool
chunkEmpty (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput B.ByteString))
  take1_ :: ByteString -> Maybe (Token ByteString, ByteString)
take1_ ByteString
s = (ShareInput ByteString -> ByteString)
-> (Word8, ShareInput ByteString) -> (Word8, ByteString)
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 ShareInput ByteString -> ByteString
forall a. ShareInput a -> a
unShareInput ((Word8, ShareInput ByteString) -> (Word8, ByteString))
-> Maybe (Word8, ShareInput ByteString)
-> Maybe (Word8, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShareInput ByteString
-> Maybe (Token (ShareInput ByteString), ShareInput ByteString)
forall s. Stream s => s -> Maybe (Token s, s)
take1_ (ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ByteString
s)
  takeN_ :: Int -> ByteString -> Maybe (Tokens ByteString, ByteString)
takeN_ Int
n ByteString
s = (ShareInput ByteString -> ByteString)
-> (ByteString, ShareInput ByteString) -> (ByteString, ByteString)
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 ShareInput ByteString -> ByteString
forall a. ShareInput a -> a
unShareInput ((ByteString, ShareInput ByteString) -> (ByteString, ByteString))
-> Maybe (ByteString, ShareInput ByteString)
-> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ShareInput ByteString
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ Int
n (ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ByteString
s)
  takeWhile_ :: (Token ByteString -> Bool)
-> ByteString -> (Tokens ByteString, ByteString)
takeWhile_ Token ByteString -> Bool
p ByteString
s = (ShareInput ByteString -> ByteString)
-> (Tokens ByteString, ShareInput ByteString)
-> (Tokens ByteString, ByteString)
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 ShareInput ByteString -> ByteString
forall a. ShareInput a -> a
unShareInput ((Tokens ByteString, ShareInput ByteString)
 -> (Tokens ByteString, ByteString))
-> (Tokens ByteString, ShareInput ByteString)
-> (Tokens ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (Token (ShareInput ByteString) -> Bool)
-> ShareInput ByteString
-> (Tokens (ShareInput ByteString), ShareInput ByteString)
forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ Token ByteString -> Bool
Token (ShareInput ByteString) -> Bool
p (ByteString -> ShareInput ByteString
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 = Proxy (ShareInput ByteString)
-> Token (ShareInput ByteString) -> Tokens (ShareInput ByteString)
forall s. Stream s => Proxy s -> Token s -> Tokens s
tokenToChunk (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
  tokensToChunk :: Proxy ByteString -> [Token ByteString] -> Tokens ByteString
tokensToChunk Proxy ByteString
Proxy = Proxy (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
-> Tokens (ShareInput ByteString)
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
  chunkToTokens :: Proxy ByteString -> Tokens ByteString -> [Token ByteString]
chunkToTokens Proxy ByteString
Proxy = Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString)
-> [Token (ShareInput ByteString)]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
  chunkLength :: Proxy ByteString -> Tokens ByteString -> Int
chunkLength Proxy ByteString
Proxy = Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Int
forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
  chunkEmpty :: Proxy ByteString -> Tokens ByteString -> Bool
chunkEmpty Proxy ByteString
Proxy = Proxy (ShareInput ByteString)
-> Tokens (ShareInput ByteString) -> Bool
forall s. Stream s => Proxy s -> Tokens s -> Bool
chunkEmpty (Proxy (ShareInput ByteString)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput BL.ByteString))
  take1_ :: ByteString -> Maybe (Token ByteString, ByteString)
take1_ ByteString
s = (ShareInput ByteString -> ByteString)
-> (Word8, ShareInput ByteString) -> (Word8, ByteString)
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 ShareInput ByteString -> ByteString
forall a. ShareInput a -> a
unShareInput ((Word8, ShareInput ByteString) -> (Word8, ByteString))
-> Maybe (Word8, ShareInput ByteString)
-> Maybe (Word8, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShareInput ByteString
-> Maybe (Token (ShareInput ByteString), ShareInput ByteString)
forall s. Stream s => s -> Maybe (Token s, s)
take1_ (ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ByteString
s)
  takeN_ :: Int -> ByteString -> Maybe (Tokens ByteString, ByteString)
takeN_ Int
n ByteString
s = (ShareInput ByteString -> ByteString)
-> (ByteString, ShareInput ByteString) -> (ByteString, ByteString)
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 ShareInput ByteString -> ByteString
forall a. ShareInput a -> a
unShareInput ((ByteString, ShareInput ByteString) -> (ByteString, ByteString))
-> Maybe (ByteString, ShareInput ByteString)
-> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ShareInput ByteString
-> Maybe (Tokens (ShareInput ByteString), ShareInput ByteString)
forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ Int
n (ByteString -> ShareInput ByteString
forall a. a -> ShareInput a
ShareInput ByteString
s)
  takeWhile_ :: (Token ByteString -> Bool)
-> ByteString -> (Tokens ByteString, ByteString)
takeWhile_ Token ByteString -> Bool
p ByteString
s = (ShareInput ByteString -> ByteString)
-> (Tokens ByteString, ShareInput ByteString)
-> (Tokens ByteString, ByteString)
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 ShareInput ByteString -> ByteString
forall a. ShareInput a -> a
unShareInput ((Tokens ByteString, ShareInput ByteString)
 -> (Tokens ByteString, ByteString))
-> (Tokens ByteString, ShareInput ByteString)
-> (Tokens ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (Token (ShareInput ByteString) -> Bool)
-> ShareInput ByteString
-> (Tokens (ShareInput ByteString), ShareInput ByteString)
forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ Token ByteString -> Bool
Token (ShareInput ByteString) -> Bool
p (ByteString -> ShareInput ByteString
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 = Proxy (ShareInput Text)
-> Token (ShareInput Text) -> Tokens (ShareInput Text)
forall s. Stream s => Proxy s -> Token s -> Tokens s
tokenToChunk (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
  tokensToChunk :: Proxy Text -> [Token Text] -> Tokens Text
tokensToChunk Proxy Text
Proxy = Proxy (ShareInput Text)
-> [Token (ShareInput Text)] -> Tokens (ShareInput Text)
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
  chunkToTokens :: Proxy Text -> Tokens Text -> [Token Text]
chunkToTokens Proxy Text
Proxy = Proxy (ShareInput Text)
-> Tokens (ShareInput Text) -> [Token (ShareInput Text)]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
  chunkLength :: Proxy Text -> Tokens Text -> Int
chunkLength Proxy Text
Proxy = Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Int
forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
  chunkEmpty :: Proxy Text -> Tokens Text -> Bool
chunkEmpty Proxy Text
Proxy = Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Bool
forall s. Stream s => Proxy s -> Tokens s -> Bool
chunkEmpty (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput T.Text))
  take1_ :: Text -> Maybe (Token Text, Text)
take1_ Text
s = (ShareInput Text -> Text)
-> (Char, ShareInput Text) -> (Char, Text)
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 ShareInput Text -> Text
forall a. ShareInput a -> a
unShareInput ((Char, ShareInput Text) -> (Char, Text))
-> Maybe (Char, ShareInput Text) -> Maybe (Char, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShareInput Text -> Maybe (Token (ShareInput Text), ShareInput Text)
forall s. Stream s => s -> Maybe (Token s, s)
take1_ (Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput Text
s)
  takeN_ :: Int -> Text -> Maybe (Tokens Text, Text)
takeN_ Int
n Text
s = (ShareInput Text -> Text)
-> (Text, ShareInput Text) -> (Text, Text)
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 ShareInput Text -> Text
forall a. ShareInput a -> a
unShareInput ((Text, ShareInput Text) -> (Text, Text))
-> Maybe (Text, ShareInput Text) -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ShareInput Text
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ Int
n (Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput Text
s)
  takeWhile_ :: (Token Text -> Bool) -> Text -> (Tokens Text, Text)
takeWhile_ Token Text -> Bool
p Text
s = (ShareInput Text -> Text)
-> (Tokens Text, ShareInput Text) -> (Tokens Text, Text)
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 ShareInput Text -> Text
forall a. ShareInput a -> a
unShareInput ((Tokens Text, ShareInput Text) -> (Tokens Text, Text))
-> (Tokens Text, ShareInput Text) -> (Tokens Text, Text)
forall a b. (a -> b) -> a -> b
$ (Token (ShareInput Text) -> Bool)
-> ShareInput Text -> (Tokens (ShareInput Text), ShareInput Text)
forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ Token Text -> Bool
Token (ShareInput Text) -> Bool
p (Text -> ShareInput Text
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 = Proxy (ShareInput Text)
-> Token (ShareInput Text) -> Tokens (ShareInput Text)
forall s. Stream s => Proxy s -> Token s -> Tokens s
tokenToChunk (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
  tokensToChunk :: Proxy Text -> [Token Text] -> Tokens Text
tokensToChunk Proxy Text
Proxy = Proxy (ShareInput Text)
-> [Token (ShareInput Text)] -> Tokens (ShareInput Text)
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
  chunkToTokens :: Proxy Text -> Tokens Text -> [Token Text]
chunkToTokens Proxy Text
Proxy = Proxy (ShareInput Text)
-> Tokens (ShareInput Text) -> [Token (ShareInput Text)]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
  chunkLength :: Proxy Text -> Tokens Text -> Int
chunkLength Proxy Text
Proxy = Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Int
forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
  chunkEmpty :: Proxy Text -> Tokens Text -> Bool
chunkEmpty Proxy Text
Proxy = Proxy (ShareInput Text) -> Tokens (ShareInput Text) -> Bool
forall s. Stream s => Proxy s -> Tokens s -> Bool
chunkEmpty (Proxy (ShareInput Text)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ShareInput TL.Text))
  take1_ :: Text -> Maybe (Token Text, Text)
take1_ Text
s = (ShareInput Text -> Text)
-> (Char, ShareInput Text) -> (Char, Text)
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 ShareInput Text -> Text
forall a. ShareInput a -> a
unShareInput ((Char, ShareInput Text) -> (Char, Text))
-> Maybe (Char, ShareInput Text) -> Maybe (Char, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShareInput Text -> Maybe (Token (ShareInput Text), ShareInput Text)
forall s. Stream s => s -> Maybe (Token s, s)
take1_ (Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput Text
s)
  takeN_ :: Int -> Text -> Maybe (Tokens Text, Text)
takeN_ Int
n Text
s = (ShareInput Text -> Text)
-> (Text, ShareInput Text) -> (Text, Text)
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 ShareInput Text -> Text
forall a. ShareInput a -> a
unShareInput ((Text, ShareInput Text) -> (Text, Text))
-> Maybe (Text, ShareInput Text) -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ShareInput Text
-> Maybe (Tokens (ShareInput Text), ShareInput Text)
forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ Int
n (Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput Text
s)
  takeWhile_ :: (Token Text -> Bool) -> Text -> (Tokens Text, Text)
takeWhile_ Token Text -> Bool
p Text
s = (ShareInput Text -> Text)
-> (Tokens Text, ShareInput Text) -> (Tokens Text, Text)
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 ShareInput Text -> Text
forall a. ShareInput a -> a
unShareInput ((Tokens Text, ShareInput Text) -> (Tokens Text, Text))
-> (Tokens Text, ShareInput Text) -> (Tokens Text, Text)
forall a b. (a -> b) -> a -> b
$ (Token (ShareInput Text) -> Bool)
-> ShareInput Text -> (Tokens (ShareInput Text), ShareInput Text)
forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ Token Text -> Bool
Token (ShareInput Text) -> Bool
p (Text -> ShareInput Text
forall a. a -> ShareInput a
ShareInput Text
s)

-- | Type class for inputs that can also be used for debugging.
--
-- @since 9.0.0
class (Stream s) => VisualStream s where
  -- | Pretty-print non-empty stream of tokens. This function is also used
  -- to print single tokens (represented as singleton lists).
  --
  -- @since 7.0.0
  showTokens :: Proxy s -> NonEmpty (Token s) -> String

  -- | Return the number of characters that a non-empty stream of tokens
  -- spans. The default implementation is sufficient if every token spans
  -- exactly 1 character.
  --
  -- @since 8.0.0
  tokensLength :: Proxy s -> NonEmpty (Token s) -> Int
  tokensLength Proxy s
Proxy = NonEmpty (Token s) -> Int
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
NonEmpty (Token String) -> String
stringPretty

instance VisualStream B.ByteString where
  showTokens :: Proxy ByteString -> NonEmpty (Token ByteString) -> String
showTokens Proxy ByteString
Proxy = NonEmpty Char -> String
stringPretty (NonEmpty Char -> String)
-> (NonEmpty Word8 -> NonEmpty Char) -> NonEmpty Word8 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Char) -> NonEmpty Word8 -> NonEmpty Char
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
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)

instance VisualStream BL.ByteString where
  showTokens :: Proxy ByteString -> NonEmpty (Token ByteString) -> String
showTokens Proxy ByteString
Proxy = NonEmpty Char -> String
stringPretty (NonEmpty Char -> String)
-> (NonEmpty Word8 -> NonEmpty Char) -> NonEmpty Word8 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Char) -> NonEmpty Word8 -> NonEmpty Char
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
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)

instance VisualStream T.Text where
  showTokens :: Proxy Text -> NonEmpty (Token Text) -> String
showTokens Proxy Text
Proxy = NonEmpty Char -> String
NonEmpty (Token Text) -> String
stringPretty

instance VisualStream TL.Text where
  showTokens :: Proxy Text -> NonEmpty (Token Text) -> String
showTokens Proxy Text
Proxy = NonEmpty Char -> String
NonEmpty (Token Text) -> String
stringPretty

-- | Type class for inputs that can also be used for error reporting.
--
-- @since 9.0.0
class (Stream s) => TraversableStream s where
  {-# MINIMAL reachOffset | reachOffsetNoLine #-}

  -- | Given an offset @o@ and initial 'PosState', adjust the state in such
  -- a way that it starts at the offset.
  --
  -- Return two values (in order):
  --
  --     * 'Maybe' 'String' representing the line on which the given offset
  --       @o@ is located. It can be omitted (i.e. 'Nothing'); in that case
  --       error reporting functions will not show offending lines. If
  --       returned, the line should satisfy a number of conditions that are
  --       described below.
  --     * The updated 'PosState' which can be in turn used to locate
  --       another offset @o'@ given that @o' >= o@.
  --
  -- The 'String' representing the offending line in input stream should
  -- satisfy the following:
  --
  --     * It should adequately represent location of token at the offset of
  --       interest, that is, character at 'sourceColumn' of the returned
  --       'SourcePos' should correspond to the token at the offset @o@.
  --     * It should not include the newline at the end.
  --     * It should not be empty, if the line happens to be empty, it
  --       should be replaced with the string @\"\<empty line\>\"@.
  --     * Tab characters should be replaced by appropriate number of
  --       spaces, which is determined by the 'pstateTabWidth' field of
  --       'PosState'.
  --
  -- __Note__: type signature of the function was changed in the version
  -- /9.0.0/.
  --
  -- @since 7.0.0
  reachOffset ::
    -- | Offset to reach
    Int ->
    -- | Initial 'PosState' to use
    PosState s ->
    -- | See the description of the function
    (Maybe String, PosState s)
  reachOffset Int
o PosState s
pst =
    (Maybe String
forall a. Maybe a
Nothing, Int -> PosState s -> PosState s
forall s. TraversableStream s => Int -> PosState s -> PosState s
reachOffsetNoLine Int
o PosState s
pst)

  -- | A version of 'reachOffset' that may be faster because it doesn't need
  -- to fetch the line at which the given offset in located.
  --
  -- The default implementation is this:
  --
  -- > reachOffsetNoLine o pst =
  -- >   snd (reachOffset o pst)
  --
  -- __Note__: type signature of the function was changed in the version
  -- /8.0.0/.
  --
  -- @since 7.0.0
  reachOffsetNoLine ::
    -- | Offset to reach
    Int ->
    -- | Initial 'PosState' to use
    PosState s ->
    -- | Reached source position and updated state
    PosState s
  reachOffsetNoLine Int
o PosState s
pst =
    (Maybe String, PosState s) -> PosState s
forall a b. (a, b) -> b
snd (Int -> PosState s -> (Maybe String, PosState s)
forall s.
TraversableStream s =>
Int -> PosState s -> (Maybe String, PosState s)
reachOffset Int
o PosState s
pst)

instance TraversableStream String where
  -- NOTE Do not eta-reduce these (breaks inlining)
  reachOffset :: Int -> PosState String -> (Maybe String, PosState String)
reachOffset Int
o PosState String
pst =
    (Int -> String -> (Tokens String, String))
-> (forall b. (b -> Token String -> b) -> b -> Tokens String -> b)
-> (Tokens String -> String)
-> (Token String -> Char)
-> (Token String, Token String)
-> Int
-> PosState String
-> (Maybe String, PosState String)
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 -> String -> (String, String)
Int -> String -> (Tokens String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (b -> Char -> b) -> b -> String -> b
(b -> Token String -> b) -> b -> Tokens String -> b
forall b. (b -> Token String -> b) -> b -> Tokens String -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' String -> String
Tokens String -> String
forall a. a -> a
id Char -> Char
Token String -> Char
forall a. a -> a
id (Char
Token String
'\n', Char
Token String
'\t') Int
o PosState String
pst
  reachOffsetNoLine :: Int -> PosState String -> PosState String
reachOffsetNoLine Int
o PosState String
pst =
    (Int -> String -> (Tokens String, String))
-> (forall b. (b -> Token String -> b) -> b -> Tokens String -> b)
-> (Token String, Token String)
-> Int
-> PosState String
-> PosState String
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 -> String -> (String, String)
Int -> String -> (Tokens String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (b -> Char -> b) -> b -> String -> b
(b -> Token String -> b) -> b -> Tokens String -> b
forall b. (b -> Token String -> b) -> b -> Tokens String -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Char
Token String
'\n', Char
Token String
'\t') Int
o PosState String
pst

instance TraversableStream B.ByteString where
  -- NOTE Do not eta-reduce these (breaks inlining)
  reachOffset :: Int -> PosState ByteString -> (Maybe String, PosState ByteString)
reachOffset Int
o PosState ByteString
pst =
    (Int -> ByteString -> (Tokens ByteString, ByteString))
-> (forall b.
    (b -> Token ByteString -> b) -> b -> Tokens ByteString -> b)
-> (Tokens ByteString -> String)
-> (Token ByteString -> Char)
-> (Token ByteString, Token ByteString)
-> Int
-> PosState ByteString
-> (Maybe String, PosState ByteString)
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)
Int -> ByteString -> (Tokens ByteString, ByteString)
B.splitAt (b -> Word8 -> b) -> b -> ByteString -> b
(b -> Token ByteString -> b) -> b -> Tokens ByteString -> b
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
forall b.
(b -> Token ByteString -> b) -> b -> Tokens ByteString -> b
B.foldl' ByteString -> String
Tokens ByteString -> String
B8.unpack (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
Token ByteString
10, Word8
Token ByteString
9) Int
o PosState ByteString
pst
  reachOffsetNoLine :: Int -> PosState ByteString -> PosState ByteString
reachOffsetNoLine Int
o PosState ByteString
pst =
    (Int -> ByteString -> (Tokens ByteString, ByteString))
-> (forall b.
    (b -> Token ByteString -> b) -> b -> Tokens ByteString -> b)
-> (Token ByteString, Token ByteString)
-> Int
-> PosState ByteString
-> PosState ByteString
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)
Int -> ByteString -> (Tokens ByteString, ByteString)
B.splitAt (b -> Word8 -> b) -> b -> ByteString -> b
(b -> Token ByteString -> b) -> b -> Tokens ByteString -> b
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
forall b.
(b -> Token ByteString -> b) -> b -> Tokens ByteString -> b
B.foldl' (Word8
Token ByteString
10, Word8
Token ByteString
9) Int
o PosState ByteString
pst

instance TraversableStream BL.ByteString where
  -- NOTE Do not eta-reduce these (breaks inlining)
  reachOffset :: Int -> PosState ByteString -> (Maybe String, PosState ByteString)
reachOffset Int
o PosState ByteString
pst =
    (Int -> ByteString -> (Tokens ByteString, ByteString))
-> (forall b.
    (b -> Token ByteString -> b) -> b -> Tokens ByteString -> b)
-> (Tokens ByteString -> String)
-> (Token ByteString -> Char)
-> (Token ByteString, Token ByteString)
-> Int
-> PosState ByteString
-> (Maybe String, PosState ByteString)
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)
Int -> ByteString -> (Tokens ByteString, ByteString)
splitAtBL (b -> Word8 -> b) -> b -> ByteString -> b
(b -> Token ByteString -> b) -> b -> Tokens ByteString -> b
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
forall b.
(b -> Token ByteString -> b) -> b -> Tokens ByteString -> b
BL.foldl' ByteString -> String
Tokens ByteString -> String
BL8.unpack (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
Token ByteString
10, Word8
Token ByteString
9) Int
o PosState ByteString
pst
  reachOffsetNoLine :: Int -> PosState ByteString -> PosState ByteString
reachOffsetNoLine Int
o PosState ByteString
pst =
    (Int -> ByteString -> (Tokens ByteString, ByteString))
-> (forall b.
    (b -> Token ByteString -> b) -> b -> Tokens ByteString -> b)
-> (Token ByteString, Token ByteString)
-> Int
-> PosState ByteString
-> PosState ByteString
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)
Int -> ByteString -> (Tokens ByteString, ByteString)
splitAtBL (b -> Word8 -> b) -> b -> ByteString -> b
(b -> Token ByteString -> b) -> b -> Tokens ByteString -> b
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
forall b.
(b -> Token ByteString -> b) -> b -> Tokens ByteString -> b
BL.foldl' (Word8
Token ByteString
10, Word8
Token ByteString
9) Int
o PosState ByteString
pst

instance TraversableStream T.Text where
  -- NOTE Do not eta-reduce (breaks inlining of reachOffset').
  reachOffset :: Int -> PosState Text -> (Maybe String, PosState Text)
reachOffset Int
o PosState Text
pst =
    (Int -> Text -> (Tokens Text, Text))
-> (forall b. (b -> Token Text -> b) -> b -> Tokens Text -> b)
-> (Tokens Text -> String)
-> (Token Text -> Char)
-> (Token Text, Token Text)
-> Int
-> PosState Text
-> (Maybe String, PosState Text)
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)
Int -> Text -> (Tokens Text, Text)
T.splitAt (b -> Char -> b) -> b -> Text -> b
(b -> Token Text -> b) -> b -> Tokens Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
forall b. (b -> Token Text -> b) -> b -> Tokens Text -> b
T.foldl' Text -> String
Tokens Text -> String
T.unpack Char -> Char
Token Text -> Char
forall a. a -> a
id (Char
Token Text
'\n', Char
Token Text
'\t') Int
o PosState Text
pst
  reachOffsetNoLine :: Int -> PosState Text -> PosState Text
reachOffsetNoLine Int
o PosState Text
pst =
    (Int -> Text -> (Tokens Text, Text))
-> (forall b. (b -> Token Text -> b) -> b -> Tokens Text -> b)
-> (Token Text, Token Text)
-> Int
-> PosState Text
-> PosState Text
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)
Int -> Text -> (Tokens Text, Text)
T.splitAt (b -> Char -> b) -> b -> Text -> b
(b -> Token Text -> b) -> b -> Tokens Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
forall b. (b -> Token Text -> b) -> b -> Tokens Text -> b
T.foldl' (Char
Token Text
'\n', Char
Token Text
'\t') Int
o PosState Text
pst

instance TraversableStream TL.Text where
  -- NOTE Do not eta-reduce (breaks inlining of reachOffset').
  reachOffset :: Int -> PosState Text -> (Maybe String, PosState Text)
reachOffset Int
o PosState Text
pst =
    (Int -> Text -> (Tokens Text, Text))
-> (forall b. (b -> Token Text -> b) -> b -> Tokens Text -> b)
-> (Tokens Text -> String)
-> (Token Text -> Char)
-> (Token Text, Token Text)
-> Int
-> PosState Text
-> (Maybe String, PosState Text)
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)
Int -> Text -> (Tokens Text, Text)
splitAtTL (b -> Char -> b) -> b -> Text -> b
(b -> Token Text -> b) -> b -> Tokens Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
forall b. (b -> Token Text -> b) -> b -> Tokens Text -> b
TL.foldl' Text -> String
Tokens Text -> String
TL.unpack Char -> Char
Token Text -> Char
forall a. a -> a
id (Char
Token Text
'\n', Char
Token Text
'\t') Int
o PosState Text
pst
  reachOffsetNoLine :: Int -> PosState Text -> PosState Text
reachOffsetNoLine Int
o PosState Text
pst =
    (Int -> Text -> (Tokens Text, Text))
-> (forall b. (b -> Token Text -> b) -> b -> Tokens Text -> b)
-> (Token Text, Token Text)
-> Int
-> PosState Text
-> PosState Text
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)
Int -> Text -> (Tokens Text, Text)
splitAtTL (b -> Char -> b) -> b -> Text -> b
(b -> Token Text -> b) -> b -> Tokens Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
forall b. (b -> Token Text -> b) -> b -> Tokens Text -> b
TL.foldl' (Char
Token Text
'\n', Char
Token Text
'\t') Int
o PosState Text
pst

----------------------------------------------------------------------------
-- Helpers

-- | An internal helper state type combining a difference 'String' and an
-- unboxed 'SourcePos'.
data St = St {-# UNPACK #-} !SourcePos ShowS

-- | A helper definition to facilitate defining 'reachOffset' for various
-- stream types.
reachOffset' ::
  forall s.
  (Stream s) =>
  -- | How to split input stream at given offset
  (Int -> s -> (Tokens s, s)) ->
  -- | How to fold over input stream
  (forall b. (b -> Token s -> b) -> b -> Tokens s -> b) ->
  -- | How to convert chunk of input stream into a 'String'
  (Tokens s -> String) ->
  -- | How to convert a token into a 'Char'
  (Token s -> Char) ->
  -- | Newline token and tab token
  (Token s, Token s) ->
  -- | Offset to reach
  Int ->
  -- | Initial 'PosState' to use
  PosState s ->
  -- | Line at which 'SourcePos' is located, updated 'PosState'
  (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
pstateInput :: s
pstateOffset :: Int
pstateSourcePos :: SourcePos
pstateTabWidth :: Pos
pstateLinePrefix :: String
pstateInput :: forall s. PosState s -> s
pstateOffset :: forall s. PosState s -> Int
pstateSourcePos :: forall s. PosState s -> SourcePos
pstateTabWidth :: forall s. PosState s -> Pos
pstateLinePrefix :: forall s. PosState s -> String
..} =
    ( String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case Pos -> String -> String
expandTab Pos
pstateTabWidth
        (String -> String)
-> ((Tokens s, s) -> String) -> (Tokens s, s) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addPrefix
        (String -> String)
-> ((Tokens s, s) -> String) -> (Tokens s, s) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
        (String -> String)
-> ((Tokens s, s) -> String) -> (Tokens s, s) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tokens s -> String
fromToks
        (Tokens s -> String)
-> ((Tokens s, s) -> Tokens s) -> (Tokens s, s) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tokens s, s) -> Tokens s
forall a b. (a, b) -> a
fst
        ((Tokens s, s) -> String) -> (Tokens s, s) -> String
forall a b. (a -> b) -> a -> b
$ (Token s -> Bool) -> s -> (Tokens s, s)
forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ (Token s -> Token s -> Bool
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 = Int -> Int -> Int
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 -- NOTE We don't use difference lists here because it's
              -- desirable for 'PosState' to be an instance of 'Eq' and
              -- 'Show'. So we just do appending here. Fortunately several
              -- parse errors on the same line should be relatively rare.
                String
pstateLinePrefix String -> String -> String
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs
          else String
xs
      sameLine :: Bool
sameLine = SourcePos -> Pos
sourceLine SourcePos
spos Pos -> Pos -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pstateOffset) s
pstateInput
      St SourcePos
spos String -> String
f = (St -> Token s -> St) -> St -> Tokens s -> St
forall b. (b -> Token s -> b) -> b -> Tokens s -> b
foldl'' St -> Token s -> St
go (SourcePos -> (String -> String) -> St
St SourcePos
pstateSourcePos String -> String
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 Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
== Token s
newlineTok ->
                  SourcePos -> (String -> String) -> St
St
                    (String -> Pos -> Pos -> SourcePos
SourcePos String
n (Pos
l Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1) Pos
pos1)
                    String -> String
forall a. a -> a
id
              | Token s
ch Token s -> Token s -> Bool
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 (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
w)))
                    (String -> String
g (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token s -> Char
fromTok Token s
ch Char -> String -> String
forall a. a -> [a] -> [a]
:))
              | Bool
otherwise ->
                  SourcePos -> (String -> String) -> St
St
                    (String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Pos
c Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1))
                    (String -> String
g (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token s -> Char
fromTok Token s
ch Char -> String -> String
forall a. a -> [a] -> [a]
:))
{-# INLINE reachOffset' #-}

-- | Like 'reachOffset'' but for 'reachOffsetNoLine'.
reachOffsetNoLine' ::
  forall s.
  (Stream s) =>
  -- | How to split input stream at given offset
  (Int -> s -> (Tokens s, s)) ->
  -- | How to fold over input stream
  (forall b. (b -> Token s -> b) -> b -> Tokens s -> b) ->
  -- | Newline token and tab token
  (Token s, Token s) ->
  -- | Offset to reach
  Int ->
  -- | Initial 'PosState' to use
  PosState s ->
  -- | Updated 'PosState'
  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
pstateInput :: forall s. PosState s -> s
pstateOffset :: forall s. PosState s -> Int
pstateSourcePos :: forall s. PosState s -> SourcePos
pstateTabWidth :: forall s. PosState s -> Pos
pstateLinePrefix :: forall s. PosState s -> String
pstateInput :: s
pstateOffset :: Int
pstateSourcePos :: SourcePos
pstateTabWidth :: Pos
pstateLinePrefix :: String
..} =
    ( PosState
        { pstateInput :: s
pstateInput = s
post,
          pstateOffset :: Int
pstateOffset = Int -> Int -> Int
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 = (SourcePos -> Token s -> SourcePos)
-> SourcePos -> Tokens s -> SourcePos
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 Int -> Int -> Int
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 Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
== Token s
newlineTok ->
                  String -> Pos -> Pos -> SourcePos
SourcePos String
n (Pos
l Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1) Pos
pos1
              | Token s
ch Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
== Token s
tabTok ->
                  String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Int -> Pos
mkPos (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
w))
              | Bool
otherwise ->
                  String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Pos
c Pos -> Pos -> Pos
forall a. Semigroup a => a -> a -> a
<> Pos
pos1)
{-# INLINE reachOffsetNoLine' #-}

-- | Like 'BL.splitAt' but accepts the index as an 'Int'.
splitAtBL :: Int -> BL.ByteString -> (BL.ByteString, BL.ByteString)
splitAtBL :: Int -> ByteString -> (ByteString, ByteString)
splitAtBL Int
n = Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
{-# INLINE splitAtBL #-}

-- | Like 'TL.splitAt' but accepts the index as an 'Int'.
splitAtTL :: Int -> TL.Text -> (TL.Text, TL.Text)
splitAtTL :: Int -> Text -> (Text, Text)
splitAtTL Int
n = Int64 -> Text -> (Text, Text)
TL.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
{-# INLINE splitAtTL #-}

-- | @stringPretty s@ returns pretty representation of string @s@. This is
-- used when printing string tokens in error messages.
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
"\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f (NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Char
xs) String -> String -> String
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
"<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pretty String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"

-- | @charPretty ch@ returns user-friendly string representation of given
-- character @ch@, suitable for using in error messages.
charPretty :: Char -> String
charPretty :: Char -> String
charPretty Char
' ' = String
"space"
charPretty Char
ch = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String
"'" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
ch] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'") (Char -> Maybe String
charPretty' Char
ch)

-- | If the given character has a pretty representation, return that,
-- otherwise 'Nothing'. This is an internal helper.
charPretty' :: Char -> Maybe String
charPretty' :: Char -> Maybe String
charPretty' = \case
  Char
'\NUL' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"null"
  Char
'\SOH' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"start of heading"
  Char
'\STX' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"start of text"
  Char
'\ETX' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"end of text"
  Char
'\EOT' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"end of transmission"
  Char
'\ENQ' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"enquiry"
  Char
'\ACK' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"acknowledge"
  Char
'\BEL' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"bell"
  Char
'\BS' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"backspace"
  Char
'\t' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"tab"
  Char
'\n' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"newline"
  Char
'\v' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"vertical tab"
  Char
'\f' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"form feed"
  Char
'\r' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"carriage return"
  Char
'\SO' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"shift out"
  Char
'\SI' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"shift in"
  Char
'\DLE' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"data link escape"
  Char
'\DC1' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"device control one"
  Char
'\DC2' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"device control two"
  Char
'\DC3' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"device control three"
  Char
'\DC4' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"device control four"
  Char
'\NAK' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"negative acknowledge"
  Char
'\SYN' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"synchronous idle"
  Char
'\ETB' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"end of transmission block"
  Char
'\CAN' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"cancel"
  Char
'\EM' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"end of medium"
  Char
'\SUB' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"substitute"
  Char
'\ESC' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"escape"
  Char
'\FS' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"file separator"
  Char
'\GS' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"group separator"
  Char
'\RS' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"record separator"
  Char
'\US' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"unit separator"
  Char
'\DEL' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"delete"
  Char
'\160' -> String -> Maybe String
forall a. a -> Maybe a
Just String
"non-breaking space"
  Char
_ -> Maybe String
forall a. Maybe a
Nothing

-- | Replace tab characters with given number of spaces.
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
w)) String
xs
    go !Int
i Int
0 (Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Int -> String -> String
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 String
xs
    go !Int
i Int
n String
xs = Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Int -> String -> String
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
xs
    w :: Int
w = Pos -> Int
unPos Pos
w'