> module AttrGrammar 
> ( AgToken (..)
> , AgRule (..)
> , agLexAll
> , agLexer
> , subRefVal
> , selfRefVal
> , rightRefVal
> ) where


> import Data.Char
> import ParseMonad


> data AgToken 
>   = AgTok_LBrace
>   | AgTok_RBrace
>   | AgTok_Where
>   | AgTok_Semicolon
>   | AgTok_Eq
>   | AgTok_SelfRef String
>   | AgTok_SubRef (Int, String)
>   | AgTok_RightmostRef String
>   | AgTok_Unknown String
>   | AgTok_EOF
>  deriving (Int -> AgToken -> ShowS
[AgToken] -> ShowS
AgToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AgToken] -> ShowS
$cshowList :: [AgToken] -> ShowS
show :: AgToken -> String
$cshow :: AgToken -> String
showsPrec :: Int -> AgToken -> ShowS
$cshowsPrec :: Int -> AgToken -> ShowS
Show,AgToken -> AgToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AgToken -> AgToken -> Bool
$c/= :: AgToken -> AgToken -> Bool
== :: AgToken -> AgToken -> Bool
$c== :: AgToken -> AgToken -> Bool
Eq,Eq 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
min :: AgToken -> AgToken -> AgToken
$cmin :: AgToken -> AgToken -> AgToken
max :: AgToken -> AgToken -> AgToken
$cmax :: AgToken -> AgToken -> AgToken
>= :: AgToken -> AgToken -> Bool
$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
compare :: AgToken -> AgToken -> Ordering
$ccompare :: AgToken -> AgToken -> Ordering
Ord)


> subRefVal :: AgToken -> (Int, String)
> subRefVal :: AgToken -> (Int, String)
subRefVal   (AgTok_SubRef (Int, String)
x)       = (Int, String)
x
> subRefVal   AgToken
_ = 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
_ = 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
_ = forall a. HasCallStack => String -> a
error String
"rightRefVal: Bad value"


> data AgRule
>   = SelfAssign String [AgToken]
>   | SubAssign (Int,String) [AgToken]
>   | RightmostAssign String [AgToken]
>   | Conditional [AgToken]
>  deriving (Int -> AgRule -> ShowS
[AgRule] -> ShowS
AgRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AgRule] -> ShowS
$cshowList :: [AgRule] -> ShowS
show :: AgRule -> String
$cshow :: AgRule -> String
showsPrec :: Int -> AgRule -> ShowS
$cshowsPrec :: Int -> AgRule -> ShowS
Show,AgRule -> AgRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AgRule -> AgRule -> Bool
$c/= :: AgRule -> AgRule -> Bool
== :: AgRule -> AgRule -> Bool
$c== :: AgRule -> AgRule -> Bool
Eq,Eq 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
min :: AgRule -> AgRule -> AgRule
$cmin :: AgRule -> AgRule -> AgRule
max :: AgRule -> AgRule -> AgRule
$cmax :: AgRule -> AgRule -> AgRule
>= :: AgRule -> AgRule -> Bool
$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
compare :: AgRule -> AgRule -> Ordering
$ccompare :: AgRule -> AgRule -> Ordering
Ord)














--       or $> (for the rightmost symbol) followed by an optional










--            $>
















> type Pfunc a = String -> Int -> ParseResult a


> agLexAll :: P [AgToken]
> agLexAll :: P [AgToken]
agLexAll = forall a. (String -> Int -> ParseResult a) -> P a
P forall a b. (a -> b) -> a -> b
$ [AgToken] -> Pfunc [AgToken]
aux []
>  where aux :: [AgToken] -> Pfunc [AgToken]
aux [AgToken]
toks [] Int
_ = forall a. a -> ParseResult a
OkP (forall a. [a] -> [a]
reverse [AgToken]
toks)
>        aux [AgToken]
toks String
s Int
l  = forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexer' (\AgToken
t -> [AgToken] -> Pfunc [AgToken]
aux (AgToken
tforall a. a -> [a] -> [a]
:[AgToken]
toks)) String
s Int
l


> agLexer :: (AgToken -> P a) -> P a
> agLexer :: forall a. (AgToken -> P a) -> P a
agLexer AgToken -> P a
m = forall a. (String -> Int -> ParseResult a) -> P a
P forall a b. (a -> b) -> a -> b
$ forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexer' (\AgToken
x -> forall a. P a -> String -> Int -> ParseResult a
runP (AgToken -> P a
m AgToken
x))


> 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) = 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) = 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') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
rest
>     in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n 
>           then forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexUnknown AgToken -> Pfunc a
cont String
s
>	    else forall a. (AgToken -> Pfunc a) -> (String -> AgToken) -> Pfunc a
agLexAttribute AgToken -> Pfunc a
cont (\String
a -> (Int, String) -> AgToken
AgTok_SubRef (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 = forall a. (AgToken -> Pfunc a) -> Pfunc a
agLexer' AgToken -> Pfunc a
cont (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
rest)
>     | Bool
otherwise = 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 [] = (forall a. [a] -> [a]
reverse String
t,[])
>         aux String
t (Char
'$':Char
c:String
cs)
>            | Char
c 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
'$'forall a. a -> [a] -> [a]
:String
t) (Char
cforall a. a -> [a] -> [a]
:String
cs)
>            | Bool
otherwise                    = (forall a. [a] -> [a]
reverse String
t,Char
'$'forall a. a -> [a] -> [a]
:Char
cforall a. a -> [a] -> [a]
:String
cs)
>         aux String
t (Char
c:String
cs)
>            | Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"{};=" = (forall a. [a] -> [a]
reverse String
t,Char
cforall a. a -> [a] -> [a]
:String
cs)
>	     | Bool
otherwise                    = String -> String -> (String, String)
aux (Char
cforall 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\'') String
xs in AgToken -> Pfunc a
cont (String -> AgToken
k (Char
xforall a. a -> [a] -> [a]
:String
ident)) String
rest
>	 | Bool
otherwise = \Int
_ -> forall a. String -> ParseResult a
FailP String
"bad attribute identifier"
> agLexAttribute AgToken -> Pfunc a
cont String -> AgToken
k String
rest = AgToken -> Pfunc a
cont (String -> AgToken
k String
"") String
rest