{- |
    Module      :  $Header$
    Description :  Parser combinators
    Copyright   :  (c) 1999-2004, Wolfgang Lux
                       2016     , Jan Tikovsky
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    The parsing combinators implemented in this module are based on the
    LL(1) parsing combinators developed by Swierstra and Duponcheel.
    They have been adapted to using continuation passing style in order to
    work with the lexing combinators described in the previous section.
    In addition, the facilities for error correction are omitted
    in this implementation.

    The two functions 'applyParser' and 'prefixParser' use the specified
    parser for parsing a string. When 'applyParser' is used, an error is
    reported if the parser does not consume the whole string,
    whereas 'prefixParser' discards the rest of the input string in this case.
-}
{-# LANGUAGE CPP #-}

module Curry.Base.LLParseComb
  ( -- * Data types
    Parser

    -- * Parser application
  , fullParser, prefixParser

    -- * Basic parsers
  , position, spanPosition, succeed, failure, symbol

    -- *  parser combinators
  , (<?>), (<|>), (<|?>), (<*>), (<\>), (<\\>)
  , (<$>), (<$->), (<*->), (<-*>), (<**>), (<??>), (<.>)
  , opt, choice, flag, optional, option, many, many1, sepBy, sepBy1
  , sepBySp, sepBy1Sp
  , chainr, chainr1, chainl, chainl1, between, ops

    -- * Layout combinators
  , layoutOn, layoutOff, layoutEnd
  ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative, (<*>), (<$>), pure)
#endif
import Control.Monad
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set

import Curry.Base.LexComb
import Curry.Base.Position
import Curry.Base.Span (span2Pos, Span, startCol, setDistance)

infixl 5 <\>, <\\>
infixl 4 <$->, <*->, <-*>, <**>, <??>, <.>
infixl 3 <|>, <|?>
infixl 2 <?>, `opt`

-- ---------------------------------------------------------------------------
-- Parser types
-- ---------------------------------------------------------------------------

-- |Parsing function
type ParseFun a s b  = (b -> SuccessP s a) -> FailP a -> SuccessP s a

-- |CPS-Parser type
data Parser a s b = Parser
  -- Parsing function for empty word
  (Maybe (ParseFun a s b))
  -- Lookup table (continuations for 'Symbol's recognized by the parser)
  (Map.Map s (Lexer s a -> ParseFun a s b))

instance Symbol s => Functor (Parser a s) where
  fmap :: (a -> b) -> Parser a s a -> Parser a s b
fmap f :: a -> b
f p :: Parser a s a
p = (a -> b) -> Parser a s (a -> b)
forall b a s. b -> Parser a s b
succeed a -> b
f Parser a s (a -> b) -> Parser a s a -> Parser a s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s a
p

instance Symbol s => Applicative (Parser a s) where
  pure :: a -> Parser a s a
pure = a -> Parser a s a
forall b a s. b -> Parser a s b
succeed

  -- |Apply the result function of the first parser to the result of the
  --  second parser.
  Parser Nothing   ps1 :: Map s (Lexer s a -> ParseFun a s (a -> b))
ps1 <*> :: Parser a s (a -> b) -> Parser a s a -> Parser a s b
<*> p2 :: Parser a s a
p2                  = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser Maybe (ParseFun a s b)
forall a. Maybe a
Nothing
    (((Lexer s a -> ParseFun a s (a -> b))
 -> Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s (a -> b))
-> Map s (Lexer s a -> ParseFun a s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Lexer s a -> ParseFun a s (a -> b))
 -> Parser a s a -> Lexer s a -> ParseFun a s b)
-> Parser a s a
-> (Lexer s a -> ParseFun a s (a -> b))
-> Lexer s a
-> ParseFun a s b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Lexer s a -> ParseFun a s (a -> b))
-> Parser a s a -> Lexer s a -> ParseFun a s b
forall s a b c.
Symbol s =>
(Lexer s a -> ParseFun a s (b -> c))
-> Parser a s b -> Lexer s a -> ParseFun a s c
seqPP Parser a s a
p2) Map s (Lexer s a -> ParseFun a s (a -> b))
ps1)
  Parser (Just p1 :: ParseFun a s (a -> b)
p1) ps1 :: Map s (Lexer s a -> ParseFun a s (a -> b))
ps1 <*> ~p2 :: Parser a s a
p2@(Parser e2 :: Maybe (ParseFun a s a)
e2 ps2 :: Map s (Lexer s a -> ParseFun a s a)
ps2) = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser ((ParseFun a s a -> ParseFun a s b)
-> Maybe (ParseFun a s a) -> Maybe (ParseFun a s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseFun a s (a -> b) -> ParseFun a s a -> ParseFun a s b
forall a s b c.
ParseFun a s (b -> c) -> ParseFun a s b -> ParseFun a s c
seqEE ParseFun a s (a -> b)
p1) Maybe (ParseFun a s a)
e2)
    (Map s (Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (((Lexer s a -> ParseFun a s (a -> b))
 -> Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s (a -> b))
-> Map s (Lexer s a -> ParseFun a s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Lexer s a -> ParseFun a s (a -> b))
 -> Parser a s a -> Lexer s a -> ParseFun a s b)
-> Parser a s a
-> (Lexer s a -> ParseFun a s (a -> b))
-> Lexer s a
-> ParseFun a s b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Lexer s a -> ParseFun a s (a -> b))
-> Parser a s a -> Lexer s a -> ParseFun a s b
forall s a b c.
Symbol s =>
(Lexer s a -> ParseFun a s (b -> c))
-> Parser a s b -> Lexer s a -> ParseFun a s c
seqPP Parser a s a
p2) Map s (Lexer s a -> ParseFun a s (a -> b))
ps1) (((Lexer s a -> ParseFun a s a) -> Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s a)
-> Map s (Lexer s a -> ParseFun a s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseFun a s (a -> b)
-> (Lexer s a -> ParseFun a s a) -> Lexer s a -> ParseFun a s b
forall a s b c.
ParseFun a s (b -> c)
-> (Lexer s a -> ParseFun a s b) -> Lexer s a -> ParseFun a s c
seqEP ParseFun a s (a -> b)
p1) Map s (Lexer s a -> ParseFun a s a)
ps2))

instance Show s => Show (Parser a s b) where
  showsPrec :: Int -> Parser a s b -> ShowS
