-- |
--
-- Module:      Language.Egison.Parser.Pattern
-- Description: Parser for Egison patterns
-- Stability:   experimental
--
-- A parser for Egison patterns.

{-# OPTIONS_GHC -Wno-orphans #-}

module Language.Egison.Parser.Pattern
  ( parseExpr
  , parseExprL
  , module X
  )
where

-- re-exports
import           Language.Egison.Parser.Pattern.Prim
                                               as X
                                                ( Source
                                                , Token
                                                , Tokens
                                                , ExtParser
                                                , ParseMode(..)
                                                , ParseFixity(..)
                                                , Errors
                                                , Error(..)
                                                , ErrorItem(..)
                                                , Location(..)
                                                , Position(..)
                                                )
import           Language.Egison.Parser.Pattern.Expr
                                               as X
                                                ( Precedence(..)
                                                , Associativity(..)
                                                , Fixity(..)
                                                , ExprL
                                                )
import           Language.Egison.Parser.Pattern.Token
                                               as X
                                                ( IsToken(..) )
import           Language.Egison.Parser.Pattern.Parsable
                                               as X
                                                ( Parsable(..) )

-- main
import           Control.Monad.Except           ( MonadError )
import           Control.Applicative            ( (<|>) )
import           Control.Monad.Combinators      ( many
                                                , sepBy
                                                )
import           Control.Comonad.Cofree         ( unwrap )

import           Language.Egison.Parser.Pattern.Prim
                                                ( Parse
                                                , runParse
                                                , lexeme
                                                , space
                                                , name
                                                , varName
                                                , valueExpr
                                                , (<?>)
                                                )
import           Language.Egison.Parser.Pattern.Combinator
                                                ( token
                                                , parens
                                                )
import           Language.Egison.Parser.Pattern.Expr
                                                ( exprParser
                                                , atomParser
                                                , Table(..)
                                                , initTable
                                                , addInfix
                                                )
import qualified Language.Egison.Parser.Pattern.Token
                                               as Token
                                                ( IsToken(..) )
import qualified Language.Egison.Syntax.Pattern.Fixity.Primitive
                                               as PrimOp
import           Language.Egison.Syntax.Pattern.Expr
                                                ( Expr )
import           Language.Egison.Syntax.Pattern.Base
                                                ( ExprF(..) )


primInfixes
  :: Source s
  => [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
primInfixes :: [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
primInfixes =
  [ ( Precedence
PrimOp.andPrecedence
    , Associativity
-> Parse
     n v e s (ExprL n v e -> ExprL n v e -> ExprF n v e (ExprL n v e))
-> Table (Parse n v e s) (ExprF n v e) (ExprL n v e)
-> Table (Parse n v e s) (ExprF n v e) (ExprL n v e)
forall (m :: * -> *) a (f :: * -> *).
Associativity -> m (a -> a -> f a) -> Table m f a -> Table m f a
addInfix Associativity
PrimOp.andAssociativity (ExprL n v e -> ExprL n v e -> ExprF n v e (ExprL n v e)
forall n v e r. r -> r -> ExprF n v e r
AndF (ExprL n v e -> ExprL n v e -> ExprF n v e (ExprL n v e))
-> Parse n v e s ()
-> Parse
     n v e s (ExprL n v e -> ExprL n v e -> ExprF n v e (ExprL n v e))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.and) Table (Parse n v e s) (ExprF n v e) (ExprL n v e)
forall (m :: * -> *) (f :: * -> *) a. Table m f a
initTable
    )
  , ( Precedence
PrimOp.orPrecedence
    , Associativity
-> Parse
     n v e s (ExprL n v e -> ExprL n v e -> ExprF n v e (ExprL n v e))
-> Table (Parse n v e s) (ExprF n v e) (ExprL n v e)
-> Table (Parse n v e s) (ExprF n v e) (ExprL n v e)
forall (m :: * -> *) a (f :: * -> *).
Associativity -> m (a -> a -> f a) -> Table m f a -> Table m f a
addInfix Associativity
PrimOp.orAssociativity (ExprL n v e -> ExprL n v e -> ExprF n v e (ExprL n v e)
forall n v e r. r -> r -> ExprF n v e r
OrF (ExprL n v e -> ExprL n v e -> ExprF n v e (ExprL n v e))
-> Parse n v e s ()
-> Parse
     n v e s (ExprL n v e -> ExprL n v e -> ExprF n v e (ExprL n v e))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.vertical) Table (Parse n v e s) (ExprF n v e) (ExprL n v e)
forall (m :: * -> *) (f :: * -> *) a. Table m f a
initTable
    )
  ]

wildcard :: Source s => Parse n v e s (ExprF n v e a)
wildcard :: Parse n v e s (ExprF n v e a)
wildcard = ExprF n v e a
forall n v e r. ExprF n v e r
WildcardF ExprF n v e a -> Parse n v e s () -> Parse n v e s (ExprF n v e a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.underscore

variable :: Source s => Parse n v e s (ExprF n v e a)
variable :: Parse n v e s (ExprF n v e a)
variable = do
  Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.dollar
  v
v <- Parse n v e s v -> Parse n v e s v
forall s n v e a. Source s => Parse n v e s a -> Parse n v e s a
lexeme Parse n v e s v
forall s n v e. Source s => Parse n v e s v
varName
  ExprF n v e a -> Parse n v e s (ExprF n v e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF n v e a -> Parse n v e s (ExprF n v e a))
-> ExprF n v e a -> Parse n v e s (ExprF n v e a)
forall a b. (a -> b) -> a -> b
$ v -> ExprF n v e a
forall n v e r. v -> ExprF n v e r
VariableF v
v

value :: Source s => Parse n v e s (ExprF n v e a)
value :: Parse n v e s (ExprF n v e a)
value = do
  Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.hash
  e
e <- Parse n v e s e -> Parse n v e s e
forall s n v e a. Source s => Parse n v e s a -> Parse n v e s a
lexeme Parse n v e s e
forall s n v e. Source s => Parse n v e s e
valueExpr
  ExprF n v e a -> Parse n v e s (ExprF n v e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF n v e a -> Parse n v e s (ExprF n v e a))
-> ExprF n v e a -> Parse n v e s (ExprF n v e a)
forall a b. (a -> b) -> a -> b
$ e -> ExprF n v e a
forall n v e r. e -> ExprF n v e r
ValueF e
e

predicate :: Source s => Parse n v e s (ExprF n v e a)
predicate :: Parse n v e s (ExprF n v e a)
predicate = do
  Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.question
  e
e <- Parse n v e s e -> Parse n v e s e
forall s n v e a. Source s => Parse n v e s a -> Parse n v e s a
lexeme Parse n v e s e
forall s n v e. Source s => Parse n v e s e
valueExpr
  ExprF n v e a -> Parse n v e s (ExprF n v e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF n v e a -> Parse n v e s (ExprF n v e a))
-> ExprF n v e a -> Parse n v e s (ExprF n v e a)
forall a b. (a -> b) -> a -> b
$ e -> ExprF n v e a
forall n v e r. e -> ExprF n v e r
PredicateF e
e

constr :: Source s => Parse n v e s (ExprF n v e (ExprL n v e))
constr :: Parse n v e s (ExprF n v e (ExprL n v e))
constr = do
  n
n  <- Parse n v e s n -> Parse n v e s n
forall s n v e a. Source s => Parse n v e s a -> Parse n v e s a
lexeme Parse n v e s n
forall s n v e. Source s => Parse n v e s n
name
  [ExprL n v e]
es <- Parse n v e s (ExprL n v e) -> Parse n v e s [ExprL n v e]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parse n v e s (ExprL n v e) -> Parse n v e s [ExprL n v e])
-> Parse n v e s (ExprL n v e) -> Parse n v e s [ExprL n v e]
forall a b. (a -> b) -> a -> b
$ Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
forall s n v e.
Source s =>
Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
atomParser Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e.
Source s =>
Parse n v e s (ExprF n v e (ExprL n v e))
atom
  ExprF n v e (ExprL n v e)
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF n v e (ExprL n v e)
 -> Parse n v e s (ExprF n v e (ExprL n v e)))
-> ExprF n v e (ExprL n v e)
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall a b. (a -> b) -> a -> b
$ n -> [ExprL n v e] -> ExprF n v e (ExprL n v e)
forall n v e r. n -> [r] -> ExprF n v e r
PatternF n
n [ExprL n v e]
es

collection :: Source s => Parse n v e s (ExprF n v e (ExprL n v e))
collection :: Parse n v e s (ExprF n v e (ExprL n v e))
collection = do
  Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.bracketLeft
  [ExprL n v e]
es <- Parse n v e s (ExprL n v e)
forall s n v e. Source s => Parse n v e s (ExprL n v e)
expr Parse n v e s (ExprL n v e)
-> Parse n v e s () -> Parse n v e s [ExprL n v e]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.comma
  Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.bracketRight
  ExprF n v e (ExprL n v e)
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF n v e (ExprL n v e)
 -> Parse n v e s (ExprF n v e (ExprL n v e)))
-> ExprF n v e (ExprL n v e)
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall a b. (a -> b) -> a -> b
$ [ExprL n v e] -> ExprF n v e (ExprL n v e)
forall n v e r. [r] -> ExprF n v e r
CollectionF [ExprL n v e]
es

not_ :: Source s => Parse n v e s (ExprF n v e (ExprL n v e))
not_ :: Parse n v e s (ExprF n v e (ExprL n v e))
not_ = do
  Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.exclamation
  ExprL n v e
e <- Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
forall s n v e.
Source s =>
Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
atomParser Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e.
Source s =>
Parse n v e s (ExprF n v e (ExprL n v e))
atom
  ExprF n v e (ExprL n v e)
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF n v e (ExprL n v e)
 -> Parse n v e s (ExprF n v e (ExprL n v e)))
