{-# LANGUAGE OverloadedStrings #-}

module Hyperscript.Parser where

import Data.Text (Text)
import Data.Void (Void)
import Text.Megaparsec (Parsec)
import qualified Text.Megaparsec.Char as C
import qualified Text.Megaparsec.Char.Lexer as L

data Error = Error deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Eq Error
Eq Error
-> (Error -> Error -> Ordering)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Error)
-> (Error -> Error -> Error)
-> Ord Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmax :: Error -> Error -> Error
>= :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c< :: Error -> Error -> Bool
compare :: Error -> Error -> Ordering
$ccompare :: Error -> Error -> Ordering
$cp1Ord :: Eq Error
Ord)

type Parser = Parsec Void Text

data HsLexemes
  = PLUS
  | MINUS
  | MULTIPLY
  | DIVIDE
  | PERIOD
  | ELLIPSIS
  | BACKSLASH
  | COLON
  | PERCENT
  | PIPE
  | EXCLAMATION
  | QUESTION
  | POUND
  | AMPERSAND
  | DOLLAR
  | SEMI
  | COMMA
  | L_PAREN
  | R_PAREN
  | L_ANG
  | R_ANG
  | LTE_ANG
  | GTE_ANG
  | EQ_
  | EQQ
  | NEQ
  | NEQQ
  | L_BRACE
  | R_BRACE
  | L_BRACKET
  | R_BRACKET
  | EQUALS
  deriving (HsLexemes -> HsLexemes -> Bool
(HsLexemes -> HsLexemes -> Bool)
-> (HsLexemes -> HsLexemes -> Bool) -> Eq HsLexemes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HsLexemes -> HsLexemes -> Bool
$c/= :: HsLexemes -> HsLexemes -> Bool
== :: HsLexemes -> HsLexemes -> Bool
$c== :: HsLexemes -> HsLexemes -> Bool
Eq, Int -> HsLexemes -> ShowS
[HsLexemes] -> ShowS
HsLexemes -> String
(Int -> HsLexemes -> ShowS)
-> (HsLexemes -> String)
-> ([HsLexemes] -> ShowS)
-> Show HsLexemes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsLexemes] -> ShowS
$cshowList :: [HsLexemes] -> ShowS
show :: HsLexemes -> String
$cshow :: HsLexemes -> String
showsPrec :: Int -> HsLexemes -> ShowS
$cshowsPrec :: Int -> HsLexemes -> ShowS
Show)

space :: Parser ()
space :: Parser ()
space = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
C.space1 (Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
"--") (Tokens Text -> Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"{-" Tokens Text
"-}")

symbol :: Tokens Text -> ParsecT Void Text Identity (Tokens Text)
symbol = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
space

plus :: ParsecT Void Text Identity HsLexemes
plus = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"+"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
PLUS

minus :: ParsecT Void Text Identity HsLexemes
minus = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"-"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
MINUS

multiply :: ParsecT Void Text Identity HsLexemes
multiply = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"*"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
MULTIPLY

divide :: ParsecT Void Text Identity HsLexemes
divide = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"/"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
DIVIDE

period :: ParsecT Void Text Identity HsLexemes
period = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"."
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
PERIOD

ellipsis :: ParsecT Void Text Identity HsLexemes
ellipsis = do
  Text -> ParsecT Void Text Identity Text
symbol Text
".."
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
ELLIPSIS

backslash :: ParsecT Void Text Identity HsLexemes
backslash = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"\\"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
BACKSLASH

colon :: ParsecT Void Text Identity HsLexemes
colon = do
  Text -> ParsecT Void Text Identity Text
symbol Text
":"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
COLON

percent :: ParsecT Void Text Identity HsLexemes
percent = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"%"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
PERCENT

pipe :: ParsecT Void Text Identity HsLexemes
pipe = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"|"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
PIPE

exclamation :: ParsecT Void Text Identity HsLexemes
exclamation = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"!"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
EXCLAMATION

question :: ParsecT Void Text Identity HsLexemes
question = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"?"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
QUESTION

pound :: ParsecT Void Text Identity HsLexemes
pound = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"#"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
POUND

ampersand :: ParsecT Void Text Identity HsLexemes
ampersand = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"&"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
AMPERSAND

dollar :: ParsecT Void Text Identity HsLexemes
dollar = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"$"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
DOLLAR

semi :: ParsecT Void Text Identity HsLexemes
semi = do
  Text -> ParsecT Void Text Identity Text
symbol Text
";"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
SEMI

comma :: ParsecT Void Text Identity HsLexemes
comma = do
  Text -> ParsecT Void Text Identity Text
symbol Text
","
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
COMMA

lParen :: ParsecT Void Text Identity HsLexemes
lParen = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"("
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
L_PAREN

rParen :: ParsecT Void Text Identity HsLexemes
rParen = do
  Text -> ParsecT Void Text Identity Text
symbol Text
")"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
R_PAREN

lAng :: ParsecT Void Text Identity HsLexemes
lAng = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"<"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
L_ANG

rAng :: ParsecT Void Text Identity HsLexemes
rAng = do
  Text -> ParsecT Void Text Identity Text
symbol Text
">"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
R_ANG

lteAng :: ParsecT Void Text Identity HsLexemes
lteAng = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"<="
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
LTE_ANG

gteAng :: ParsecT Void Text Identity HsLexemes
gteAng = do
  Text -> ParsecT Void Text Identity Text
symbol Text
">="
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
GTE_ANG

eq :: ParsecT Void Text Identity HsLexemes
eq = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"=="
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
EQ_

eqq :: ParsecT Void Text Identity HsLexemes
eqq = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"==="
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
EQQ

neq :: ParsecT Void Text Identity HsLexemes
neq = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"!="
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
NEQ

neqq :: ParsecT Void Text Identity HsLexemes
neqq = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"!=="
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
NEQQ

lBrace :: ParsecT Void Text Identity HsLexemes
lBrace = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"{"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
L_BRACE

rBrace :: ParsecT Void Text Identity HsLexemes
rBrace = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"}"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
R_BRACE

lBracket :: ParsecT Void Text Identity HsLexemes
lBracket = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"["
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
L_BRACKET

rBracket :: ParsecT Void Text Identity HsLexemes
rBracket = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"]"
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
R_BRACKET

equals :: ParsecT Void Text Identity HsLexemes
equals = do
  Text -> ParsecT Void Text Identity Text
symbol Text
"="
  HsLexemes -> ParsecT Void Text Identity HsLexemes
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLexemes
EQUALS