-pquals :: { Located [LStmt RdrName] } -- Either a singleton ParStmt,
- -- or a reversed list of Stmts
- : pquals1 { case unLoc $1 of
- [qs] -> L1 qs
- qss -> L1 [L1 (ParStmt stmtss)]
- where
- stmtss = [ (reverse qs, undefined)
- | qs <- qss ]
- }
-
-pquals1 :: { Located [[LStmt RdrName]] }
- : pquals1 '|' quals { LL (unLoc $3 : unLoc $1) }
- | '|' quals { L (getLoc $2) [unLoc $2] }
-
-quals :: { Located [LStmt RdrName] }
- : quals ',' qual { LL ($3 : unLoc $1) }
- | qual { L1 [$1] }
+flattenedpquals :: { Located [LStmt RdrName] }
+ : pquals { case (unLoc $1) of
+ [qs] -> L1 qs
+ -- We just had one thing in our "parallel" list so
+ -- we simply return that thing directly
+
+ qss -> L1 [L1 $ ParStmt [(qs, undefined) | qs <- qss] noSyntaxExpr noSyntaxExpr noSyntaxExpr]
+ -- We actually found some actual parallel lists so
+ -- we wrap them into as a ParStmt
+ }
+
+pquals :: { Located [[LStmt RdrName]] }
+ : squals '|' pquals { L (getLoc $2) (reverse (unLoc $1) : unLoc $3) }
+ | squals { L (getLoc $1) [reverse (unLoc $1)] }
+
+squals :: { Located [LStmt RdrName] } -- In reverse order, because the last
+ -- one can "grab" the earlier ones
+ : squals ',' transformqual { LL [L (getLoc $3) ((unLoc $3) (reverse (unLoc $1)))] }
+ | squals ',' qual { LL ($3 : unLoc $1) }
+ | transformqual { LL [L (getLoc $1) ((unLoc $1) [])] }
+ | qual { L1 [$1] }
+-- | transformquals1 ',' '{|' pquals '|}' { LL ($4 : unLoc $1) }
+-- | '{|' pquals '|}' { L1 [$2] }
+
+
+-- It is possible to enable bracketing (associating) qualifier lists by uncommenting the lines with {| |}
+-- above. Due to a lack of consensus on the syntax, this feature is not being used until we get user
+-- demand. Note that the {| |} symbols are reused from -XGenerics and hence if you want to compile
+-- a program that makes use of this temporary syntax you must supply that flag to GHC
+
+transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) }
+ -- Function is applied to a list of stmts *in order*
+ : 'then' exp { LL $ \leftStmts -> (mkTransformStmt leftStmts $2) }
+ -- >>>
+ | 'then' exp 'by' exp { LL $ \leftStmts -> (mkTransformByStmt leftStmts $2 $4) }
+ | 'then' 'group' 'by' exp { LL $ \leftStmts -> (mkGroupByStmt leftStmts $4) }
+ -- <<<
+ -- These two productions deliberately have a shift-reduce conflict. I have made 'group' into a special_id,
+ -- which means you can enable TransformListComp while still using Data.List.group. However, this makes the two
+ -- productions ambiguous. I've set things up so that Happy chooses to resolve the conflict in that case by
+ -- choosing the "group by" variant, which is what we want.
+ --
+ -- This is rather dubious: the user might be confused as to how to parse this statement. However, it is a good
+ -- practical choice. NB: Data.List.group :: [a] -> [[a]], so using the first production would not even type check
+ -- if /that/ is the group function we conflict with.
+ | 'then' 'group' 'using' exp { LL $ \leftStmts -> (mkGroupUsingStmt leftStmts $4) }
+ | 'then' 'group' 'by' exp 'using' exp { LL $ \leftStmts -> (mkGroupByUsingStmt leftStmts $4 $6) }