showsPrec p :: Int
p (Parser e :: Maybe (ParseFun a s b)
e ps :: Map s (Lexer s a -> ParseFun a s b)
ps) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString "Parser " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS
forall a. Show a => a -> ShowS
shows (Maybe (ParseFun a s b) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ParseFun a s b)
e) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Char -> ShowS
showChar ' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set s -> ShowS
forall a. Show a => a -> ShowS
shows (Map s (Lexer s a -> ParseFun a s b) -> Set s
forall k a. Map k a -> Set k
Map.keysSet Map s (Lexer s a -> ParseFun a s b)
ps)

-- ---------------------------------------------------------------------------
-- Parser application
-- ---------------------------------------------------------------------------

-- |Apply a parser and lexer to a 'String', whereas the 'FilePath' is used
-- to identify the origin of the 'String' in case of parsing errors.
fullParser :: Symbol s => Parser a s a -> Lexer s a -> FilePath -> String
           -> CYM a
fullParser :: Parser a s a -> Lexer s a -> String -> String -> CYM a
fullParser p :: Parser a s a
p lexer :: Lexer s a
lexer = P a -> String -> String -> CYM a
forall a. P a -> String -> String -> CYM a
parse (Lexer s a
lexer (Parser a s a -> Lexer s a -> ParseFun a s a
forall s a b.
Symbol s =>
Parser a s b -> Lexer s a -> ParseFun a s b
choose Parser a s a
p Lexer s a
lexer a -> Span -> s -> P a
forall s a. Symbol s => a -> Span -> s -> P a
successP Span -> String -> P a
forall a. Span -> String -> P a
failP) Span -> String -> P a
forall a. Span -> String -> P a
failP)
  where successP :: a -> Span -> s -> P a
successP x :: a
x pos :: Span
pos s :: s
s
          | s -> Bool
forall s. Symbol s => s -> Bool
isEOF s
s   = a -> P a
forall a. a -> P a
returnP a
x
          | Bool
otherwise = Span -> String -> P a
forall a. Span -> String -> P a
failP Span
pos (s -> String
forall s. Symbol s => s -> String
unexpected s
s)

-- |Apply a parser and lexer to parse the beginning of a 'String'.
-- The 'FilePath' is used to identify the origin of the 'String' in case of
-- parsing errors.
prefixParser :: Symbol s => Parser a s a -> Lexer s a -> FilePath -> String
             -> CYM a
prefixParser :: Parser a s a -> Lexer s a -> String -> String -> CYM a
prefixParser p :: Parser a s a
p lexer :: Lexer s a
lexer = P a -> String -> String -> CYM a
forall a. P a -> String -> String -> CYM a
parse (Lexer s a
lexer (Parser a s a -> Lexer s a -> ParseFun a s a
forall s a b.
Symbol s =>
Parser a s b -> Lexer s a -> ParseFun a s b
choose Parser a s a
p Lexer s a
lexer a -> Span -> s -> P a
forall a p p. a -> p -> p -> P a
discardP Span -> String -> P a
forall a. Span -> String -> P a
failP) Span -> String -> P a
forall a. Span -> String -> P a
failP)
  where discardP :: a -> p -> p -> P a
discardP x :: a
x _ _ = a -> P a
forall a. a -> P a
returnP a
x

-- |Choose the appropriate parsing function w.r.t. to the next 'Symbol'.
choose :: Symbol s => Parser a s b -> Lexer s a -> ParseFun a s b
choose :: Parser a s b -> Lexer s a -> ParseFun a s b
choose (Parser e :: Maybe (ParseFun a s b)
e ps :: Map s (Lexer s a -> ParseFun a s b)
ps) lexer :: Lexer s a
lexer success :: b -> SuccessP s a
success failp :: FailP a
failp pos :: Span
pos s :: s
s = case s
-> Map s (Lexer s a -> ParseFun a s b)
-> Maybe (Lexer s a -> ParseFun a s b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup s
s Map s (Lexer s a -> ParseFun a s b)
ps of
  Just p :: Lexer s a -> ParseFun a s b
p  -> Lexer s a -> ParseFun a s b
p Lexer s a
lexer b -> SuccessP s a
success FailP a
failp Span
pos s
s
  Nothing -> case Maybe (ParseFun a s b)
e of
    Just p :: ParseFun a s b
p  -> ParseFun a s b
p b -> SuccessP s a
success FailP a
failp Span
pos s
s
    Nothing -> FailP a
failp Span
pos (s -> String
forall s. Symbol s => s -> String
unexpected s
s)

-- |Fail on an unexpected 'Symbol'
unexpected :: Symbol s => s -> String
unexpected :: s -> String
unexpected s :: s
s
  | s -> Bool
forall s. Symbol s => s -> Bool
isEOF s
s   = "Unexpected end-of-file"
  | Bool
otherwise = "Unexpected token " String -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Show a => a -> String
show s
s

-- ---------------------------------------------------------------------------
-- Basic parsers
-- ---------------------------------------------------------------------------

-- |Return the current position without consuming the input
position :: Parser a s Position
position :: Parser a s Position
position = Maybe (ParseFun a s Position)
-> Map s (Lexer s a -> ParseFun a s Position)
-> Parser a s Position
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser (ParseFun a s Position -> Maybe (ParseFun a s Position)
forall a. a -> Maybe a
Just ParseFun a s Position
forall t p. (Position -> Span -> t) -> p -> Span -> t
p) Map s (Lexer s a -> ParseFun a s Position)
forall k a. Map k a
Map.empty
  where p :: (Position -> Span -> t) -> p -> Span -> t
p success :: Position -> Span -> t
success _ sp :: Span
sp = Position -> Span -> t
success (Span -> Position
span2Pos Span
sp) Span
sp

spanPosition :: Symbol s => Parser a s Span
spanPosition :: Parser a s Span
spanPosition = Maybe (ParseFun a s Span)
-> Map s (Lexer s a -> ParseFun a s Span) -> Parser a s Span
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser (ParseFun a s Span -> Maybe (ParseFun a s Span)
forall a. a -> Maybe a
Just ParseFun a s Span
forall t t p.
Symbol t =>
(Span -> Span -> t -> t) -> p -> Span -> t -> t
p) Map s (Lexer s a -> ParseFun a s Span)
forall k a. Map k a
Map.empty
  where p :: (Span -> Span -> t -> t) -> p -> Span -> t -> t
p success :: Span -> Span -> t -> t
success _ sp :: Span
sp s :: t
s = Span -> Span -> t -> t
success (Span -> Distance -> Span
setDistance Span
sp (Int -> t -> Distance
forall s. Symbol s => Int -> s -> Distance
dist (Span -> Int
startCol Span
sp) t
s)) Span
sp t
s

-- |Always succeeding parser
succeed :: b -> Parser a s b
succeed :: b -> Parser a s b
succeed x :: b
x = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser (ParseFun a s b -> Maybe (ParseFun a s b)
forall a. a -> Maybe a
Just ParseFun a s b
forall t p. (b -> t) -> p -> t
p) Map s (Lexer s a -> ParseFun a s b)
forall k a. Map k a
Map.empty
  where p :: (b -> t) -> p -> t
p success :: b -> t
success _ = b -> t
success b
x

-- |Always failing parser with a given message
failure :: String -> Parser a s b
failure :: String -> Parser a s b
failure msg :: String
msg = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser (ParseFun a s b -> Maybe (ParseFun a s b)
forall a. a -> Maybe a
Just ParseFun a s b
forall p t t p. p -> (t -> String -> t) -> t -> p -> t
p) Map s (Lexer s a -> ParseFun a s b)
forall k a. Map k a
Map.empty
  where p :: p -> (t -> String -> t) -> t -> p -> t
p _ failp :: t -> String -> t
failp pos :: t
pos _ = t -> String -> t
failp t
pos String
msg

-- |Create a parser accepting the given 'Symbol'
symbol :: s -> Parser a s s
symbol :: s -> Parser a s s
symbol s :: s
s = Maybe (ParseFun a s s)
-> Map s (Lexer s a -> ParseFun a s s) -> Parser a s s
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser Maybe (ParseFun a s s)
forall a. Maybe a
Nothing (s
-> (Lexer s a -> ParseFun a s s)
-> Map s (Lexer s a -> ParseFun a s s)
forall k a. k -> a -> Map k a
Map.singleton s
s Lexer s a -> ParseFun a s s
forall t t t t p. (t -> t -> t) -> (t -> t) -> t -> p -> t -> t
p)
  where p :: (t -> t -> t) -> (t -> t) -> t -> p -> t -> t
p lexer :: t -> t -> t
lexer success :: t -> t
success failp :: t
failp _ s' :: t
s' = t -> t -> t
lexer (t -> t
success t
s') t
failp

-- ---------------------------------------------------------------------------
-- Parser combinators
-- ---------------------------------------------------------------------------

-- |Behave like the given parser, but use the given 'String' as the error
-- message if the parser fails
(<?>) :: Symbol s => Parser a s b -> String -> Parser a s b
p :: Parser a s b
p <?> :: Parser a s b -> String -> Parser a s b
<?> msg :: String
msg = Parser a s b
p Parser a s b -> Parser a s b -> Parser a s b
forall s a b.
Symbol s =>
Parser a s b -> Parser a s b -> Parser a s b
<|> String -> Parser a s b
forall a s b. String -> Parser a s b
failure String
msg

-- |Deterministic choice between two parsers.
-- The appropriate parser is chosen based on the next 'Symbol'
(<|>) :: Symbol s => Parser a s b -> Parser a s b -> Parser a s b
Parser e1 :: Maybe (ParseFun a s b)
e1 ps1 :: Map s (Lexer s a -> ParseFun a s b)
ps1 <|> :: Parser a s b -> Parser a s b -> Parser a s b
<|> Parser e2 :: Maybe (ParseFun a s b)
e2 ps2 :: Map s (Lexer s a -> ParseFun a s b)
ps2
  | Maybe (ParseFun a s b) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ParseFun a s b)
e1 Bool -> Bool -> Bool
&& Maybe (ParseFun a s b) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ParseFun a s b)
e2 = String -> Parser a s b
forall a s b. String -> Parser a s b
failure "Ambiguous parser for empty word"
  | Bool -> Bool