-> ExprF n v e (ExprL n v e)
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall a b. (a -> b) -> a -> b
$ ExprL n v e -> ExprF n v e (ExprL n v e)
forall n v e r. r -> ExprF n v e r
NotF ExprL n v e
e

tupleOrParens :: Source s => Parse n v e s (ExprF n v e (ExprL n v e))
tupleOrParens :: Parse n v e s (ExprF n v e (ExprL n v e))
tupleOrParens = Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e a. Source s => Parse n v e s a -> Parse n v e s a
parens (Parse n v e s (ExprF n v e (ExprL n v e))
 -> Parse n v e s (ExprF n v e (ExprL n v e)))
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall a b. (a -> b) -> a -> b
$ do
  [ExprL n v e]
es <- Parse n v e s (ExprL n v e)
forall s n v e. Source s => Parse n v e s (ExprL n v e)
expr Parse n v e s (ExprL n v e)
-> Parse n v e s () -> Parse n v e s [ExprL n v e]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Token s -> Parse n v e s ()
forall s n v e. Source s => Token s -> Parse n v e s ()
token Token s
forall c. IsToken c => c
Token.comma
  ExprF n v e (ExprL n v e)
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExprF n v e (ExprL n v e)
 -> Parse n v e s (ExprF n v e (ExprL n v e)))
