-- |
--
-- Module:      Language.Egison.Parser.Pattern.Prim
-- Description: Parser monad and primitive parsers
-- Stability:   experimental
--
-- A parser monad and primitive parsers.
--
-- Note that all dependencies on parser library are in this module.

module Language.Egison.Parser.Pattern.Prim
  (
  -- * Parser Configuration
    ParseFixity(..)
  , ParseMode(..)
  , ExtParser
  -- * Parser Monad
  , Parse
  , runParse
  -- * Primitive Parsers
  , extParser
  , space
  , lexeme
  , name
  , varName
  , valueExpr
  -- * Errors
  , Errors
  , Error(..)
  , ErrorItem(..)
  -- * Locations
  , Position(..)
  , Location(..)
  , Locate(..)
  -- * Source Stream Class
  , Source
  , Token
  , Tokens
  -- * Re-exports
  , module X
  )
where

-- re-exports
import           Text.Megaparsec               as X
                                                ( MonadParsec(..)
                                                , (<?>)
                                                , single
                                                , chunk
                                                )

-- main
import           Control.Monad                  ( void )
import           Control.Monad.Reader           ( ask )
import           Control.Applicative            ( Alternative((<|>))
                                                , empty
                                                )
import qualified Text.Megaparsec               as Parsec
                                                ( takeWhile1P
                                                , takeWhileP
                                                , manyTill
                                                , chunk
                                                , customFailure
                                                , single
                                                , anySingle
                                                )
import qualified Text.Megaparsec.Char.Lexer    as L
                                                ( lexeme
                                                , space
                                                )

import qualified Language.Egison.Parser.Pattern.Token
                                               as Token
                                                ( isSpace
                                                , comma
                                                , parenLeft
                                                , parenRight
                                                , bracketLeft
                                                , bracketRight
                                                , newline
                                                )
import           Language.Egison.Parser.Pattern.Prim.Location
                                                ( Position(..)
                                                , Location(..)
                                                , Locate(..)
                                                )
import           Language.Egison.Parser.Pattern.Prim.Error
                                                ( Error(..)
                                                , ErrorItem(..)
                                                , Errors
                                                , CustomError(..)
                                                )

import           Language.Egison.Parser.Pattern.Prim.Source
                                                ( Source(..)
                                                , Token
                                                , Tokens
                                                )
import           Language.Egison.Parser.Pattern.Prim.ParseMode
                                                ( ParseMode(..)
                                                , ParseFixity(..)
                                                , ExtParser
                                                )
import           Language.Egison.Parser.Pattern.Prim.Parse
                                                ( Parse
                                                , runParse
                                                )


skipBlockComment :: Source s => Tokens s -> Tokens s -> Parse n v e s ()
skipBlockComment :: Tokens s -> Tokens s -> Parse n v e s ()
skipBlockComment Tokens s
start Tokens s
end = Parse n v e s (Tokens s)
cs Parse n v e s (Tokens s) -> Parse n v e s () -> Parse n v e s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse n v e s [Token s] -> Parse n v e s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parse n v e s (Token s)
-> Parse n v e s (Tokens s) -> Parse n v e s [Token s]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
Parsec.manyTill Parse n v e s (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
Parsec.anySingle Parse n v e s (Tokens s)
ce)
 where
  cs :: Parse n v e s (Tokens s)
cs = Tokens s -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parsec.chunk Tokens s
start
  ce :: Parse n v e s (Tokens s)
ce = Tokens s -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parsec.chunk Tokens s
end

skipLineComment :: Source s => Tokens s -> Parse n v e s ()
skipLineComment :: Tokens s -> Parse n v e s ()
skipLineComment Tokens s
prefix = Tokens s -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parsec.chunk Tokens s
prefix
  Parse n v e s (Tokens s) -> Parse n v e s () -> Parse n v e s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse n v e s (Tokens s) -> Parse n v e s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"chars") (Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Token s
forall c. IsToken c => c
Token.newline))

