{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- 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 (..),
    VisualStream (..),
    TraversableStream (..),
  )
where

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__: 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 = forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk Proxy s
pxy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

  -- | 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 = forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength Proxy s
pxy Tokens s
ts forall a. Ord a => a -> a -> Bool
<= Int
0

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

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

instance Stream B.ByteString where
  type Token B.ByteString = Word8
  type Tokens B.ByteString = B.ByteString
  tokenToChunk :: Proxy ByteString -> Token ByteString -> Tokens ByteString
tokenToChunk Proxy ByteString
Proxy = Word8 -> ByteString
B.singleton
  tokensToChunk :: Proxy ByteString -> [Token ByteString] -> Tokens ByteString
tokensToChunk Proxy ByteString
Proxy = [Word8] -> ByteString
B.pack
  chunkToTokens :: Proxy ByteString -> Tokens ByteString -> [Token ByteString]
chunkToTokens Proxy ByteString
Proxy = ByteString -> [Word8]
B.unpack
  chunkLength :: Proxy ByteString -> Tokens ByteString -> Int
chunkLength Proxy ByteString
Proxy = ByteString -> Int
B.length
  chunkEmpty :: Proxy ByteString -> Tokens ByteString -> Bool
chunkEmpty Proxy ByteString
Proxy = ByteString -> Bool
B.null
  take1_ :: ByteString -> Maybe (Token ByteString, ByteString)
take1_ = ByteString -> Maybe (Word8, ByteString)
B.uncons
  takeN_ :: Int -> ByteString -> Maybe (Tokens ByteString, ByteString)
takeN_ Int
n ByteString
s
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (ByteString
B.empty, ByteString
s)
    | ByteString -> Bool
B.null ByteString
s = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
s)
  takeWhile_ :: (Token ByteString -> Bool)
-> ByteString -> (Tokens ByteString, ByteString)
takeWhile_ = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span

instance Stream BL.ByteString where
  type Token BL.ByteString = Word8
  type Tokens BL.ByteString = BL.ByteString
  tokenToChunk :: Proxy ByteString -> Token ByteString -> Tokens ByteString
tokenToChunk Proxy ByteString
Proxy = Word8 -> ByteString
BL.singleton
  tokensToChunk :: Proxy ByteString -> [Token ByteString] -> Tokens ByteString
tokensToChunk Proxy ByteString
Proxy = [Word8] -> ByteString
BL.pack
  chunkToTokens :: Proxy ByteString -> Tokens ByteString -> [Token ByteString]
chunkToTokens Proxy ByteString
Proxy = ByteString -> [Word8]
BL.unpack
  chunkLength :: Proxy ByteString -> Tokens ByteString -> Int
chunkLength Proxy ByteString
Proxy = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length
  chunkEmpty :: Proxy ByteString -> Tokens ByteString -> Bool
chunkEmpty Proxy ByteString
Proxy = ByteString -> Bool
BL.null
  take1_ :: ByteString -> Maybe (Token ByteString, ByteString)
take1_ = ByteString -> Maybe (Word8, ByteString)
BL.uncons
  takeN_ :: Int -> ByteString -> Maybe (Tokens ByteString, ByteString)
takeN_ Int
n ByteString
s
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (ByteString
BL.empty, ByteString
s)
    | ByteString -> Bool
BL.null ByteString
s = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ByteString
s)
  takeWhile_ :: (Token ByteString -> Bool)
-> ByteString -> (Tokens ByteString, ByteString)
takeWhile_ = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BL.span

instance Stream T.Text where
  type Token T.Text = Char
  type Tokens T.Text = T.Text
  tokenToChunk :: Proxy Text -> Token Text -> Tokens Text
tokenToChunk Proxy Text
Proxy = Char -> Text
T.singleton
  tokensToChunk :: Proxy Text -> [Token Text] -> Tokens Text
tokensToChunk Proxy Text
Proxy = String -> Text
T.pack
  chunkToTokens :: Proxy Text -> Tokens Text -> [Token Text]
chunkToTokens Proxy Text
Proxy = Text -> String
T.unpack
  chunkLength :: Proxy Text -> Tokens Text -> Int