not (Set s -> Bool
forall a. Set a -> Bool
Set.null Set s
common)  = String -> Parser a s b
forall a s b. String -> Parser a s b
failure (String -> Parser a s b) -> String -> Parser a s b
forall a b. (a -> b) -> a -> b
$ "Ambiguous parser for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set s -> String
forall a. Show a => a -> String
show Set s
common
  | Bool
otherwise              = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser (Maybe (ParseFun a s b)
e1 Maybe (ParseFun a s b)
-> Maybe (ParseFun a s b) -> Maybe (ParseFun a s b)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (ParseFun a s b)
e2) (Map s (Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map s (Lexer s a -> ParseFun a s b)
ps1 Map s (Lexer s a -> ParseFun a s b)
ps2)
  where common :: Set s
common = Map s (Lexer s a -> ParseFun a s b) -> Set s
forall k a. Map k a -> Set k
Map.keysSet Map s (Lexer s a -> ParseFun a s b)
ps1 Set s -> Set s -> Set s
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Map s (Lexer s a -> ParseFun a s b) -> Set s
forall k a. Map k a -> Set k
Map.keysSet Map s (Lexer s a -> ParseFun a s b)
ps2

-- |Non-deterministic choice between two parsers.
--
-- The other parsing combinators require that the grammar being parsed
-- is LL(1). In some cases it may be difficult or even
-- impossible to transform a grammar into LL(1) form. As a remedy, we
-- include a non-deterministic version of the choice combinator in
-- addition to the deterministic combinator adapted from the paper. For
-- every symbol from the intersection of the parser's first sets, the
-- combinator '(<|?>)' applies both parsing functions to the input
-- stream and uses that one which processes the longer prefix of the
-- input stream irrespective of whether it succeeds or fails. If both
-- functions recognize the same prefix, we choose the one that succeeds
-- and report an ambiguous parse error if both succeed.
(<|?>) :: Symbol s => Parser a s b -> Parser a s b -> Parser a s b
Parser e1 :: Maybe (ParseFun a s b)
e1 ps1 :: Map s (Lexer s a -> ParseFun a s b)
ps1 <|?> :: Parser a s b -> Parser a s b -> Parser a s b
<|?> Parser e2 :: Maybe (ParseFun a s b)
e2 ps2 :: Map s (Lexer s a -> ParseFun a s b)
ps2
  | Maybe (ParseFun a s b) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ParseFun a s b)
e1 Bool -> Bool -> Bool
&& Maybe (ParseFun a s b) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ParseFun a s b)
e2 = String -> Parser a s b
forall a s b. String -> Parser a s b
failure "Ambiguous parser for empty word"
  | Bool
