> module Happy.Frontend.AttrGrammar
> ( AgToken (..)
> , AgRule (..)
> , AgSelfAssign(..)
> , AgSubAssign(..)
> , AgConditional(..)
> , HasLexer (..)
> , Index
> , agLexAll
> , subRefVal
> , selfRefVal
> , rightRefVal
> ) where
> import Data.Char
> import Happy.Frontend.ParseMonad.Class
> type Index = Int
> data AgToken
> = AgTok_LBrace
> | AgTok_RBrace
> | AgTok_Where
> | AgTok_Semicolon
> | AgTok_Eq
> | AgTok_SelfRef String
> | AgTok_SubRef (Index, String)
> | AgTok_RightmostRef String
> | AgTok_Unknown String
> | AgTok_EOF
> deriving (Int -> AgToken -> ShowS
[AgToken] -> ShowS
AgToken -> String
(Int -> AgToken -> ShowS)
-> (AgToken -> String) -> ([AgToken] -> ShowS) -> Show AgToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgToken -> ShowS
showsPrec :: Int -> AgToken -> ShowS
$cshow :: AgToken -> String
show :: AgToken -> String
$cshowList :: [AgToken] -> ShowS
showList :: [AgToken] -> ShowS
Show,AgToken -> AgToken -> Bool
(AgToken -> AgToken -> Bool)
-> (AgToken -> AgToken -> Bool) -> Eq AgToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AgToken -> AgToken -> Bool
== :: AgToken -> AgToken -> Bool
$c/= :: AgToken -> AgToken -> Bool
/= :: AgToken -> AgToken -> Bool
Eq,Eq AgToken
Eq AgToken =>
(AgToken -> AgToken -> Ordering)
-> (AgToken -> AgToken -> Bool)
-> (AgToken -> AgToken -> Bool)
-> (AgToken -> AgToken -> Bool)
-> (AgToken -> AgToken -> Bool)
-> (AgToken -> AgToken -> AgToken)
-> (AgToken -> AgToken -> AgToken)
-> Ord AgToken
AgToken -> AgToken -> Bool
AgToken -> AgToken -> Ordering
AgToken -> AgToken -> AgToken
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
$ccompare :: AgToken -> AgToken -> Ordering
compare :: AgToken -> AgToken -> Ordering
$c< :: AgToken -> AgToken -> Bool
< :: AgToken -> AgToken -> Bool
$c<= :: AgToken -> AgToken -> Bool
<= :: AgToken -> AgToken -> Bool
$c> :: AgToken -> AgToken -> Bool
> :: AgToken -> AgToken -> Bool
$c>= :: AgToken -> AgToken -> Bool
>= :: AgToken -> AgToken -> Bool
$cmax :: AgToken -> AgToken -> AgToken
max :: AgToken -> AgToken -> AgToken
$cmin :: AgToken -> AgToken -> AgToken
min :: AgToken -> AgToken -> AgToken
Ord)
> subRefVal :: AgToken -> (Index, String)
> subRefVal :: AgToken -> (Int, String)
subRefVal (AgTok_SubRef (Int, String)
x) = (Int, String)
x
> subRefVal AgToken
_ = String -> (Int, String)
forall a. HasCallStack => String -> a
error String
"subRefVal: Bad value"
> selfRefVal :: AgToken -> String
> selfRefVal :: AgToken -> String
selfRefVal (AgTok_SelfRef String
x) = String
x
> selfRefVal AgToken
_ = ShowS
forall a. HasCallStack => String -> a
error String
"selfRefVal: Bad value"
> rightRefVal :: AgToken -> String
> rightRefVal :: AgToken -> String
rightRefVal (AgTok_RightmostRef String
x) = String
x
> rightRefVal AgToken
_ = ShowS
forall a. HasCallStack => String -> a
error String
"rightRefVal: Bad value"
> data AgRule
> = SelfAssign AgSelfAssign
> | SubAssign AgSubAssign
> | RightmostAssign String [AgToken]
>
> | Conditional AgConditional
> deriving (Int -> AgRule -> ShowS
[AgRule] -> ShowS
AgRule -> String
(Int -> AgRule -> ShowS)
-> (AgRule -> String) -> ([AgRule] -> ShowS) -> Show AgRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgRule -> ShowS
showsPrec :: Int -> AgRule -> ShowS
$cshow :: AgRule -> String
show :: AgRule -> String
$cshowList :: [AgRule] -> ShowS
showList :: [AgRule] -> ShowS
Show,AgRule -> AgRule -> Bool
(AgRule -> AgRule -> Bool)
-> (AgRule -> AgRule -> Bool) -> Eq AgRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AgRule -> AgRule -> Bool
== :: AgRule -> AgRule -> Bool
$c/= :: AgRule -> AgRule -> Bool
/= :: AgRule -> AgRule -> Bool
Eq,Eq AgRule
Eq AgRule =>
(AgRule -> AgRule -> Ordering)
-> (AgRule -> AgRule -> Bool)
-> (AgRule -> AgRule -> Bool)
-> (AgRule -> AgRule -> Bool)
-> (AgRule -> AgRule -> Bool)
-> (AgRule -> AgRule -> AgRule)
-> (AgRule -> AgRule -> AgRule)
-> Ord AgRule
AgRule -> AgRule -> Bool
AgRule -> AgRule -> Ordering
AgRule -> AgRule -> AgRule
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
$ccompare :: AgRule -> AgRule -> Ordering
compare :: AgRule -> AgRule -> Ordering
$c< :: AgRule -> AgRule -> Bool
< :: AgRule -> AgRule -> Bool
$c<= :: AgRule -> AgRule -> Bool
<= :: AgRule -> AgRule -> Bool
$c> :: AgRule -> AgRule -> Bool
> :: AgRule -> AgRule -> Bool
$c>= :: AgRule -> AgRule -> Bool
>= :: AgRule -> AgRule -> Bool
$cmax :: AgRule -> AgRule -> AgRule
max :: AgRule -> AgRule -> AgRule
$cmin :: AgRule -> AgRule -> AgRule
min :: AgRule -> AgRule -> AgRule
Ord)
We will partition the rule types and handle them separately, so we want
a separate data type for each core rule type. We don't need one for
`RightmostAssign` because it is syntactic sugar.
> data AgSelfAssign = MkAgSelfAssign String [AgToken]
> deriving (Int -> AgSelfAssign -> ShowS
[AgSelfAssign] -> ShowS
AgSelfAssign -> String
(Int -> AgSelfAssign -> ShowS)
-> (AgSelfAssign -> String)
-> ([AgSelfAssign] -> ShowS)
-> Show AgSelfAssign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgSelfAssign -> ShowS
showsPrec :: Int -> AgSelfAssign -> ShowS
$cshow :: AgSelfAssign -> String
show :: AgSelfAssign -> String
$cshowList :: [AgSelfAssign] -> ShowS
showList :: [AgSelfAssign] -> ShowS
Show,AgSelfAssign -> AgSelfAssign -> Bool
(AgSelfAssign -> AgSelfAssign -> Bool)
-> (AgSelfAssign -> AgSelfAssign -> Bool) -> Eq AgSelfAssign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AgSelfAssign -> AgSelfAssign -> Bool
== :: AgSelfAssign -> AgSelfAssign -> Bool
$c/= :: AgSelfAssign -> AgSelfAssign -> Bool
/= :: AgSelfAssign -> AgSelfAssign -> Bool
Eq,Eq AgSelfAssign
Eq AgSelfAssign =>
(AgSelfAssign -> AgSelfAssign -> Ordering)
-> (AgSelfAssign -> AgSelfAssign -> Bool)
-> (AgSelfAssign -> AgSelfAssign -> Bool)
-> (AgSelfAssign -> AgSelfAssign -> Bool)
-> (AgSelfAssign -> AgSelfAssign -> Bool)
-> (AgSelfAssign -> AgSelfAssign -> AgSelfAssign)
-> (AgSelfAssign -> AgSelfAssign -> AgSelfAssign)
-> Ord AgSelfAssign
AgSelfAssign -> AgSelfAssign -> Bool
AgSelfAssign -> AgSelfAssign -> Ordering
AgSelfAssign -> AgSelfAssign -> AgSelfAssign
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
$ccompare :: AgSelfAssign -> AgSelfAssign -> Ordering
compare :: AgSelfAssign -> AgSelfAssign -> Ordering
$c< :: AgSelfAssign -> AgSelfAssign -> Bool
< :: AgSelfAssign -> AgSelfAssign -> Bool
$c<= :: AgSelfAssign -> AgSelfAssign -> Bool
<= :: AgSelfAssign -> AgSelfAssign -> Bool
$c> :: AgSelfAssign -> AgSelfAssign -> Bool
> :: AgSelfAssign -> AgSelfAssign -> Bool
$c>= :: AgSelfAssign -> AgSelfAssign -> Bool
>= :: AgSelfAssign -> AgSelfAssign -> Bool
$cmax :: AgSelfAssign -> AgSelfAssign -> AgSelfAssign
max :: AgSelfAssign -> AgSelfAssign -> AgSelfAssign
$cmin :: AgSelfAssign -> AgSelfAssign -> AgSelfAssign
min :: AgSelfAssign -> AgSelfAssign -> AgSelfAssign
Ord)
> data AgSubAssign = MkAgSubAssign (Index, String) [AgToken]
> deriving (Int -> AgSubAssign -> ShowS
[AgSubAssign] -> ShowS
AgSubAssign -> String
(Int -> AgSubAssign -> ShowS)
-> (AgSubAssign -> String)
-> ([AgSubAssign] -> ShowS)
-> Show AgSubAssign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgSubAssign -> ShowS
showsPrec :: Int -> AgSubAssign -> ShowS
$cshow :: AgSubAssign -> String
show :: AgSubAssign -> String
$cshowList :: [AgSubAssign] -> ShowS
showList :: [AgSubAssign] -> ShowS
Show,AgSubAssign -> AgSubAssign -> Bool
(AgSubAssign -> AgSubAssign -> Bool)
-> (AgSubAssign -> AgSubAssign -> Bool) -> Eq AgSubAssign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AgSubAssign -> AgSubAssign -> Bool
== :: AgSubAssign -> AgSubAssign -> Bool
$c/= :: AgSubAssign -> AgSubAssign -> Bool
/= :: AgSubAssign -> AgSubAssign -> Bool
Eq,Eq AgSubAssign
Eq AgSubAssign =>
(AgSubAssign -> AgSubAssign -> Ordering)
-> (AgSubAssign -> AgSubAssign -> Bool)
-> (AgSubAssign -> AgSubAssign -> Bool)
-> (AgSubAssign -> AgSubAssign -> Bool)
-> (AgSubAssign -> AgSubAssign -> Bool)
-> (AgSubAssign -> AgSubAssign -> AgSubAssign)
-> (AgSubAssign -> AgSubAssign -> AgSubAssign)
-> Ord AgSubAssign
AgSubAssign -> AgSubAssign -> Bool
AgSubAssign -> AgSubAssign -> Ordering
AgSubAssign -> AgSubAssign -> AgSubAssign
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
$ccompare :: AgSubAssign -> AgSubAssign -> Ordering
compare :: AgSubAssign -> AgSubAssign -> Ordering
$c< :: AgSubAssign -> AgSubAssign -> Bool
< :: AgSubAssign -> AgSubAssign -> Bool
$c<= :: AgSubAssign -> AgSubAssign -> Bool
<= :: AgSubAssign -> AgSubAssign -> Bool
$c> :: AgSubAssign -> AgSubAssign -> Bool
> :: AgSubAssign -> AgSubAssign -> Bool
$c>= :: AgSubAssign -> AgSubAssign -> Bool
>= :: AgSubAssign -> AgSubAssign -> Bool
$cmax :: AgSubAssign -> AgSubAssign -> AgSubAssign
max :: AgSubAssign -> AgSubAssign -> AgSubAssign
$cmin :: AgSubAssign -> AgSubAssign -> AgSubAssign
min :: AgSubAssign -> AgSubAssign -> AgSubAssign
Ord)
> data AgConditional = MkAgConditional [AgToken]
> deriving (Int -> AgConditional -> ShowS
[AgConditional] -> ShowS
AgConditional -> String
(Int -> AgConditional -> ShowS)
-> (AgConditional -> String)
-> ([AgConditional] -> ShowS)
-> Show AgConditional
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgConditional -> ShowS
showsPrec :: Int -> AgConditional -> ShowS
$cshow :: AgConditional -> String
show :: AgConditional -> String
$cshowList :: [AgConditional] -> ShowS
showList :: [AgConditional] -> ShowS
Show,AgConditional -> AgConditional -> Bool
(AgConditional -> AgConditional -> Bool)
-> (AgConditional -> AgConditional -> Bool) -> Eq AgConditional
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AgConditional -> AgConditional -> Bool
== :: AgConditional -> AgConditional -> Bool
$c/= :: AgConditional -> AgConditional -> Bool
/= :: AgConditional -> AgConditional -> Bool
Eq,Eq AgConditional
Eq AgConditional =>
(AgConditional -> AgConditional -> Ordering)
-> (AgConditional -> AgConditional -> Bool)
-> (AgConditional -> AgConditional -> Bool)
-> (AgConditional -> AgConditional -> Bool)
-> (AgConditional -> AgConditional -> Bool)
-> (AgConditional -> AgConditional -> AgConditional)
-> (AgConditional -> AgConditional -> AgConditional)
-> Ord AgConditional
AgConditional -> AgConditional -> Bool
AgConditional -> AgConditional -> Ordering
AgConditional -> AgConditional -> AgConditional
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
$ccompare :: AgConditional -> AgConditional -> Ordering
compare :: AgConditional -> AgConditional -> Ordering
$c< :: AgConditional -> AgConditional -> Bool
< :: AgConditional -> AgConditional -> Bool
$c<= :: AgConditional -> AgConditional -> Bool
<= :: AgConditional -> AgConditional -> Bool
$c> :: AgConditional -> AgConditional -> Bool
> :: AgConditional -> AgConditional -> Bool
$c>= :: AgConditional -> AgConditional -> Bool
>= :: AgConditional -> AgConditional -> Bool
$cmax :: AgConditional -> AgConditional -> AgConditional
max :: AgConditional -> AgConditional -> AgConditional
$cmin :: AgConditional -> AgConditional -> AgConditional
min :: AgConditional -> AgConditional -> AgConditional
Ord)
> agLexAll :: String -> Int -> ParseResult [AgToken]
> agLexAll :: String -> Int -> ParseResult [AgToken]
agLexAll = [AgToken] -> String -> Int -> ParseResult [AgToken]
aux []
> where aux :: [AgToken] -> String -> Int -> ParseResult [AgToken]
aux [AgToken]
toks [] Int
_ = [AgToken] -> ParseResult [AgToken]
forall a b. b -> Either a b
Right ([AgToken] -> [AgToken]
forall a. [a] -> [a]
reverse [AgToken]
toks)
> aux [AgToken]
toks String
s Int
l = (AgToken -> String -> Int -> ParseResult [AgToken])
-> String -> Int -> ParseResult [AgToken]
forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexer (\AgToken
t -> [AgToken] -> String -> Int -> ParseResult [AgToken]
aux (AgToken
tAgToken -> [AgToken] -> [AgToken]
forall a. a -> [a] -> [a]
:[AgToken]
toks)) String
s Int
l
> instance HasLexer AgToken where
> lexToken :: forall a. (AgToken -> Pfunc a) -> Pfunc a
lexToken = (AgToken -> Pfunc r) -> Pfunc r
forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexer
> agLexer :: (AgToken -> Pfunc a) -> Pfunc a
> agLexer :: forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexer AgToken -> Pfunc a
cont [] = AgToken -> Pfunc a
cont AgToken
AgTok_EOF []
> agLexer AgToken -> Pfunc a
cont (Char
'{':String
rest) = AgToken -> Pfunc a
cont AgToken
AgTok_LBrace String
rest
> agLexer AgToken -> Pfunc a
cont (Char
'}':String
rest) = AgToken -> Pfunc a
cont AgToken
AgTok_RBrace String
rest
> agLexer AgToken -> Pfunc a
cont (Char
';':String
rest) = AgToken -> Pfunc a
cont AgToken
AgTok_Semicolon String
rest
> agLexer AgToken -> Pfunc a
cont (Char
'=':String
rest) = AgToken -> Pfunc a
cont AgToken
AgTok_Eq String
rest
> agLexer AgToken -> Pfunc a
cont (Char
'w':Char
'h':Char
'e':Char
'r':Char
'e':String
rest) = AgToken -> Pfunc a
cont AgToken
AgTok_Where String
rest
> agLexer AgToken -> Pfunc a
cont (Char
'$':Char
'$':String
rest) = (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
forall a. (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
agLexAttribute AgToken -> Pfunc a
cont (\String
a -> String -> AgToken
AgTok_SelfRef String
a) String
rest
> agLexer AgToken -> Pfunc a
cont (Char
'$':Char
'>':String
rest) = (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
forall a. (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
agLexAttribute AgToken -> Pfunc a
cont (\String
a -> String -> AgToken
AgTok_RightmostRef String
a) String
rest
> agLexer AgToken -> Pfunc a
cont s :: String
s@(Char
'$':String
rest) =
> let (String
n,String
rest') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
rest
> in if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n
> then (AgToken -> Pfunc a) -> Pfunc a
forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexUnknown AgToken -> Pfunc a
cont String
s
> else (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
forall a. (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
agLexAttribute AgToken -> Pfunc a
cont (\String
a -> (Int, String) -> AgToken
AgTok_SubRef (String -> Int
forall a. Read a => String -> a
read String
n,String
a)) String
rest'
> agLexer AgToken -> Pfunc a
cont s :: String
s@(Char
c:String
rest)
> | Char -> Bool
isSpace Char
c = (AgToken -> Pfunc a) -> Pfunc a
forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexer AgToken -> Pfunc a
cont ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
rest)
> | Bool
otherwise = (AgToken -> Pfunc a) -> Pfunc a
forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexUnknown AgToken -> Pfunc a
cont String
s
> agLexUnknown :: (AgToken -> Pfunc a) -> Pfunc a
> agLexUnknown :: forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexUnknown AgToken -> Pfunc a
cont String
s = let (String
u,String
rest) = String -> String -> (String, String)
aux [] String
s in AgToken -> Pfunc a
cont (String -> AgToken
AgTok_Unknown String
u) String
rest
> where aux :: String -> String -> (String, String)
aux String
t [] = (ShowS
forall a. [a] -> [a]
reverse String
t,[])
> aux String
t (Char
'$':Char
c:String
cs)
> | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isDigit Char
c) = String -> String -> (String, String)
aux (Char
'$'Char -> ShowS
forall a. a -> [a] -> [a]
:String
t) (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)
> | Bool
otherwise = (ShowS
forall a. [a] -> [a]
reverse String
t,Char
'$'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)
> aux String
t (Char
c:String
cs)
> | Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"{};=" = (ShowS
forall a. [a] -> [a]
reverse String
t,Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)
> | Bool
otherwise = String -> String -> (String, String)
aux (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
t) String
cs
> agLexAttribute :: (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
> agLexAttribute :: forall a. (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
agLexAttribute AgToken -> Pfunc a
cont String -> AgToken
k (Char
'.':Char
x:String
xs)
> | Char -> Bool
isLower Char
x = let (String
ident,String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') String
xs in AgToken -> Pfunc a
cont (String -> AgToken
k (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
ident)) String
rest
> | Bool
otherwise = \Int
_ -> String -> ParseResult a
forall a b. a -> Either a b
Left String
"bad attribute identifier"
> agLexAttribute AgToken -> Pfunc a
cont String -> AgToken
k String
rest = AgToken -> Pfunc a
cont (String -> AgToken
k String
"") String
rest