chunkLength Proxy Text
Proxy = Text -> Int
T.length
  chunkEmpty :: Proxy Text -> Tokens Text -> Bool
chunkEmpty Proxy Text
Proxy = Text -> Bool
T.null
  take1_ :: Text -> Maybe (Token Text, Text)
take1_ = Text -> Maybe (Char, Text)
T.uncons
  takeN_ :: Int -> Text -> Maybe (Tokens Text, Text)
takeN_ Int
n Text
s
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (Text
T.empty, Text
s)
    | Text -> Bool
T.null Text
s = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (Int -> Text -> (Text, Text)
T.splitAt Int
n Text
s)
  takeWhile_ :: (Token Text -> Bool) -> Text -> (Tokens Text, Text)
takeWhile_ = (Char -> Bool) -> Text -> (Text, Text)
T.span

instance Stream TL.Text where
  type Token TL.Text = Char
  type Tokens TL.Text = TL.Text
  tokenToChunk :: Proxy Text -> Token Text -> Tokens Text
tokenToChunk Proxy Text
Proxy = Char -> Text
TL.singleton
  tokensToChunk :: Proxy Text -> [Token Text] -> Tokens Text
tokensToChunk Proxy Text
Proxy = String -> Text
TL.pack
  chunkToTokens :: Proxy Text -> Tokens Text -> [Token Text]
chunkToTokens Proxy Text
Proxy = Text -> String
TL.unpack
  chunkLength :: Proxy Text -> Tokens Text -> Int
chunkLength Proxy Text
Proxy = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
TL.length
  chunkEmpty :: Proxy Text -> Tokens Text -> Bool
chunkEmpty Proxy Text
Proxy = Text -> Bool
TL.null
  take1_ :: Text -> Maybe (Token Text, Text)
take1_ = Text -> Maybe (Char, Text)
TL.uncons
  takeN_ :: Int -> Text -> Maybe (Tokens Text, Text)
takeN_ Int
n Text
s
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (Text
TL.empty, Text
s)
    | Text -> Bool
TL.null Text
s = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (Int64 -> Text -> (Text, Text)
TL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Text
s)
  takeWhile_ :: (Token Text -> Bool) -> Text -> (Tokens Text, Text)
takeWhile_ = (Char -> Bool) -> Text -> (Text, Text)
TL.span

-- | 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 = forall a. NonEmpty a -> Int
NE.length

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

instance VisualStream B.ByteString where
  showTokens :: Proxy ByteString -> NonEmpty (Token ByteString) -> String
showTokens Proxy ByteString
Proxy = NonEmpty Char -> String
stringPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance VisualStream BL.ByteString where
  showTokens :: Proxy ByteString -> NonEmpty (Token ByteString) -> String
showTokens Proxy ByteString
Proxy = NonEmpty Char -> String
stringPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)

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

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

-- | 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 =
    (forall a. Maybe a
Nothing, 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 =
    forall a b. (a, b) -> b
snd (forall s.
TraversableStream s =>
Int -> PosState s -> (Maybe String, PosState s)
reachOffset Int
o PosState s
pst)

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

instance TraversableStream B.ByteString where
  -- NOTE Do not eta-reduce these (breaks inlining)
  reachOffset :: Int -> PosState ByteString -> (Maybe String, PosState ByteString)
reachOffset Int
o PosState ByteString
pst =
    forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Tokens s -> String)
-> (Token s -> Char)
-> (Token s, Token s)
-> Int
-> PosState s
-> (Maybe String, PosState s)
reachOffset' Int -> ByteString -> (ByteString, ByteString)
B.splitAt forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' ByteString -> String
B8.unpack (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word8
10, Word8
9) Int
o PosState ByteString
pst
  reachOffsetNoLine :: Int -> PosState ByteString -> PosState ByteString
reachOffsetNoLine Int
o PosState ByteString
pst =
    forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Token s, Token s)
-> Int
-> PosState s
-> PosState s
reachOffsetNoLine' Int -> ByteString -> (ByteString, ByteString)
B.splitAt forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (Word8
10, Word8
9) Int
o PosState ByteString
pst