-- | Skip one or more spaces.
space :: Source s => Parse n v e s ()
space :: Parse n v e s ()
space = do
  ParseMode { Maybe (Tokens s, Tokens s)
$sel:blockComment:ParseMode :: forall n v e s. ParseMode n v e s -> Maybe (Tokens s, Tokens s)
blockComment :: Maybe (Tokens s, Tokens s)
blockComment, Maybe (Tokens s)
$sel:lineComment:ParseMode :: forall n v e s. ParseMode n v e s -> Maybe (Tokens s)
lineComment :: Maybe (Tokens s)
lineComment } <- Parse n v e s (ParseMode n v e s)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let block :: Parse n v e s ()
block = ((Tokens s, Tokens s) -> Parse n v e s ())
-> Maybe (Tokens s, Tokens s) -> Parse n v e s ()
forall a a. (a -> Parse n v e s a) -> Maybe a -> Parse n v e s a
emptyOr ((Tokens s -> Tokens s -> Parse n v e s ())
-> (Tokens s, Tokens s) -> Parse n v e s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Tokens s -> Tokens s -> Parse n v e s ()
forall s n v e.
Source s =>
Tokens s -> Tokens s -> Parse n v e s ()
skipBlockComment) Maybe (Tokens s, Tokens s)
blockComment
      line :: Parse n v e s ()
line  = (Tokens s -> Parse n v e s ())
-> Maybe (Tokens s) -> Parse n v e s ()
forall a a. (a -> Parse n v e s a) -> Maybe a -> Parse n v e s a
emptyOr Tokens s -> Parse n v e s ()
forall s n v e. Source s => Tokens s -> Parse n v e s ()
skipLineComment Maybe (Tokens s)
lineComment
  Parse n v e s ()
-> Parse n v e s () -> Parse n v e s () -> Parse n v e s ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parse n v e s ()
space1 Parse n v e s ()
line Parse n v e s ()
block
 where
  space1 :: Parse n v e s ()
space1  = Parse n v e s (Tokens s) -> Parse n v e s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parse n v e s (Tokens s) -> Parse n v e s ())
-> Parse n v e s (Tokens s) -> Parse n v e s ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"whitespace") Token s -> Bool
forall c. IsToken c => c -> Bool
Token.isSpace
  emptyOr :: (a -> Parse n v e s a) -> Maybe a -> Parse n v e s a