-> ExprF n v e (ExprL n v e)
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall a b. (a -> b) -> a -> b
$ case [ExprL n v e]
es of
    [ExprL n v e
x] -> ExprL n v e -> ExprF n v e (ExprL n v e)
forall (f :: * -> *) (w :: * -> *) a.
ComonadCofree f w =>
w a -> f (w a)
unwrap ExprL n v e
x  -- parens, discarding location once
    [ExprL n v e]
_   -> [ExprL n v e] -> ExprF n v e (ExprL n v e)
forall n v e r. [r] -> ExprF n v e r
TupleF [ExprL n v e]
es  -- tuple

atom :: Source s => Parse n v e s (ExprF n v e (ExprL n v e))
atom :: Parse n v e s (ExprF n v e (ExprL n v e))
atom =
  Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e a. Source s => Parse n v e s (ExprF n v e a)
wildcard
    Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e a. Source s => Parse n v e s (ExprF n v e a)
variable
    Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e.
Source s =>
Parse n v e s (ExprF n v e (ExprL n v e))
not_
    Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e a. Source s => Parse n v e s (ExprF n v e a)
value
    Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e.
Source s =>
Parse n v e s (ExprF n v e (ExprL n v e))
collection
    Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e.
Source s =>
Parse n v e s (ExprF n v e (ExprL n v e))
constr
    Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e a. Source s => Parse n v e s (ExprF n v e a)