instance TraversableStream BL.ByteString where
  -- NOTE Do not eta-reduce these (breaks inlining)
  reachOffset :: Int -> PosState ByteString -> (Maybe String, PosState ByteString)
reachOffset Int
o PosState ByteString
pst =
    forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Tokens s -> String)
-> (Token s -> Char)
-> (Token s, Token s)
-> Int
-> PosState s
-> (Maybe String, PosState s)
reachOffset' Int -> ByteString -> (ByteString, ByteString)
splitAtBL forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BL.foldl' ByteString -> String
BL8.unpack (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word8
10, Word8
9) Int
o PosState ByteString
pst
  reachOffsetNoLine :: Int -> PosState ByteString -> PosState ByteString
reachOffsetNoLine Int
o PosState ByteString
pst =
    forall s.
Stream s =>
(Int -> s -> (Tokens s, s))
-> (forall b. (b -> Token s -> b) -> b -> Tokens s -> b)
-> (Token s, Token s)
-> Int
-> PosState s
-> PosState s
reachOffsetNoLine' Int -> ByteString -> (ByteString, ByteString)
splitAtBL forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BL.foldl' (Word8
10, Word8
9) Int
o PosState ByteString
pst

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

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

----------------------------------------------------------------------------
-- 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
pstateLinePrefix :: forall s. PosState s -> String
pstateTabWidth :: forall s. PosState s -> Pos
pstateSourcePos :: forall s. PosState s -> SourcePos
pstateOffset :: forall s. PosState s -> Int
pstateInput :: forall s. PosState s -> s
pstateLinePrefix :: String
pstateTabWidth :: Pos
pstateSourcePos :: SourcePos
pstateOffset :: Int
pstateInput :: s
..} =
    ( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Pos -> String -> String
expandTab Pos
pstateTabWidth
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addPrefix
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tokens s -> String
fromToks
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
        forall a b. (a -> b) -> a -> b
$ forall s. Stream s => (Token s -> Bool) -> s -> (Tokens s, s)
takeWhile_ (forall a. Eq a => a -> a -> Bool
/= Token s
newlineTok) s
post of
        String
"" -> String
"<empty line>"
        String
xs -> String
xs,
      PosState
        { pstateInput :: s
pstateInput = s
post,
          pstateOffset :: Int
pstateOffset = forall a. Ord a => a -> a -> a
max Int
pstateOffset Int
o,
          pstateSourcePos :: SourcePos
pstateSourcePos = SourcePos
spos,
          pstateTabWidth :: Pos
pstateTabWidth = Pos
pstateTabWidth,
          pstateLinePrefix :: String
pstateLinePrefix =
            if Bool
sameLine
              then -- 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 forall a. [a] -> [a] -> [a]
++ String -> String
f String
""
              else String -> String
f String
""
        }
    )
    where
      addPrefix :: String -> String
addPrefix String
xs =
        if Bool
sameLine
          then String
pstateLinePrefix forall a. [a] -> [a] -> [a]
++ String
xs
          else String
xs
      sameLine :: Bool
sameLine = SourcePos -> Pos
sourceLine SourcePos
spos forall a. Eq a => a -> a -> Bool
== SourcePos -> Pos
sourceLine SourcePos
pstateSourcePos
      (Tokens s
pre, s
post) = Int -> s -> (Tokens s, s)
splitAt' (Int
o forall a. Num a => a -> a -> a
- Int
pstateOffset) s
pstateInput
      St SourcePos
spos String -> String
f = forall b. (b -> Token s -> b) -> b -> Tokens s -> b
foldl'' St -> Token s -> St
go (SourcePos -> (String -> String) -> St
St SourcePos
pstateSourcePos forall a. a -> a
id) Tokens s
pre
      go :: St -> Token s -> St
go (St SourcePos
apos String -> String
g) Token s
ch =
        let SourcePos String
n Pos
l Pos
c = SourcePos
apos
            c' :: Int
c' = Pos -> Int
unPos Pos
c
            w :: Int
w = Pos -> Int
unPos Pos
pstateTabWidth
         in if
                | Token s
ch forall a. Eq a => a -> a -> Bool
== Token s
newlineTok ->
                    SourcePos -> (String -> String) -> St