emptyOr = Parse n v e s a
-> (a -> Parse n v e s a) -> Maybe a -> Parse n v e s a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parse n v e s a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Parse a lexical chunk.
takeChunk :: forall n v e s . Source s => Parse n v e s (Tokens s)
takeChunk :: Parse n v e s (Tokens s)
takeChunk = Parse n v e s (Tokens s)
withParens Parse n v e s (Tokens s)
-> Parse n v e s (Tokens s) -> Parse n v e s (Tokens s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (Tokens s)
withBrackets Parse n v e s (Tokens s)
-> Parse n v e s (Tokens s) -> Parse n v e s (Tokens s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (Tokens s)
withoutParens
 where
  withParens :: Parse n v e s (Tokens s)
withParens = do
    Token s
left <- Token s -> Parse n v e s (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parsec.single Token s
forall c. IsToken c => c
Token.parenLeft
    Tokens s
ck   <- Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"lexical chunk (in parens)")
                              (Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Token s
forall c. IsToken c => c
Token.parenRight)
    Token s
right <- Token s -> Parse n v e s (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parsec.single Token s
forall c. IsToken c => c
Token.parenRight
    Tokens s -> Parse n v e s (Tokens s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tokens s -> Parse n v e s (Tokens s))
-> Tokens s -> Parse n v e s (Tokens s)
forall a b. (a -> b) -> a -> b
$ Token s -> Tokens s -> Tokens s
forall s. Source s => Token s -> Tokens s -> Tokens s
consTokens @s Token s
left (Tokens s -> Token s -> Tokens s
forall s. Source s => Tokens s -> Token s -> Tokens s
snocTokens @s Tokens s
ck Token s
right)
  withBrackets :: Parse n v e s (Tokens s)
withBrackets = do
    Token s
left <- Token s -> Parse n v e s (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parsec.single Token s
forall c. IsToken c => c
Token.bracketLeft
    Tokens s
ck   <- Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"lexical chunk (in brackets)")
                              (Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Token s
forall c. IsToken c => c
Token.bracketRight)
    Token s
right <- Token s -> Parse n v e s (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parsec.single Token s
forall c. IsToken c => c
Token.bracketRight
    Tokens s -> Parse n v e s (Tokens s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tokens s -> Parse n v e s (Tokens s))
-> Tokens s -> Parse n v e s (Tokens s)
forall a b. (a -> b) -> a -> b
$ Token s -> Tokens s -> Tokens s
forall s. Source s => Token s -> Tokens s -> Tokens s
consTokens @s Token s
left (Tokens s -> Token s -> Tokens s
forall s. Source s => Tokens s -> Token s -> Tokens s
snocTokens @s Tokens s
ck Token s
right)
  withoutParens :: Parse n v e s (Tokens s)
withoutParens = Maybe String -> (Token s -> Bool) -> Parse n v e s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Parsec.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"lexical chunk") Token s -> Bool
forall a. (IsToken a, Eq a) => a -> Bool
endOfChunk
  endOfChunk :: a -> Bool
endOfChunk a
x = Bool -> Bool
not (a -> Bool
forall a. (IsToken a, Eq a) => a -> Bool
isDelimiter a
x) Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall c. IsToken c => c
Token.parenRight
  isDelimiter :: a -> Bool
isDelimiter a
x =
    a -> Bool
forall c. IsToken c => c -> Bool
Token.isSpace a
x
      Bool -> Bool -> Bool
|| a
forall c. IsToken c => c
Token.comma
      a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
      Bool -> Bool -> Bool
|| a
forall c. IsToken c => c
Token.parenRight
      a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
      Bool -> Bool -> Bool
|| a
forall c. IsToken c => c
Token.bracketRight
      a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x

-- | Apply an external parser.
extParser :: Source s => ExtParser s a -> Parse n v e s a
extParser :: ExtParser s a -> Parse n v e s a
extParser ExtParser s a
p = Parse n v e s a -> Parse n v e s a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parse n v e s a -> Parse n v e s a)
-> Parse n v e s a -> Parse n v e s a
forall a b. (a -> b) -> a -> b
$ do
  Tokens s
lchunk <- Parse n v e s (Tokens s)
forall n v e s. Source s => Parse n v e s (Tokens s)
takeChunk
  case ExtParser s a
p Tokens s
lchunk of
    Left  String
err -> CustomError s -> Parse n v e s a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
Parsec.customFailure (Tokens s -> String -> CustomError s
forall s. Tokens s -> String -> CustomError s
ExtParserError Tokens s
lchunk String
err)
    Right a
x   -> a -> Parse n v e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | Make a lexical token.
-- @lexeme p@ first applies parser @p@ then 'space' parser.
lexeme :: Source s => Parse n v e s a -> Parse n v e s a
lexeme :: Parse n v e s a -> Parse n v e s a
lexeme = Parse n v e s () -> Parse n v e s a -> Parse n v e s a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parse n v e s ()
forall s n v e. Source s => Parse n v e s ()
space

-- | Parser for @n@ in @Parse n v e s@ monad.
name :: Source s => Parse n v e s n
name :: Parse n v e s n
name = do
  ParseMode { ExtParser s n
$sel:nameParser:ParseMode :: forall n v e s. ParseMode n v e s -> ExtParser s n
nameParser :: ExtParser s n
nameParser } <- Parse n v e s (ParseMode n v e s)
forall r (m :: * -> *). MonadReader r m => m r
ask
  ExtParser s n -> Parse n v e s n
forall s a n v e. Source s => ExtParser s a -> Parse n v e s a
extParser ExtParser s n
nameParser

-- | Parser for @v@ in @Parse n v e s@ monad.
varName :: Source s => Parse n v e s v
varName :: Parse n v e s v
varName = do
  ParseMode { ExtParser s v
$sel:varNameParser:ParseMode :: forall n v e s. ParseMode n v e s -> ExtParser s v
varNameParser :: ExtParser s v
varNameParser } <- Parse n v e s (ParseMode n v e s)
forall r (m :: * -> *). MonadReader r m => m r
ask
  ExtParser s v -> Parse n v e s v
forall s a n v e. Source s => ExtParser s a -> Parse n v e s a
extParser ExtParser s v
varNameParser

-- | Parser for @e@ in @Parse n v e s@ monad.
valueExpr :: Source s => Parse n v e s e
valueExpr :: Parse n v e s e
valueExpr = do
  ParseMode { ExtParser s e
$sel:valueExprParser:ParseMode :: forall n v e s. ParseMode n v e s -> ExtParser s e
valueExprParser :: ExtParser s e
valueExprParser } <- Parse n v e s (ParseMode n v e s)
forall r (m :: * -> *). MonadReader r m => m r
ask
  ExtParser s e -> Parse n v e s e
forall s a n v e. Source s => ExtParser s a -> Parse n v e s a
extParser ExtParser s e
valueExprParser