predicate
    Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprF n v e (ExprL n v e))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e.
Source s =>
Parse n v e s (ExprF n v e (ExprL n v e))
tupleOrParens
    Parse n v e s (ExprF n v e (ExprL n v e))
-> String -> Parse n v e s (ExprF n v e (ExprL n v e))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"atomic pattern"

expr :: Source s => Parse n v e s (ExprL n v e)
expr :: Parse n v e s (ExprL n v e)
expr = [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
forall s n v e.
Source s =>
[(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
-> Parse n v e s (ExprF n v e (ExprL n v e))
-> Parse n v e s (ExprL n v e)
exprParser [(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
forall s n v e.
Source s =>
[(Precedence, Table (Parse n v e s) (ExprF n v e) (ExprL n v e))]
primInfixes Parse n v e s (ExprF n v e (ExprL n v e))
forall s n v e.
Source s =>
Parse n v e s (ExprF n v e (ExprL n v e))
atom

instance Source s => Parsable (Expr n v e) s (ParseMode n v e s) where
  parseNonGreedyWithLocation :: ParseMode n v e s
-> s -> m (Cofree (Base (Expr n v e)) Location, s)
parseNonGreedyWithLocation = Parse n v e s (ExprL n v e)
-> ParseMode n v e s -> s -> m (ExprL n v e, s)
forall s (m :: * -> *) n v e a.
(Source s, MonadError (Errors s) m) =>
Parse n v e s a -> ParseMode n v e s -> s -> m (a, s)
runParse (Parse n v e s ()
forall s n v e. Source s => Parse n v e s ()
space Parse n v e s ()
-> Parse n v e s (ExprL n v e) -> Parse n v e s (ExprL n v e)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse n v e s (ExprL n v e)
forall s n v e. Source s => Parse n v e s (ExprL n v e)
expr)

-- | Parse 'Expr' with locations annotated.
parseExprL
  :: forall m s n v e
   . (Source s, MonadError (Errors s) m)
  => ParseMode n v e s
  -> s
  -> m (ExprL n v e)
parseExprL :: ParseMode n v e s -> s -> m (ExprL n v e)
parseExprL = forall s mode (m :: * -> *).
(Parsable (Expr n v e) s mode, MonadError (Errors s) m) =>
mode -> s -> m (Cofree (Base (Expr n v e)) Location)
forall a s mode (m :: * -> *).
(Parsable a s mode, MonadError (Errors s) m) =>
mode -> s -> m (Cofree (Base a) Location)
parseWithLocation @(Expr n v e)

-- | Parse 'Expr'.
parseExpr
  :: (Source s, MonadError (Errors s) m)
  => ParseMode n v e s
  -> s
  -> m (Expr n v e)
parseExpr :: ParseMode n v e s -> s -> m (Expr n v e)
parseExpr = ParseMode n v e s -> s -> m (Expr n v e)
forall a s mode (m :: * -> *).
(Parsable a s mode, MonadError (Errors s) m) =>
mode -> s -> m a
parse