St
                      (String -> Pos -> Pos -> SourcePos
SourcePos String
n (Pos
l forall a. Semigroup a => a -> a -> a
<> Pos
pos1) Pos
pos1)
                      forall a. a -> a
id
                | Token s
ch forall a. Eq a => a -> a -> Bool
== Token s
tabTok ->
                    SourcePos -> (String -> String) -> St
St
                      (String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Int -> Pos
mkPos forall a b. (a -> b) -> a -> b
$ Int
c' forall a. Num a => a -> a -> a
+ Int
w forall a. Num a => a -> a -> a
- ((Int
c' forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`rem` Int
w)))
                      (String -> String
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token s -> Char
fromTok Token s
ch forall a. a -> [a] -> [a]
:))
                | Bool
otherwise ->
                    SourcePos -> (String -> String) -> St
St
                      (String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Pos
c forall a. Semigroup a => a -> a -> a
<> Pos
pos1))
                      (String -> String
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token s -> Char
fromTok Token s
ch forall a. a -> [a] -> [a]
:))
{-# INLINE reachOffset' #-}

-- | 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
pstateLinePrefix :: String
pstateTabWidth :: Pos
pstateSourcePos :: SourcePos
pstateOffset :: Int
pstateInput :: s
pstateLinePrefix :: forall s. PosState s -> String
pstateTabWidth :: forall s. PosState s -> Pos
pstateSourcePos :: forall s. PosState s -> SourcePos
pstateOffset :: forall s. PosState s -> Int
pstateInput :: forall s. PosState s -> s
..} =
    ( PosState
        { pstateInput :: s
pstateInput = s
post,
          pstateOffset :: Int
pstateOffset = forall a. Ord a => a -> a -> a
max Int
pstateOffset Int
o,
          pstateSourcePos :: SourcePos
pstateSourcePos = SourcePos
spos,
          pstateTabWidth :: Pos
pstateTabWidth = Pos
pstateTabWidth,
          pstateLinePrefix :: String
pstateLinePrefix = String
pstateLinePrefix
        }
    )
    where
      spos :: SourcePos
spos = forall b. (b -> Token s -> b) -> b -> Tokens s -> b
foldl'' SourcePos -> Token s -> SourcePos
go SourcePos
pstateSourcePos Tokens s
pre
      (Tokens s
pre, s
post) = Int -> s -> (Tokens s, s)
splitAt' (Int
o forall a. Num a => a -> a -> a
- Int
pstateOffset) s
pstateInput
      go :: SourcePos -> Token s -> SourcePos
go (SourcePos String
n Pos
l Pos
c) Token s
ch =
        let c' :: Int
c' = Pos -> Int
unPos Pos
c
            w :: Int
w = Pos -> Int
unPos Pos
pstateTabWidth
         in if
                | Token s
ch forall a. Eq a => a -> a -> Bool
== Token s
newlineTok ->
                    String -> Pos -> Pos -> SourcePos
SourcePos String
n (Pos
l forall a. Semigroup a => a -> a -> a
<> Pos
pos1) Pos
pos1
                | Token s
ch forall a. Eq a => a -> a -> Bool
== Token s
tabTok ->
                    String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Int -> Pos
mkPos forall a b. (a -> b) -> a -> b
$ Int
c' forall a. Num a => a -> a -> a
+ Int
w forall a. Num a => a -> a -> a
- ((Int
c' forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`rem` Int
w))
                | Bool
otherwise ->
                    String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
