{-# LANGUAGE BlockArguments   #-}
{-# LANGUAGE DeriveFunctor    #-}
{-# LANGUAGE FlexibleContexts #-}

-- |

-- Module      :  Text.Megaparsec.Char.Lexer.New

-- Copyright   :  (c) 2022 Lev Dvorkin

-- License     :  BSD3

--

-- Maintainer  :  Lev Dvorkin <lev_135@mail.ru>

-- Stability   :  experimental

-- Portability :  non-portable

--

-- This module provides alternative to /Text.Megaparsec.Char.Lexer/ approach

-- for lexing process, especially for indentation-sensitive parsing.

-- It's highly not recommended to mix functions from these two modules.

--

-- Parsing of white space is an important part of any parser. We propose

-- a special policy for consuming line spaces (i. e. spaces and tabs) and line

-- endings:

--

-- - For line spaces we follow /Text.Megaparsec.Char.Lexer/: each lexeme should

--   consume __all line spaces after it__ and this can be done by wrapping it in

--   `lexeme` combinator.

-- - For end of line symbols we have a different convention: parser should

--   consume __only eols inside it's block__, but __not those, which follow it__.

--

-- Also note that you need to call 'space' manually to consume any white space

-- before the first lexeme (i.e. at the beginning of the file).

--

-- This module is intended to be imported qualified:

--

-- > import qualified Text.Megaparsec.Char.Lexer.New as L

--


module Text.Megaparsec.Char.Lexer.New
  ( -- * Space consumer wrappers

    Sc (..), Scn,
    -- * White space

    L.space,
    lexeme,
    symbol,
    symbol',
    L.skipLineComment,
    L.skipBlockComment,
    L.skipBlockCommentNested,

    -- * Indentation

    -- ** Primitives for indentation-sensitive parsing

    L.indentLevel,
    L.incorrectIndent,
    L.indentGuard,
    -- ** Blocks of line

    block,
    blockWith,
    -- ** Headed blocks

    -- *** Simple combinators

    headedOne,
    headedOptional,
    headedSome,
    headedMany,
    -- *** General combinators

    headedBlock,
    Body,
    pureBody,
    oneBody,
    optionBody,
    optionalBody,
    someBody,
    manyBody,
    -- ** Line folds

    lineFold,
    paragraph,
    lineFoldWith,

    -- * Character and string literals

    L.charLiteral,

    -- * Numbers

    L.decimal,
    L.binary,
    L.octal,
    L.hexadecimal,
    L.scientific,
    L.float,
    L.signed,
  ) where

import Control.Monad (unless, void)
import Data.CaseInsensitive (FoldCase)
import qualified Data.List.NonEmpty as NE
import qualified Data.Monoid as Monoid
import qualified Data.Set as E
import Text.Megaparsec
import qualified Text.Megaparsec.Char.Lexer as L
import Text.Read (readMaybe)

-- | Newtype wrapper for line space consumer. In common cases you should use

-- standard combinators from /Text.Megaparsec.Char.Lexer.New/ rather than

-- unwrap it manually

newtype Sc m
  = Sc { Sc m -> m ()
unSc :: m () }

-- | A type synonym for space and eol consumer. Should be called manually

-- wherever line break is expected

type Scn m
  = m ()

-- | A @lexeme sc p@ behaves like @p@ and consumes spaces by @sc@ after it

lexeme :: MonadParsec e s m =>
  Sc m -> m a -> m a
lexeme :: Sc m -> m a -> m a
lexeme Sc m
sc = m () -> m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme (m () -> m a -> m a) -> m () -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Sc m -> m ()
forall (m :: * -> *). Sc m -> m ()
unSc Sc m
sc
{-# INLINEABLE lexeme #-}

-- | @symbol sc toks@ parse toks and consumes spaces by @sc@ after them

symbol :: MonadParsec e s m =>
  Sc m -> Tokens s -> m (Tokens s)
symbol :: Sc m -> Tokens s -> m (Tokens s)
symbol Sc m
sc = m () -> Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol (m () -> Tokens s -> m (Tokens s))
-> m () -> Tokens s -> m (Tokens s)
forall a b. (a -> b) -> a -> b
$ Sc m -> m ()
forall (m :: * -> *). Sc m -> m ()
unSc Sc m
sc
{-# INLINEABLE symbol #-}

-- | A case-insensitive version of `symbol`

symbol' :: (MonadParsec e s m, FoldCase (Tokens s)) =>
  Sc m -> Tokens s -> m (Tokens s)
symbol' :: Sc m -> Tokens s -> m (Tokens s)
symbol' Sc m
sc = m () -> Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
m () -> Tokens s -> m (Tokens s)
L.symbol' (m () -> Tokens s -> m (Tokens s))
-> m () -> Tokens s -> m (Tokens s)
forall a b. (a -> b) -> a -> b
$ Sc m -> m ()
forall (m :: * -> *). Sc m -> m ()
unSc Sc m
sc
{-# INLINEABLE symbol' #-}

-- | Generalized version of `block`, providing a way to change what is desired

-- ordering related to a reference indentation level

blockWith :: (TraversableStream s, MonadParsec e s m)
  => Ordering -- ^ desired ordering @act \`compare\` ref@

  -> Pos -- ^ reference indentation level

  -> Scn m -- ^ space and eols consumer

  -> (Scn m -> m a) -- ^ callback that uses provided space consumer

  -> m a -- ^ result returned by a callback

blockWith :: Ordering -> Pos -> Scn m -> (Scn m -> m a) -> m a
blockWith Ordering
ord Pos
ref Scn m
scn Scn m -> m a
action =
  Scn m -> m a
action (Scn m -> m a) -> Scn m -> m a
forall a b. (a -> b) -> a -> b
$ m Pos -> Scn m
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Pos -> Scn m) -> m Pos -> Scn m
forall a b. (a -> b) -> a -> b
$ Scn m -> Ordering -> Pos -> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
L.indentGuard Scn m
scn Ordering
ord Pos
ref
{-# INLINEABLE blockWith #-}

-- | Parse a block of consecutive lines with the same Indentation

--

-- For example, for parsing something like

--

-- @

-- foo

-- bar

-- baz

-- @

--

-- you can use something like this

--

-- @

-- block space $ \scn -> do

--   string "foo" <* scn

--   string "bar" <* scn

--   string "baz" -- we do not use eol consumer after the last string!

-- @

block :: (TraversableStream s, MonadParsec e s m)
  => Scn m -> (Scn m -> m a) -> m a
block :: Scn m -> (Scn m -> m a) -> m a
block Scn m
scn Scn m -> m a
action = do
  Pos
ref <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  Ordering -> Pos -> Scn m -> (Scn m -> m a) -> m a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
Ordering -> Pos -> Scn m -> (Scn m -> m a) -> m a
blockWith Ordering
EQ Pos
ref Scn m
scn Scn m -> m a
action
{-# INLINEABLE block #-}

-- | Opaque type, containing information about parsing `headedBlock`s body

--

-- `Functor` instance can be used to modify a result value

data Body m a
  = BodyNone a
  | BodyOne (Scn m -> m a)
  | BodyOpt a (Scn m -> m a)
  deriving (a -> Body m b -> Body m a
(a -> b) -> Body m a -> Body m b
(forall a b. (a -> b) -> Body m a -> Body m b)
-> (forall a b. a -> Body m b -> Body m a) -> Functor (Body m)
forall a b. a -> Body m b -> Body m a
forall a b. (a -> b) -> Body m a -> Body m b
forall (m :: * -> *) a b. Functor m => a -> Body m b -> Body m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Body m a -> Body m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Body m b -> Body m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> Body m b -> Body m a
fmap :: (a -> b) -> Body m a -> Body m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Body m a -> Body m b
Functor)

-- | Don't parse anything, just return a constant value. Can be used if after

-- parsing head you realized that there should be no body here

pureBody :: a -> Body m a
pureBody :: a -> Body m a
pureBody = a -> Body m a
forall (m :: * -> *) a. a -> Body m a
BodyNone

-- | Parse a body by given callback. Callback can use space consumer to

-- parse a multiline body. If the body consists of some identical parts use

-- `someBody`/`manyBody` instead.

--

-- Note, that it will always fail, if the body is empty, even if a callback can

-- succeed without consuming input. Use `optionBody`/`optionalBody` in this case.

oneBody :: (Scn m -> m a) -> Body m a
oneBody :: (Scn m -> m a) -> Body m a
oneBody = (Scn m -> m a) -> Body m a
forall (m :: * -> *) a. (Scn m -> m a) -> Body m a
BodyOne

-- | Parse a body by given callback, if the next line after a head has greater

-- indentation level, otherwise return a constant value

optionBody :: a -> (Scn m -> m a) -> Body m a
optionBody :: a -> (Scn m -> m a) -> Body m a
optionBody = a -> (Scn m -> m a) -> Body m a
forall (m :: * -> *) a. a -> (Scn m -> m a) -> Body m a
BodyOpt

-- | Parse a body by given callback, if the next line after a head has greater

-- indentation level, otherwise return Nothing

--

-- prop> optionalBody = optionBody Nothing

optionalBody :: (Scn m -> m (Maybe a)) -> Body m (Maybe a)
optionalBody :: (Scn m -> m (Maybe a)) -> Body m (Maybe a)
optionalBody = Maybe a -> (Scn m -> m (Maybe a)) -> Body m (Maybe a)
forall (m :: * -> *) a. a -> (Scn m -> m a) -> Body m a
BodyOpt Maybe a
forall a. Maybe a
Nothing

-- | Parse some (greater, than zero) number of lines by given parser

--

-- prop> someBody pEl = oneBody (pEl `sepBy1`)

someBody :: (TraversableStream s, MonadParsec e s m)
  => m el -> Body m [el]
someBody :: m el -> Body m [el]
someBody m el
pEl = (Scn m -> m [el]) -> Body m [el]
forall (m :: * -> *) a. (Scn m -> m a) -> Body m a
BodyOne (m el
pEl m el -> Scn m -> m [el]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1`)
{-# INLINEABLE someBody #-}

-- | Parse many (maybe zero) lines by given parser

--

-- prop> manyBody pEl = optionBody [] (pEl `sepBy`)

manyBody :: (TraversableStream s, MonadParsec e s m)
  => m el -> Body m [el]
manyBody :: m el -> Body m [el]
manyBody m el
pEl = [el] -> (Scn m -> m [el]) -> Body m [el]
forall (m :: * -> *) a. a -> (Scn m -> m a) -> Body m a
BodyOpt [] (m el
pEl m el -> Scn m -> m [el]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy`)
{-# INLINEABLE manyBody #-}

-- | Parse a head of the block and then its body, depending on what `Body`

-- is returned after processing of the head. Use it if the choice of body parser

-- depends on the head parser's result. In other cases you should prefer

-- `headedOne`/`headedSome`/`headedMany`/`headedOptional`

--

-- For example, suppose we want to parse something like this (in the first line

-- we have an arbitrary identifier and than it's repeated in all subsequent

-- lines):

--

-- @

-- foo:

--   foo 42

--   foo 36

-- @

--

-- we can use something like this:

--

-- @

-- headedBlock space space $ do

--   name <- takeWhile1P isLetter

--   string ":"

--   pure $ someBody (L.symbol hspace name *> L.decimal)

-- @

headedBlock :: (TraversableStream s, MonadParsec e s m)
  => Scn m -- ^ how to consume white space after the head

  -> Scn m -- ^ how to consume white space after each line of body

  -> m (Body m a) -- ^ how to parse a head and get body parser

  -> m a -- ^ the value, returned by body parser

headedBlock :: Scn m -> Scn m -> m (Body m a) -> m a
headedBlock Scn m
hscn Scn m
scn m (Body m a)
pContent = do
  Pos
ref <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  Body m a
content <- m (Body m a)
pContent
  case Body m a
content of
    BodyNone a
a -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    BodyOne Scn m -> m a
pa -> do
      Pos
lvl <- Scn m -> Ordering -> Pos -> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m () -> Ordering -> Pos -> m Pos
L.indentGuard Scn m
hscn Ordering
GT Pos
ref
      Ordering -> Pos -> Scn m -> (Scn m -> m a) -> m a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
Ordering -> Pos -> Scn m -> (Scn m -> m a) -> m a
blockWith Ordering
EQ Pos
lvl Scn m
scn Scn m -> m a
pa
    BodyOpt a
a Scn m -> m a
pa -> do
      Pos
lvl <- Scn m
hscn Scn m -> m Pos -> m Pos
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
      if Pos
lvl Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
ref
        then Ordering -> Pos -> Scn m -> (Scn m -> m a) -> m a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
Ordering -> Pos -> Scn m -> (Scn m -> m a) -> m a
blockWith Ordering
EQ Pos
lvl Scn m
scn Scn m -> m a
pa
        else a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINEABLE headedBlock #-}

headedOne :: (TraversableStream s, MonadParsec e s m)
  => Scn m -- ^ how to consume white space after the head

  -> Scn m -- ^ how to consume white space after each line of body

  -> m (el -> a) -- ^ how to parse a head

  -> (Scn m -> m el) -- ^ callback to parse a body

  -> m a -- callback's result transformed by the result of head parser

headedOne :: Scn m -> Scn m -> m (el -> a) -> (Scn m -> m el) -> m a
headedOne Scn m
hscn Scn m
scn m (el -> a)
pHead Scn m -> m el
pEl = Scn m -> Scn m -> m (Body m a) -> m a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
Scn m -> Scn m -> m (Body m a) -> m a
headedBlock Scn m
hscn Scn m
scn (m (Body m a) -> m a) -> m (Body m a) -> m a
forall a b. (a -> b) -> a -> b
$
  (Scn m -> m a) -> Body m a
forall (m :: * -> *) a. (Scn m -> m a) -> Body m a
BodyOne ((Scn m -> m a) -> Body m a)
-> ((el -> a) -> Scn m -> m a) -> (el -> a) -> Body m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\el -> a
f -> (el -> a) -> m el -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap el -> a
f (m el -> m a) -> (Scn m -> m el) -> Scn m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scn m -> m el
pEl) ((el -> a) -> Body m a) -> m (el -> a) -> m (Body m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (el -> a)
pHead
{-# INLINEABLE headedOne #-}

headedOptional :: (TraversableStream s, MonadParsec e s m)
  => Scn m -- ^ how to consume white space after the head

  -> Scn m -- ^ how to consume white space after each line of body

  -> m (Maybe el -> a) -- ^ how to parse a head

  -> (Scn m -> m el) -- ^ callback to parse a body

  -> m a -- callback's result transformed by the result of head parser

headedOptional :: Scn m -> Scn m -> m (Maybe el -> a) -> (Scn m -> m el) -> m a
headedOptional Scn m
hscn Scn m
scn m (Maybe el -> a)
pHead Scn m -> m el
pEl = Scn m -> Scn m -> m (Body m a) -> m a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
Scn m -> Scn m -> m (Body m a) -> m a
headedBlock Scn m
hscn Scn m
scn do
  Maybe el -> a
h <- m (Maybe el -> a)
pHead
  Body m a -> m (Body m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Body m a -> m (Body m a)) -> Body m a -> m (Body m a)
forall a b. (a -> b) -> a -> b
$ a -> (Scn m -> m a) -> Body m a
forall (m :: * -> *) a. a -> (Scn m -> m a) -> Body m a
BodyOpt (Maybe el -> a
h Maybe el
forall a. Maybe a
Nothing) ((el -> a) -> m el -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe el -> a
h (Maybe el -> a) -> (el -> Maybe el) -> el -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. el -> Maybe el
forall a. a -> Maybe a
Just) (m el -> m a) -> (Scn m -> m el) -> Scn m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scn m -> m el
pEl)
{-# INLINEABLE headedOptional #-}

headedSome :: (TraversableStream s, MonadParsec e s m)
  => Scn m -- ^ how to consume white space after the head

  -> Scn m -- ^ how to consume white space after each line of body

  -> m ([el] -> a) -- ^ how to parse a head

  -> m el -- ^ how to parse each element of the body

  -> m a -- result of the head parser, applied to parsed elements of body

headedSome :: Scn m -> Scn m -> m ([el] -> a) -> m el -> m a
headedSome Scn m
hscn Scn m
scn m ([el] -> a)
pHead m el
pEl = Scn m -> Scn m -> m (Body m a) -> m a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
Scn m -> Scn m -> m (Body m a) -> m a
headedBlock Scn m
hscn Scn m
scn (m (Body m a) -> m a) -> m (Body m a) -> m a
forall a b. (a -> b) -> a -> b
$
  (([el] -> a) -> Body m a) -> m ([el] -> a) -> m (Body m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([el] -> a) -> Body m [el] -> Body m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m el -> Body m [el]
forall s e (m :: * -> *) el.
(TraversableStream s, MonadParsec e s m) =>
m el -> Body m [el]
someBody m el
pEl) m ([el] -> a)
pHead
{-# INLINEABLE headedSome #-}

headedMany :: (TraversableStream s, MonadParsec e s m)
  => Scn m -- ^ how to consume white space after the head

  -> Scn m -- ^ how to consume white space after each line of body

  -> m ([el] -> a) -- ^ how to parse a head

  -> m el -- ^ how to parse each element of the body

  -> m a -- result of the head parser, applied to parsed elements of body

headedMany :: Scn m -> Scn m -> m ([el] -> a) -> m el -> m a
headedMany Scn m
hscn Scn m
scn m ([el] -> a)
pHead m el
pEl = Scn m -> Scn m -> m (Body m a) -> m a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
Scn m -> Scn m -> m (Body m a) -> m a
headedBlock Scn m
hscn Scn m
scn (m (Body m a) -> m a) -> m (Body m a) -> m a
forall a b. (a -> b) -> a -> b
$
  (([el] -> a) -> Body m a) -> m ([el] -> a) -> m (Body m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([el] -> a) -> Body m [el] -> Body m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m el -> Body m [el]
forall s e (m :: * -> *) el.
(TraversableStream s, MonadParsec e s m) =>
m el -> Body m [el]
manyBody m el
pEl) m ([el] -> a)
pHead
{-# INLINEABLE headedMany #-}

data LineFoldErrInfo = LineFoldErrInfo Int Pos
  deriving (ReadPrec [LineFoldErrInfo]
ReadPrec LineFoldErrInfo
Int -> ReadS LineFoldErrInfo
ReadS [LineFoldErrInfo]
(Int -> ReadS LineFoldErrInfo)
-> ReadS [LineFoldErrInfo]
-> ReadPrec LineFoldErrInfo
-> ReadPrec [LineFoldErrInfo]
-> Read LineFoldErrInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LineFoldErrInfo]
$creadListPrec :: ReadPrec [LineFoldErrInfo]
readPrec :: ReadPrec LineFoldErrInfo
$creadPrec :: ReadPrec LineFoldErrInfo
readList :: ReadS [LineFoldErrInfo]
$creadList :: ReadS [LineFoldErrInfo]
readsPrec :: Int -> ReadS LineFoldErrInfo
$creadsPrec :: Int -> ReadS LineFoldErrInfo
Read, Int -> LineFoldErrInfo -> ShowS
[LineFoldErrInfo] -> ShowS
LineFoldErrInfo -> String
(Int -> LineFoldErrInfo -> ShowS)
-> (LineFoldErrInfo -> String)
-> ([LineFoldErrInfo] -> ShowS)
-> Show LineFoldErrInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineFoldErrInfo] -> ShowS
$cshowList :: [LineFoldErrInfo] -> ShowS
show :: LineFoldErrInfo -> String
$cshow :: LineFoldErrInfo -> String
showsPrec :: Int -> LineFoldErrInfo -> ShowS
$cshowsPrec :: Int -> LineFoldErrInfo -> ShowS
Show)

lineFoldWith :: (TraversableStream s, MonadParsec e s m) =>
  Ordering -> Pos -> Sc m-> Scn m -> (Sc m -> m a) -> m a
lineFoldWith :: Ordering -> Pos -> Sc m -> Scn m -> (Sc m -> m a) -> m a
lineFoldWith Ordering
ord Pos
ref Sc m
sc Scn m
scn Sc m -> m a
action =
  (ParseError s e -> ParseError s e) -> m a -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region ParseError s e -> ParseError s e
forall s e. ParseError s e -> ParseError s e
procErr (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$
    Sc m -> m a
action (Sc m -> m a) -> (m (Maybe ()) -> Sc m) -> m (Maybe ()) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scn m -> Sc m
forall (m :: * -> *). m () -> Sc m
Sc (Scn m -> Sc m) -> (m (Maybe ()) -> Scn m) -> m (Maybe ()) -> Sc m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe ()) -> Scn m
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe ()) -> m a) -> m (Maybe ()) -> m a
forall a b. (a -> b) -> a -> b
$ Sc m -> Scn m
forall (m :: * -> *). Sc m -> m ()
unSc Sc m
sc Scn m -> m (Maybe ()) -> m (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Scn m -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Scn m -> m (Maybe ()))
-> (Scn m -> Scn m) -> Scn m -> m (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scn m -> Scn m
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) do
      State s e
st <- m (State s e)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
      Pos
lvl' <- Scn m
scn Scn m -> m Pos -> m Pos
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
      Bool -> Scn m -> Scn m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Pos
lvl' Pos -> Pos -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Pos
ref Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
ord) do
        Int
o <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
        State s e -> Scn m
forall e s (m :: * -> *). MonadParsec e s m => State s e -> m ()
setParserState State s e
st
        let i :: LineFoldErrInfo
i = Int -> Pos -> LineFoldErrInfo
LineFoldErrInfo Int
o Pos
lvl'
        Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> Scn m
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure Maybe (ErrorItem (Token s))
forall a. Maybe a
Nothing (ErrorItem (Token s) -> Set (ErrorItem (Token s))
forall a. a -> Set a
E.singleton (ErrorItem (Token s) -> Set (ErrorItem (Token s)))
-> ErrorItem (Token s) -> Set (ErrorItem (Token s))
forall a b. (a -> b) -> a -> b
$ NonEmpty Char -> ErrorItem (Token s)
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem (Token s))
-> NonEmpty Char -> ErrorItem (Token s)
forall a b. (a -> b) -> a -> b
$ String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> NonEmpty Char) -> String -> NonEmpty Char
forall a b. (a -> b) -> a -> b
$ LineFoldErrInfo -> String
forall a. Show a => a -> String
show LineFoldErrInfo
i)
  where
    procETok :: ErrorItem t -> Maybe (ParseError s e)
procETok (Label NonEmpty Char
lbl) = case String -> Maybe LineFoldErrInfo
forall a. Read a => String -> Maybe a
readMaybe (NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Char
lbl) of
      (Just (LineFoldErrInfo Int
o Pos
act)) ->
          ParseError s e -> Maybe (ParseError s e)
forall a. a -> Maybe a
Just (ParseError s e -> Maybe (ParseError s e))
-> ParseError s e -> Maybe (ParseError s e)
forall a b. (a -> b) -> a -> b
$ Int -> Set (ErrorFancy e) -> ParseError s e
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o (Set (ErrorFancy e) -> ParseError s e)
-> Set (ErrorFancy e) -> ParseError s e
forall a b. (a -> b) -> a -> b
$ ErrorFancy e -> Set (ErrorFancy e)
forall a. a -> Set a
E.singleton (ErrorFancy e -> Set (ErrorFancy e))
-> ErrorFancy e -> Set (ErrorFancy e)
forall a b. (a -> b) -> a -> b
$ Ordering -> Pos -> Pos -> ErrorFancy e
forall e. Ordering -> Pos -> Pos -> ErrorFancy e
ErrorIndentation Ordering
GT Pos
ref Pos
act
      Maybe LineFoldErrInfo
_ -> Maybe (ParseError s e)
forall a. Maybe a
Nothing
    procETok ErrorItem t
_ = Maybe (ParseError s e)
forall a. Maybe a
Nothing
    procErr :: ParseError s e -> ParseError s e
procErr ParseError s e
e = case ParseError s e
e of
          TrivialError Int
_ Maybe (ErrorItem (Token s))
_ Set (ErrorItem (Token s))
etoks ->
            case First (ParseError s e) -> Maybe (ParseError s e)
forall a. First a -> Maybe a
Monoid.getFirst (First (ParseError s e) -> Maybe (ParseError s e))
-> First (ParseError s e) -> Maybe (ParseError s e)
forall a b. (a -> b) -> a -> b
$ (ErrorItem (Token s) -> First (ParseError s e))
-> Set (ErrorItem (Token s)) -> First (ParseError s e)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe (ParseError s e) -> First (ParseError s e)
forall a. Maybe a -> First a
Monoid.First (Maybe (ParseError s e) -> First (ParseError s e))
-> (ErrorItem (Token s) -> Maybe (ParseError s e))
-> ErrorItem (Token s)
-> First (ParseError s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorItem (Token s) -> Maybe (ParseError s e)
forall t s e. ErrorItem t -> Maybe (ParseError s e)
procETok) Set (ErrorItem (Token s))
etoks of
              (Just ParseError s e
e') -> ParseError s e
e'
              Maybe (ParseError s e)
Nothing   -> ParseError s e
e
          ParseError s e
_ -> ParseError s e
e
{-# INLINEABLE lineFoldWith #-}

lineFold ::
  (TraversableStream s, MonadParsec e s m) =>
  -- | Line space consumer

  Sc m ->
  -- | Line space and eols consumer

  Scn m ->
  -- | Callback that uses provided space-consumer

  (Sc m -> m a) ->
  m a
lineFold :: Sc m -> Scn m -> (Sc m -> m a) -> m a
lineFold Sc m
sc Scn m
scn Sc m -> m a
action = do
  Pos
lvl <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  Ordering -> Pos -> Sc m -> Scn m -> (Sc m -> m a) -> m a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
Ordering -> Pos -> Sc m -> Scn m -> (Sc m -> m a) -> m a
lineFoldWith Ordering
GT Pos
lvl Sc m
sc Scn m
scn Sc m -> m a
action
{-# INLINEABLE lineFold #-}

paragraph ::
  (TraversableStream s, MonadParsec e s m) =>
  -- | Line space consumer

  Sc m ->
  -- | Line space and eols consumer

  Scn m ->
  -- | Callback that uses provided space-consumer

  (Sc m -> m a) ->
  m a
paragraph :: Sc m -> Scn m -> (Sc m -> m a) -> m a
paragraph Sc m
sc Scn m
scn Sc m -> m a
action = do
  Pos
lvl <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
  Ordering -> Pos -> Sc m -> Scn m -> (Sc m -> m a) -> m a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
Ordering -> Pos -> Sc m -> Scn m -> (Sc m -> m a) -> m a
lineFoldWith Ordering
EQ Pos
lvl Sc m
sc Scn m
scn Sc m -> m a
action
{-# INLINEABLE paragraph #-}