otherwise              = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser (Maybe (ParseFun a s b)
e1 Maybe (ParseFun a s b)
-> Maybe (ParseFun a s b) -> Maybe (ParseFun a s b)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (ParseFun a s b)
e2) (Map s (Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map s (Lexer s a -> ParseFun a s b)
ps1' Map s (Lexer s a -> ParseFun a s b)
ps2)
  where
  ps1' :: Map s (Lexer s a -> ParseFun a s b)
ps1' = [(s, Lexer s a -> ParseFun a s b)]
-> Map s (Lexer s a -> ParseFun a s b)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (s
s, (Lexer s a -> ParseFun a s b)
-> ((Lexer s a -> ParseFun a s b) -> Lexer s a -> ParseFun a s b)
-> Maybe (Lexer s a -> ParseFun a s b)
-> Lexer s a
-> ParseFun a s b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Lexer s a -> ParseFun a s b
p ((Lexer s a -> ParseFun a s b)
-> (Lexer s a -> ParseFun a s b) -> Lexer s a -> ParseFun a s b
forall p t t b t p p b a.
(p
 -> (t -> Span -> t -> P b) -> (Span -> t -> P b) -> p -> p -> P b)
-> (p
    -> (t -> Span -> t -> P a) -> (Span -> t -> P a) -> p -> p -> P b)
-> p
-> (t -> Span -> t -> P a)
-> (Span -> t -> P a)
-> p
-> p
-> P b
try Lexer s a -> ParseFun a s b
p) (s
-> Map s (Lexer s a -> ParseFun a s b)
-> Maybe (Lexer s a -> ParseFun a s b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup s
s Map s (Lexer s a -> ParseFun a s b)
ps2))
                      | (s :: s
s, p :: Lexer s a -> ParseFun a s b
p) <- Map s (Lexer s a -> ParseFun a s b)
-> [(s, Lexer s a -> ParseFun a s b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map s (Lexer s a -> ParseFun a s b)
ps1
                      ]
  try :: (p
 -> (t -> Span -> t -> P b) -> (Span -> t -> P b) -> p -> p -> P b)
-> (p
    -> (t -> Span -> t -> P a) -> (Span -> t -> P a) -> p -> p -> P b)
-> p
-> (t -> Span -> t -> P a)
-> (Span -> t -> P a)
-> p
-> p
-> P b
try p1 :: p -> (t -> Span -> t -> P b) -> (Span -> t -> P b) -> p -> p -> P b
p1 p2 :: p -> (t -> Span -> t -> P a) -> (Span -> t -> P a) -> p -> p -> P b
p2 lexer :: p
lexer success :: t -> Span -> t -> P a
success failp :: Span -> t -> P a
failp pos :: p
pos s :: p
s =
    ((Span, P a) -> P b) -> P ((Span, P a) -> P b)
forall a b. (a -> P b) -> P (a -> P b)
closeP1 (Span, P a) -> P b
p2s P ((Span, P a) -> P b) -> (((Span, P a) -> P b) -> P b) -> P b
forall a b. P a -> (a -> P b) -> P b
`thenP` \p2s' :: (Span, P a) -> P b
p2s' ->
    ((Span, P a) -> P b) -> P ((Span, P a) -> P b)
forall a b. (a -> P b) -> P (a -> P b)
closeP1 (Span, P a) -> P b
p2f P ((Span, P a) -> P b) -> (((Span, P a) -> P b) -> P b) -> P b
forall a b. P a -> (a -> P b) -> P b
`thenP` \p2f' :: (Span, P a) -> P b
p2f' ->
    (p
 -> (t -> Span -> t -> P b) -> (Span -> t -> P b) -> p -> p -> P b)
-> ((Span, P a) -> P b) -> ((Span, P a) -> P b) -> P b
forall t t t.
(p -> (t -> Span -> t -> t) -> (Span -> t -> t) -> p -> p -> t)
-> ((Span, P a) -> t) -> ((Span, P a) -> t) -> t
parse' p -> (t -> Span -> t -> P b) -> (Span -> t -> P b) -> p -> p -> P b
p1 (((Span, P a) -> P b) -> (Span, P a) -> P b
forall a a b. ((a, P a) -> P b) -> (a, P a) -> P b
retry (Span, P a) -> P b
p2s') (((Span, P a) -> P b) -> (Span, P a) -> P b
forall a a b. ((a, P a) -> P b) -> (a, P a) -> P b
retry (Span, P a) -> P b
p2f')
    where p2s :: (Span, P a) -> P b
p2s r1 :: (Span, P a)
r1 = (p
 -> (t -> Span -> t -> P a) -> (Span -> t -> P a) -> p -> p -> P b)
-> ((Span, P a) -> P a) -> ((Span, P a) -> P a) -> P b
forall t t t.
(p -> (t -> Span -> t -> t) -> (Span -> t -> t) -> p -> p -> t)
-> ((Span, P a) -> t) -> ((Span, P a) -> t) -> t
parse' p -> (t -> Span -> t -> P a) -> (Span -> t -> P a) -> p -> p -> P b
p2       (Bool -> (Span, P a) -> (Span, P a) -> P a
forall a. Bool -> (Span, P a) -> (Span, P a) -> P a
select Bool
True   (Span, P a)
r1) (Bool -> (Span, P a) -> (Span, P a) -> P a
forall a. Bool -> (Span, P a) -> (Span, P a) -> P a
select Bool
False (Span, P a)
r1)
          p2f :: (Span, P a) -> P b
p2f r1 :: (Span, P a)
r1 = (p
 -> (t -> Span -> t -> P a) -> (Span -> t -> P a) -> p -> p -> P b)
-> ((Span, P a) -> P a) -> ((Span, P a) -> P a) -> P b
forall t t t.
(p -> (t -> Span -> t -> t) -> (Span -> t -> t) -> p -> p -> t)
-> ((Span, P a) -> t) -> ((Span, P a) -> t) -> t
parse' p -> (t -> Span -> t -> P a) -> (Span -> t -> P a) -> p -> p -> P b
p2 (((Span, P a) -> (Span, P a) -> P a)
-> (Span, P a) -> (Span, P a) -> P a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> (Span, P a) -> (Span, P a) -> P a
forall a. Bool -> (Span, P a) -> (Span, P a) -> P a
select Bool
False) (Span, P a)
r1) (Bool -> (Span, P a) -> (Span, P a) -> P a
forall a. Bool -> (Span, P a) -> (Span, P a) -> P a
select Bool
False (Span, P a)
r1)
          parse' :: (p -> (t -> Span -> t -> t) -> (Span -> t -> t) -> p -> p -> t)
-> ((Span, P a) -> t) -> ((Span, P a) -> t) -> t
parse' p :: p -> (t -> Span -> t -> t) -> (Span -> t -> t) -> p -> p -> t
p psucc :: (Span, P a) -> t
psucc pfail :: (Span, P a) -> t
pfail =
            p -> (t -> Span -> t -> t) -> (Span -> t -> t) -> p -> p -> t
p p
lexer (((Span, P a) -> t) -> t -> Span -> t -> t
forall t. ((Span, P a) -> t) -> t -> Span -> t -> t
successK (Span, P a) -> t
psucc) (((Span, P a) -> t) -> Span -> t -> t
forall t. ((Span, P a) -> t) -> Span -> t -> t
failK (Span, P a) -> t
pfail) p
pos p
s
          successK :: ((Span, P a) -> t) -> t -> Span -> t -> t
successK k :: (Span, P a) -> t
k x :: t
x pos' :: Span
pos' s' :: t
s' = (Span, P a) -> t
k (Span
pos', t -> Span -> t -> P a
success t
x Span
pos' t
s')
          failK :: ((Span, P a) -> t) -> Span -> t -> t
failK k :: (Span, P a) -> t
k pos' :: Span
pos' msg :: t
msg = (Span, P a) -> t
k (Span
pos', Span -> t -> P a
failp Span
pos' t
msg)
          retry :: ((a, P a) -> P b) -> (a, P a) -> P b
retry k :: (a, P a) -> P b
k (pos' :: a
pos',p :: P a
p) = P a -> P (P a)
forall a. P a -> P (P a)
closeP0 P a
p P (P a) -> (P a -> P b) -> P b
forall a b. P a -> (a -> P b) -> P b
`thenP` ((a, P a) -> P b) -> a -> P a -> P b
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, P a) -> P b
k a
pos'
  select :: Bool -> (Span, P a) -> (Span, P a) -> P a
select suc :: Bool
suc (pos1 :: Span
pos1, p1 :: P a
p1) (pos2 :: Span
pos2, p2 :: P a
p2) = case Span
pos1 Span -> Span -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Span
pos2 of
    GT -> P a
p1
    EQ | Bool
suc       -> Span -> String -> P a
forall a. Span -> String -> P a
failP Span
pos1 (String -> P a) -> String -> P a
forall a b. (a -> b) -> a -> b
$ "Ambiguous parse before " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Position -> String
showPosition (Span -> Position
span2Pos Span
pos1)
       | Bool
otherwise -> P a
p1
    LT -> P a
p2

seqEE :: ParseFun a s (b -> c) -> ParseFun a s b -> ParseFun a s c
seqEE :: ParseFun a s (b -> c) -> ParseFun a s b -> ParseFun a s c
seqEE p1 :: ParseFun a s (b -> c)
p1 p2 :: ParseFun a s b
p2 success :: c -> SuccessP s a
success failp :: FailP a
failp = ParseFun a s (b -> c)
p1 (\f :: b -> c
f -> ParseFun a s b
p2 (c -> SuccessP s a
success (c -> SuccessP s a) -> (b -> c) -> b -> SuccessP s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f) FailP a
failp) FailP a
failp

seqEP :: ParseFun a s (b -> c) -> (Lexer s a -> ParseFun a s b)
      -> Lexer s a -> ParseFun a s c
seqEP :: ParseFun a s (b -> c)
-> (Lexer s a -> ParseFun a s b) -> Lexer s a -> ParseFun a s c
seqEP p1 :: ParseFun a s (b -> c)
p1 p2 :: Lexer s a -> ParseFun a s b
p2 lexer :: Lexer s a
lexer success :: c -> SuccessP s a
success failp :: FailP a
failp = ParseFun a s (b -> c)
p1 (\f :: b -> c
f -> Lexer s a -> ParseFun a s b
p2 Lexer s a
lexer (c -> SuccessP s a
success (c -> SuccessP s a) -> (b -> c) -> b -> SuccessP s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f) FailP a
failp) FailP a
failp

seqPP :: Symbol s => (Lexer s a -> ParseFun a s (b -> c)) -> Parser a s b
      -> Lexer s a -> ParseFun a s c
seqPP :: (Lexer s a -> ParseFun a s (b -> c))
-> Parser a s b -> Lexer s a -> ParseFun a s c
seqPP p1 :: Lexer s a -> ParseFun a s (b -> c)
p1 p2 :: Parser a s b
p2 lexer :: Lexer s a
lexer success :: c -> SuccessP s a
success failp :: FailP a
failp =
  Lexer s a -> ParseFun a s (b -> c)
p1 Lexer s a
lexer (\f :: b -> c
f -> Parser a s b -> Lexer s a -> ParseFun a s b
forall s a b.
Symbol s =>
Parser a s b -> Lexer s a -> ParseFun a s b
choose Parser a s b
p2 Lexer s a
lexer (c -> SuccessP s a
success (c -> SuccessP s a) -> (b -> c) -> b -> SuccessP s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f) FailP a
failp) FailP a
failp

-- ---------------------------------------------------------------------------
-- The combinators \verb|<\\>| and \verb|<\>| can be used to restrict
-- the first set of a parser. This is useful for combining two parsers
-- with an overlapping first set with the deterministic combinator <|>.
-- ---------------------------------------------------------------------------

-- |Restrict the first parser by the first 'Symbol's of the second
(<\>) :: Symbol s => Parser a s b -> Parser a s c -> Parser a s b
p :: Parser a s b
p <\> :: Parser a s b -> Parser a s c -> Parser a s b
<\> Parser _ ps :: Map s (Lexer s a -> ParseFun a s c)
ps = Parser a s b
p Parser a s b -> [s] -> Parser a s b
forall s a b. Symbol s => Parser a s b -> [s] -> Parser a s b
<\\> Map s (Lexer s a -> ParseFun a s c) -> [s]
forall k a. Map k a -> [k]
Map.keys Map s (Lexer s a -> ParseFun a s c)
ps

-- |Restrict a parser by a list of first 'Symbol's
(<\\>) :: Symbol s => Parser a s b -> [s] -> Parser a s b
Parser e :: Maybe (ParseFun a s b)
e ps :: Map s (Lexer s a -> ParseFun a s b)
ps <\\> :: Parser a s b -> [s] -> Parser a s b
<\\> xs :: [s]
xs = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser Maybe (ParseFun a s b)
e ((s
 -> Map s (Lexer s a -> ParseFun a s b)
 -> Map s (Lexer s a -> ParseFun a s b))
-> Map s (Lexer s a -> ParseFun a s b)
-> [s]
-> Map s (Lexer s a -> ParseFun a s b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s
-> Map s (Lexer s a -> ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Map s (Lexer s a -> ParseFun a s b)
ps [s]
xs)

-- ---------------------------------------------------------------------------
-- Other combinators
-- Note that some of these combinators have not been published in the
-- paper, but were taken from the implementation found on the web.
-- ---------------------------------------------------------------------------

-- |Replace the result of the parser with the first argument
(<$->) :: Symbol s => a -> Parser b s c -> Parser b s a
f :: a
f <$-> :: a -> Parser b s c -> Parser b s a
<$-> p :: Parser b s c
p = a -> c -> a
forall a b. a -> b -> a
const a
f (c -> a) -> Parser b s c -> Parser b s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser b s c
p

-- |Apply two parsers in sequence, but return only the result of the first
-- parser
(<*->) :: Symbol s => Parser a s b -> Parser a s c -> Parser a s b
p :: Parser a s b
p <*-> :: Parser a s b -> Parser a s c -> Parser a s b
<*-> q :: Parser a s c
q = b -> c -> b
forall a b. a -> b -> a
const (b -> c -> b) -> Parser a s b -> Parser a s (c -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s b
p Parser a s (c -> b) -> Parser a s c -> Parser a s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s c
q

-- |Apply two parsers in sequence, but return only the result of the second
-- parser
(<-*>) :: Symbol s => Parser a s b -> Parser a s c -> Parser a s c
p :: Parser a s b
p <-*> :: Parser a s b -> Parser a s c -> Parser a s c
<-*> q :: Parser a s c
q = (c -> c) -> b -> c -> c
forall a b. a -> b -> a
const c -> c
forall a. a -> a
id (b -> c -> c) -> Parser a s b -> Parser a s (c -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s b
p Parser a s (c -> c) -> Parser a s c -> Parser a s c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s c
q

-- |Apply the parsers in sequence and apply the result function of the second
-- parse to the result of the first
(<**>) :: Symbol s => Parser a s b -> Parser a s (b -> c) -> Parser a s c
p :: Parser a s b
p <**> :: Parser a s b -> Parser a s (b -> c) -> Parser a s c
<**> q :: Parser a s (b -> c)
q = ((b -> c) -> b -> c) -> b -> (b -> c) -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> c) -> b -> c
forall a b. (a -> b) -> a -> b
($) (b -> (b -> c) -> c) -> Parser a s b -> Parser a s ((b -> c) -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s b
p Parser a s ((b -> c) -> c) -> Parser a s (b -> c) -> Parser a s c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s (b -> c)
q

-- |Same as (<**>), but only applies the function if the second parser
-- succeeded.
(<??>) :: Symbol s => Parser a s b -> Parser a s (b -> b) -> Parser a s b
p :: Parser a s b
p <??> :: Parser a s b -> Parser a s (b -> b) -> Parser a s b
<??> q :: Parser a s (b -> b)
q = Parser a s b
p Parser a s b -> Parser a s (b -> b) -> Parser a s b
forall s a b c.
Symbol s =>
Parser a s b -> Parser a s (b -> c) -> Parser a s c
<**> (Parser a s (b -> b)
q Parser a s (b -> b) -> (b -> b) -> Parser a s (b -> b)
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` b -> b
forall a. a -> a
id)

-- |Flipped function composition on parsers
(<.>) :: Symbol s => Parser a s (b -> c) -> Parser a s (c -> d)
      -> Parser a s (b -> d)
p1 :: Parser a s (b -> c)
p1 <.> :: Parser a s (b -> c) -> Parser a s (c -> d) -> Parser a s (b -> d)
<.> p2 :: Parser a s (c -> d)
p2 = Parser a s (b -> c)
p1 Parser a s (b -> c)
-> Parser a s ((b -> c) -> b -> d) -> Parser a s (b -> d)
forall s a b c.
Symbol s =>
Parser a s b -> Parser a s (b -> c) -> Parser a s c
<**> ((c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((c -> d) -> (b -> c) -> b -> d)
-> Parser a s (c -> d) -> Parser a s ((b -> c) -> b -> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s (c -> d)
p2)

-- |Try the first parser, but return the second argument if it didn't succeed
opt :: Symbol s => Parser a s b -> b -> Parser a s b
p :: Parser a s b
p opt :: Parser a s b -> b -> Parser a s b
`opt` x :: b
x = Parser a s b
p Parser a s b -> Parser a s b -> Parser a s b
forall s a b.
Symbol s =>
Parser a s b -> Parser a s b -> Parser a s b
<|> b -> Parser a s b
forall b a s. b -> Parser a s b
succeed b
x

-- |Choose the first succeeding parser from a non-empty list of parsers
choice :: Symbol s => [Parser a s b] -> Parser a s b
choice :: [Parser a s b] -> Parser a s b
choice = (Parser a s b -> Parser a s b -> Parser a s b)
-> [Parser a s b] -> Parser a s b
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Parser a s b -> Parser a s b -> Parser a s b
forall s a b.
Symbol s =>
Parser a s b -> Parser a s b -> Parser a s b
(<|>)

-- |Try to apply a given parser and return a boolean value if the parser
-- succeeded.
flag :: Symbol s => Parser a s b -> Parser a s Bool
flag :: Parser a s b -> Parser a s Bool
flag p :: Parser a s b
p = Bool
True Bool -> Parser a s b -> Parser a s Bool
forall s a b c. Symbol s => a -> Parser b s c -> Parser b s a
<$-> Parser a s b
p Parser a s Bool -> Bool -> Parser a s Bool
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` Bool
False

-- |Try to apply a parser but forget if it succeeded
optional :: Symbol s => Parser a s b -> Parser a s ()
optional :: Parser a s b -> Parser a s ()
optional p :: Parser a s b
p = () -> b -> ()
forall a b. a -> b -> a
const () (b -> ()) -> Parser a s b -> Parser a s ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s b
p Parser a s () -> () -> Parser a s ()
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` ()

-- |Try to apply a parser and return its result in a 'Maybe' type
option :: Symbol s => Parser a s b -> Parser a s (Maybe b)
option :: Parser a s b -> Parser a s (Maybe b)
option p :: Parser a s b
p = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> Parser a s b -> Parser a s (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s b
p Parser a s (Maybe b) -> Maybe b -> Parser a s (Maybe b)
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` Maybe b
forall a. Maybe a
Nothing

-- |Repeatedly apply a parser for 0 or more occurences
many :: Symbol s => Parser a s b -> Parser a s [b]
many :: Parser a s b -> Parser a s [b]
many p :: Parser a s b
p = Parser a s b -> Parser a s [b]
forall s a b. Symbol s => Parser a s b -> Parser a s [b]
many1 Parser a s b
p Parser a s [b] -> [b] -> Parser a s [b]
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` []

-- |Repeatedly apply a parser for 1 or more occurences
many1 :: Symbol s => Parser a s b -> Parser a s [b]
many1 :: Parser a s b -> Parser a s [b]
many1 p :: Parser a s b
p = (:) (b -> [b] -> [b]) -> Parser a s b -> Parser a s ([b] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s b
p Parser a s ([b] -> [b]) -> Parser a s [b] -> Parser a s [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s b -> Parser a s [b]
forall s a b. Symbol s => Parser a s b -> Parser a s [b]
many Parser a s b
p

-- |Parse a list with is separated by a seperator
sepBy :: Symbol s => Parser a s b -> Parser a s c -> Parser a s [b]
p :: Parser a s b
p sepBy :: Parser a s b -> Parser a s c -> Parser a s [b]
`sepBy` q :: Parser a s c
q = Parser a s b
p Parser a s b -> Parser a s c -> Parser a s [b]
forall s a b c.
Symbol s =>
Parser a s b -> Parser a s c -> Parser a s [b]
`sepBy1` Parser a s c
q Parser a s [b] -> [b] -> Parser a s [b]
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` []

-- |Parse a non-empty list with is separated by a seperator
sepBy1 :: Symbol s => Parser a s b -> Parser a s c -> Parser a s [b]
p :: Parser a s b
p sepBy1 :: Parser a s b -> Parser a s c -> Parser a s [b]
`sepBy1` q :: Parser a s c
q = (:) (b -> [b] -> [b]) -> Parser a s b -> Parser a s ([b] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s b
p Parser a s ([b] -> [b]) -> Parser a s [b] -> Parser a s [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s b -> Parser a s [b]
forall s a b. Symbol s => Parser a s b -> Parser a s [b]
many (Parser a s c
q Parser a s c -> Parser a s b -> Parser a s b
forall s a b c.
Symbol s =>
Parser a s b -> Parser a s c -> Parser a s c
<-*> Parser a s b
p)

-- |Parse a list with is separated by a seperator
sepBySp :: Symbol s => Parser a s b -> Parser a s c -> Parser a s ([b], [Span])
p :: Parser a s b
p sepBySp :: Parser a s b -> Parser a s c -> Parser a s ([b], [Span])
`sepBySp` q :: Parser a s c
q = Parser a s b
p Parser a s b -> Parser a s c -> Parser a s ([b], [Span])
forall s a b c.
Symbol s =>
Parser a s b -> Parser a s c -> Parser a s ([b], [Span])
`sepBy1Sp` Parser a s c
q Parser a s ([b], [Span])
-> ([b], [Span]) -> Parser a s ([b], [Span])
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` ([], [])

sepBy1Sp :: Symbol s => Parser a s b -> Parser a s c -> Parser a s ([b], [Span])
p :: Parser a s b
p sepBy1Sp :: Parser a s b -> Parser a s c -> Parser a s ([b], [Span])
`sepBy1Sp` q :: Parser a s c
q = b -> [(Span, b)] -> ([b], [Span])
forall a a. a -> [(a, a)] -> ([a], [a])
comb (b -> [(Span, b)] -> ([b], [Span]))
-> Parser a s b -> Parser a s ([(Span, b)] -> ([b], [Span]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s b
p Parser a s ([(Span, b)] -> ([b], [Span]))
-> Parser a s [(Span, b)] -> Parser a s ([b], [Span])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s (Span, b) -> Parser a s [(Span, b)]
forall s a b. Symbol s => Parser a s b -> Parser a s [b]
many ((,) (Span -> b -> (Span, b))
-> Parser a s Span -> Parser a s (b -> (Span, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s Span
forall s a. Symbol s => Parser a s Span
spanPosition Parser a s (b -> (Span, b))
-> Parser a s c -> Parser a s (b -> (Span, b))
forall s a b c.
Symbol s =>
Parser a s b -> Parser a s c -> Parser a s b
<*-> Parser a s c
q Parser a s (b -> (Span, b)) -> Parser a s b -> Parser a s (Span, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s b
p)
  where comb :: a -> [(a, a)] -> ([a], [a])
comb x :: a
x xs :: [(a, a)]
xs = let (ss :: [a]
ss, ys :: [a]
ys) = [(a, a)] -> ([a], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, a)]
xs
                    in (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys,[a]
ss)

-- |@chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
-- Returns a value produced by a *right* associative application of all
-- functions returned by op. If there are no occurrences of @p@, @x@ is
-- returned.
chainr :: Symbol s
       => Parser a s b -> Parser a s (b -> b -> b) -> b -> Parser a s b
chainr :: Parser a s b -> Parser a s (b -> b -> b) -> b -> Parser a s b
chainr p :: Parser a s b
p op :: Parser a s (b -> b -> b)
op x :: b
x = Parser a s b -> Parser a s (b -> b -> b) -> Parser a s b
forall s a b.
Symbol s =>
Parser a s b -> Parser a s (b -> b -> b) -> Parser a s b
chainr1 Parser a s b
p Parser a s (b -> b -> b)
op Parser a s b -> b -> Parser a s b
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` b
x

-- |Like 'chainr', but parses one or more occurrences of p.
chainr1 :: Symbol s => Parser a s b -> Parser a s (b -> b -> b) -> Parser a s b
chainr1 :: Parser a s b -> Parser a s (b -> b -> b) -> Parser a s b
chainr1 p :: Parser a s b
p op :: Parser a s (b -> b -> b)
op = Parser a s b
r where r :: Parser a s b
r = Parser a s b
p Parser a s b -> Parser a s (b -> b) -> Parser a s b
forall s a b c.
Symbol s =>
Parser a s b -> Parser a s (b -> c) -> Parser a s c
<**> ((b -> b -> b) -> b -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> b -> b) -> b -> b -> b)
-> Parser a s (b -> b -> b) -> Parser a s (b -> b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s (b -> b -> b)
op Parser a s (b -> b -> b) -> Parser a s b -> Parser a s (b -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s b
r Parser a s (b -> b) -> (b -> b) -> Parser a s (b -> b)
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` b -> b
forall a. a -> a
id)

-- |@chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
-- Returns a value produced by a *left* associative application of all
-- functions returned by op. If there are no occurrences of @p@, @x@ is
-- returned.
chainl :: Symbol s
       => Parser a s b -> Parser a s (b -> b -> b) -> b -> Parser a s b
chainl :: Parser a s b -> Parser a s (b -> b -> b) -> b -> Parser a s b
chainl p :: Parser a s b
p op :: Parser a s (b -> b -> b)
op x :: b
x = Parser a s b -> Parser a s (b -> b -> b) -> Parser a s b
forall s a b.
Symbol s =>
Parser a s b -> Parser a s (b -> b -> b) -> Parser a s b
chainl1 Parser a s b
p Parser a s (b -> b -> b)
op Parser a s b -> b -> Parser a s b
forall s a b. Symbol s => Parser a s b -> b -> Parser a s b
`opt` b
x

-- |Like 'chainl', but parses one or more occurrences of p.
chainl1 :: Symbol s => Parser a s b -> Parser a s (b -> b -> b) -> Parser a s b
chainl1 :: Parser a s b -> Parser a s (b -> b -> b) -> Parser a s b
chainl1 p :: Parser a s b
p op :: Parser a s (b -> b -> b)
op = b -> [b -> b] -> b
forall t. t -> [t -> t] -> t
foldF (b -> [b -> b] -> b) -> Parser a s b -> Parser a s ([b -> b] -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s b
p Parser a s ([b -> b] -> b) -> Parser a s [b -> b] -> Parser a s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s (b -> b) -> Parser a s [b -> b]
forall s a b. Symbol s => Parser a s b -> Parser a s [b]
many ((b -> b -> b) -> b -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> b -> b) -> b -> b -> b)
-> Parser a s (b -> b -> b) -> Parser a s (b -> b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a s (b -> b -> b)
op Parser a s (b -> b -> b) -> Parser a s b -> Parser a s (b -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a s b
p)
  where foldF :: t -> [t -> t] -> t
foldF x :: t
x []     = t
x
        foldF x :: t
x (f :: t -> t
f:fs :: [t -> t]
fs) = t -> [t -> t] -> t
foldF (t -> t
f t
x) [t -> t]
fs

-- |Parse an expression between an opening and a closing part.
between :: Symbol s => Parser a s b -> Parser a s c -> Parser a s b
        -> Parser a s c
between :: Parser a s b -> Parser a s c -> Parser a s b -> Parser a s c
between open :: Parser a s b
open p :: Parser a s c
p close :: Parser a s b
close = Parser a s b
open Parser a s b -> Parser a s c -> Parser a s c
forall s a b c.
Symbol s =>
Parser a s b -> Parser a s c -> Parser a s c
<-*> Parser a s c
p Parser a s c -> Parser a s b -> Parser a s c
forall s a b c.
Symbol s =>
Parser a s b -> Parser a s c -> Parser a s b
<*-> Parser a s b
close

-- |Parse one of the given operators
ops :: Symbol s => [(s, b)] -> Parser a s b
ops :: [(s, b)] -> Parser a s b
ops []              = String -> Parser a s b
forall a s b. String -> Parser a s b
failure "Curry.Base.LLParseComb.ops: empty list"
ops [(s :: s
s, x :: b
x)]        = b
x b -> Parser a s s -> Parser a s b
forall s a b c. Symbol s => a -> Parser b s c -> Parser b s a
<$-> s -> Parser a s s
forall s a. s -> Parser a s s
symbol s
s
ops ((s :: s
s, x :: b
x) : rest :: [(s, b)]
rest) = b
x b -> Parser a s s -> Parser a s b
forall s a b c. Symbol s => a -> Parser b s c -> Parser b s a
<$-> s -> Parser a s s
forall s a. s -> Parser a s s
symbol s
s Parser a s b -> Parser a s b -> Parser a s b
forall s a b.
Symbol s =>
Parser a s b -> Parser a s b -> Parser a s b
<|> [(s, b)] -> Parser a s b
forall s b a. Symbol s => [(s, b)] -> Parser a s b
ops [(s, b)]
rest

-- ---------------------------------------------------------------------------
-- Layout combinators
-- Note that the layout functions grab the next token (and its position).
-- After modifying the layout context, the continuation is called with
-- the same token and an undefined result.
-- ---------------------------------------------------------------------------

-- |Disable layout-awareness for the following
layoutOff :: Symbol s => Parser a s b
layoutOff :: Parser a s b
layoutOff = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser (ParseFun a s b -> Maybe (ParseFun a s b)
forall a. a -> Maybe a
Just ParseFun a s b
forall t t a a p. (t -> t -> a -> P a) -> p -> t -> a -> P a
off) Map s (Lexer s a -> ParseFun a s b)
forall k a. Map k a
Map.empty
  where off :: (t -> t -> a -> P a) -> p -> t -> a -> P a
off success :: t -> t -> a -> P a
success _ pos :: t
pos = Int -> P a -> P a
forall a. Int -> P a -> P a
pushContext (-1) (P a -> P a) -> (a -> P a) -> a -> P a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t -> a -> P a
success t
forall a. HasCallStack => a
undefined t
pos

-- |Add a new scope for layout
layoutOn :: Symbol s => Parser a s b
layoutOn :: Parser a s b
layoutOn = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser (ParseFun a s b -> Maybe (ParseFun a s b)
forall a. a -> Maybe a
Just ParseFun a s b
forall t a a p. (t -> Span -> a -> P a) -> p -> Span -> a -> P a
on) Map s (Lexer s a -> ParseFun a s b)
forall k a. Map k a
Map.empty
  where on :: (t -> Span -> a -> P a) -> p -> Span -> a -> P a
on success :: t -> Span -> a -> P a
success _ pos :: Span
pos = Int -> P a -> P a
forall a. Int -> P a -> P a
pushContext (Position -> Int
column (Span -> Position
span2Pos Span
pos)) (P a -> P a) -> (a -> P a) -> a -> P a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Span -> a -> P a
success t
forall a. HasCallStack => a
undefined Span
pos

-- |End the current layout scope (or re-enable layout-awareness if it is
-- currently disabled
layoutEnd :: Symbol s => Parser a s b
layoutEnd :: Parser a s b
layoutEnd = Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
forall a s b.
Maybe (ParseFun a s b)
-> Map s (Lexer s a -> ParseFun a s b) -> Parser a s b
Parser (ParseFun a s b -> Maybe (ParseFun a s b)
forall a. a -> Maybe a
Just ParseFun a s b
forall t t a a p. (t -> t -> a -> P a) -> p -> t -> a -> P a
end) Map s (Lexer s a -> ParseFun a s b)
forall k a. Map k a
Map.empty
  where end :: (t -> t -> a -> P a) -> p -> t -> a -> P a
end success :: t -> t -> a -> P a
success _ pos :: t
pos = P a -> P a
forall a. P a -> P a
popContext (P a -> P a) -> (a -> P a) -> a -> P a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t -> a -> P a
success t
forall a. HasCallStack => a
undefined t
pos