l (Pos
c forall a. Semigroup a => a -> a -> a
<> Pos
pos1)
{-# INLINE reachOffsetNoLine' #-}

-- | 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 (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 (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
"\"" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f (forall a. NonEmpty a -> [a]
NE.toList NonEmpty Char
xs) forall a. Semigroup a => a -> a -> a
<> String
"\""
  where
    f :: Char -> String
f Char
ch =
      case Char -> Maybe String
charPretty' Char
ch of
        Maybe String
Nothing -> [Char
ch]
        Just String
pretty -> String
"<" forall a. Semigroup a => a -> a -> a
<> String
pretty forall a. Semigroup a => a -> a -> a
<> String
">"

-- | @charPretty 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 = forall a. a -> Maybe a -> a
fromMaybe (String
"'" forall a. Semigroup a => a -> a -> a
<> [Char
ch] forall a. Semigroup a => a -> a -> a
<> String
"'") (Char -> Maybe String
charPretty' Char
ch)

-- | 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' -> forall a. a -> Maybe a
Just String
"null"
  Char
'\SOH' -> forall a. a -> Maybe a
Just String
"start of heading"
  Char
'\STX' -> forall a. a -> Maybe a
Just String
"start of text"
  Char
'\ETX' -> forall a. a -> Maybe a
Just String
"end of text"
  Char
'\EOT' -> forall a. a -> Maybe a
Just String
"end of transmission"
  Char
'\ENQ' -> forall a. a -> Maybe a
Just String
"enquiry"
  Char
'\ACK' -> forall a. a -> Maybe a
Just String
"acknowledge"
  Char
'\BEL' -> forall a. a -> Maybe a
Just String
"bell"
  Char
'\BS' -> forall a. a -> Maybe a
Just String
"backspace"
  Char
'\t' -> forall a. a -> Maybe a
Just String
"tab"
  Char
'\n' -> forall a. a -> Maybe a
Just String
"newline"
  Char
'\v' -> forall a. a -> Maybe a
Just String
"vertical tab"
  Char
'\f' -> forall a. a -> Maybe a
Just String
"form feed"
  Char
'\r' -> forall a. a -> Maybe a
Just String
"carriage return"
  Char
'\SO' -> forall a. a -> Maybe a
Just String
"shift out"
  Char
'\SI' -> forall a. a -> Maybe a
Just String
"shift in"
  Char
'\DLE' -> forall a. a -> Maybe a
Just String
"data link escape"
  Char
'\DC1' -> forall a. a -> Maybe a
Just String
"device control one"
  Char
'\DC2' -> forall a. a -> Maybe a
Just String
"device control two"
  Char
'\DC3' -> forall a. a -> Maybe a
Just String
"device control three"
  Char
'\DC4' -> forall a. a -> Maybe a
Just String
"device control four"
  Char
'\NAK' -> forall a. a -> Maybe a
Just String
"negative acknowledge"
  Char
'\SYN' -> forall a. a -> Maybe a
Just String
"synchronous idle"
  Char
'\ETB' -> forall a. a -> Maybe a
Just String
"end of transmission block"
  Char
'\CAN' -> forall a. a -> Maybe a
Just String
"cancel"
  Char
'\EM' -> forall a. a -> Maybe a
Just String
"end of medium"
  Char
'\SUB' -> forall a. a -> Maybe a
Just String
"substitute"
  Char
'\ESC' -> forall a. a -> Maybe a
Just String
"escape"
  Char
'\FS' -> forall a. a -> Maybe a
Just String
"file separator"
  Char
'\GS' -> forall a. a -> Maybe a
Just String
"group separator"
  Char
'\RS' -> forall a. a -> Maybe a
Just String
"record separator"
  Char
'\US' -> forall a. a -> Maybe a
Just String
"unit separator"
  Char
'\DEL' -> forall a. a -> Maybe a
Just String
"delete"
  Char
'\160' -> forall a. a -> Maybe a
Just String
"non-breaking space"
  Char
_ -> forall a. Maybe a
Nothing

-- | Replace tab characters with given number of spaces.
expandTab ::
  Pos ->
  String ->
  String
expandTab :: Pos -> String -> String
expandTab Pos
w' = Int -> String -> String
go Int
0
  where
    go :: Int -> String -> String
go Int
0 [] = []
    go Int
0 (Char
'\t' : String
xs) = Int -> String -> String
go Int
w String
xs
    go Int
0 (Char
x : String
xs) = Char
x forall a. a -> [a] -> [a]
: Int -> String -> String
go Int
0 String
xs
    go Int
n String
xs = Char
' ' forall a. a -> [a] -> [a]
: Int -> String -> String
go (Int
n forall a. Num a => a -> a -> a
- Int
1) String
xs
    w :: Int
w = Pos -> Int
unPos Pos
w'