> {- | A quasiquoter for SQL. Antiquoting is a bit inconsistent.
>
> Example:
>
> >
> > {-# LANGUAGE QuasiQuotes #-}
> > import Database.HsSqlPpp.Ast
> > import Database.HsSqlPpp.Quote
> > import Database.HsSqlPpp.Annotation
> >
> > test :: Statement
> > test = [$sqlStmt|
> >
> >   create table $n(tablename) (
> >    $m(varname) $n(typename)
> >   );
> >
> >         |]
> >   where
> >     tablename = [sqlName| my_table |]
> >     varname = [sqlNameComponent| my_field |]
> >     typename = [sqlName| text |]
> >
>
> See <http://jakewheat.github.com/hssqlppp/QuasiQuoteTests.html>
> for more simple examples
>
> The splices are:
>
> * $e(scalarexpression)
>
> * $s(string)
>
> * $t(triggerevent)
>
> * $s(statement)
>
> * $n(name)
>
> * $m(namecomponent)
>
> You can use $m() in a name context, and $n() or $m() in a scalar
> expression context. You can only use a single variable name in a
> splice atm.
>      -}
, and for some example files which use quasiquotation to do ast transformations which implement syntax extensions to sql these files need fixing up before ready for public consumption improvements to qq: quasi quotes and antiquotes for?: tablerefs select lists multiple statements use haskell syntax inside antiquotes
>
> {-# LANGUAGE ScopedTypeVariables #-}
>
> module Database.HsSqlPpp.Quote
>     (sqlStmts,sqlStmt,pgsqlStmts,pgsqlStmt,sqlExpr,sqlName,sqlNameComponent) where
> import Language.Haskell.TH.Quote
> import Language.Haskell.TH
> import Data.Generics
> import Data.List
>
> import qualified Database.HsSqlPpp.Parse as P
> import Database.HsSqlPpp.Annotation
> import Database.HsSqlPpp.Syntax hiding (Name)
> import qualified  Database.HsSqlPpp.Syntax as A
> --import qualified Data.Text as T
> import qualified Data.Text.Lazy as L
> --import Data.Data
> import Data.Text ()
> -- Control.Monad.Identity
> --import Text.Parsec
public api: the quasiquote functions
> -- | quotes Statements
> sqlStmts :: QuasiQuoter
> sqlStmts = makeQQ $ parseStatements P.defaultParseFlags
>
> -- | quotes a single Statement
> sqlStmt :: QuasiQuoter
> sqlStmt = makeQQ parseOneStatement
>
> -- | quotes plpgsql Statements
> pgsqlStmts :: QuasiQuoter
> pgsqlStmts = makeQQ $ parsePlpgsql P.defaultParseFlags
>
> -- | quotes a plpgsql Statement
> pgsqlStmt :: QuasiQuoter
> pgsqlStmt = makeQQ parseOnePlpgsql
> -- | quotes a ScalarExpr
> sqlExpr :: QuasiQuoter
> sqlExpr = makeQQ $ parseScalarExpr P.defaultParseFlags
>      {-QuasiQuoter {quoteExp = prs}
>   where
>     prs :: String -> Q Exp
>     prs s = either (fail . show) return (pse s)
>             >>= dataToExpQ (const Nothing)-}
> --pse :: String -> Either P.ParseErrorExtra ScalarExpr
> --pse = parseScalarExpr P.defaultParseFlags "" Nothing
ghc -Wall -threaded -rtsopts -isrc:src-extra/catalogReader:src-extra/chaos:src-extra/devel-util:src-extra/docutil:src-extra/examples:src-extra/extensions:src-extra/h7c:src-extra/tests:src-extra/chaos/extensions:src-extra/utils temp.lhs
> -- | quotes a Name
> sqlName :: QuasiQuoter
> sqlName = makeQQ $ parseName P.defaultParseFlags
> -- | quotes a Name
> sqlNameComponent :: QuasiQuoter
> sqlNameComponent = makeQQ $ parseNameComponent P.defaultParseFlags
boilerplate utils to hook everything together
> type Parser e a = (String
>                    -> Maybe (Int,Int)
>                    -> String
>                    -> Either e a)
>
> makeQQ :: (Show e, Data a) =>
>           Parser e a -> QuasiQuoter
> makeQQ p = QuasiQuoter {quoteExp = parseExprExp p
>                        ,quotePat = parseExprPat p
>                        ,quoteType = error "quasi-quoter doesn't work for types"
>                        ,quoteDec = error "quasi-quoter doesn't work for declarations"}
hack for the text issue: create parallel ast with text replaced with strings automatically create conversion function to convert tree with text to tree with strings automatically pass this tree into dataToExpQ then get the result, and convert the Exp type back to using text not sure what needs to be done about which package the Exp refers to maybe it will work?
> parseExprExp :: (Show e, Data a) =>
>                 Parser e a -> String -> Q Exp
> parseExprExp p s = parseSql' p s
>                    >>= dataToExpQ (const Nothing
>                                     `extQ` antiExpE
>                                     `extQ` antiStrE
>                                     `extQ` antiTriggerEventE
>                                     `extQ` antiStatementE
>                                     `extQ` antiNameE
>                                     `extQ` antiNameComponentE)
> parseExprPat :: (Show e, Data a) =>
>                 Parser e a ->  String -> Q Pat
> parseExprPat p s = parseSql' p s
>                    >>=  dataToPatQ (const Nothing
>                                     `extQ` antiExpP
>                                     `extQ` antiStrP
>                                     `extQ` antiTriggerEventP
>                                     `extQ` antiStatementP
>                                     `extQ` antiNameP
>                                     `extQ` antiNameComponentP
>                                     `extQ` annotToWildCard)
>
wrapper for all the different parsers which sets the source location and converts left to fail todo: error messages not coming out nicely from ghc when doing fail.show.
> parseSql' :: (Data a, Show e) => Parser e a -> String -> Q a
> parseSql' p s = do
>     Loc fn _ _ (l,c) _ <- location
>     either (fail . show) return (p fn (Just (l,c)) s)
wrappers - the Parser module doesn't expose methods which parse exactly one statement
> parseOnePlpgsql :: Parser String Statement
> parseOnePlpgsql f sp s =
>     case parsePlpgsql P.defaultParseFlags f sp s of
>       Right [st] -> Right st
>       Right _ -> Left "got multiple statements"
>       Left e -> Left $ show e
>
> parseOneStatement :: Parser String Statement
> parseOneStatement f sp s =
>     case parseStatements P.defaultParseFlags f sp s of
>       Right [st] -> Right st
>       Right _ -> Left "got multiple statements"
>       Left e -> Left $ show e
hack: replace the annotations in asts produced by parsing with wildcards, if you don't do this then pattern matches generally don't work since the source position annotations from the parser don't match up. The source position annotations are still available so that e.g. a function can pattern match against a statement then get the source position from the matched statements.
> annotToWildCard :: Annotation -> Maybe PatQ
> annotToWildCard _ = Just $ return WildP
= individual antinode lookup functions
> antiExpE :: ScalarExpr -> Maybe ExpQ
> antiExpE v = fmap varE (antiExp v)
>
> antiExpP :: ScalarExpr -> Maybe PatQ
> antiExpP v = fmap varP $ antiExp v
>
> antiExp :: ScalarExpr -> Maybe Name
> antiExp (AntiScalarExpr v) = Just $ mkName v
> antiExp _ = Nothing
> antiNameE :: A.Name -> Maybe ExpQ
> antiNameE v = fmap varE (antiName v)
>
> antiNameP :: A.Name -> Maybe PatQ
> antiNameP v = fmap varP $ antiName v
>
> antiName :: A.Name -> Maybe Name
> antiName (AntiName v) = Just $ mkName v
> antiName _ = Nothing
> antiNameComponentE :: NameComponent -> Maybe ExpQ
> antiNameComponentE v = fmap varE (antiNameComponent v)
>
> antiNameComponentP :: NameComponent -> Maybe PatQ
> antiNameComponentP v = fmap varP $ antiNameComponent v
>
> antiNameComponent :: NameComponent -> Maybe Name
> antiNameComponent (AntiNameComponent v) = Just $ mkName v
> antiNameComponent _ = Nothing
> antiStatementE :: Statement -> Maybe ExpQ
> antiStatementE v = fmap varE (antiStatement v)
>
> antiStatementP :: Statement -> Maybe PatQ
> antiStatementP v = fmap varP $ antiStatement v
>
> antiStatement :: Statement -> Maybe Name
> antiStatement (AntiStatement v) = Just $ mkName v
> antiStatement _ = Nothing
antistatements not working ... trying to replace a single antistatement node with multiple statement nodes and my generics skills aren't up to the task.
> {-antiStatementE :: [Statement] -> Maybe ExpQ
> antiStatementE (AntiStatement v : tl) =
>    Just (listE (vref : conArgs))
>    where
>      conArgs = gmapQ (dataToExpQ (const Nothing
>                                     `extQ` antiExpE
>                                     -- `extQ` antiStrE
>                                     `extQ` antiTriggerEventE
>                                     `extQ` antiStatementE
>                                     `extQ` antiNameE
>                                     `extQ` antiNameComponentE)) tl
>      vref :: ExpQ
>      vref = varE $ mkName v
> antiStatementE _ = Nothing-}
> antiStrE :: String -> Maybe ExpQ
> antiStrE v = fmap varE $ antiStr v
> antiStrP :: String -> Maybe PatQ
> antiStrP v = fmap varP $ antiStr v
> antiStr :: String -> Maybe Name
> antiStr v =
>   fmap mkName $ getSpliceName v
>   where
>     getSpliceName s
>       | isPrefixOf "$s(" s && last s == ')' =
>           Just $ drop 3 $ init s
>       | otherwise = Nothing
>
> antiTriggerEventE :: TriggerEvent -> Maybe ExpQ
> antiTriggerEventE (AntiTriggerEvent v) = Just $ varE $ mkName v
> antiTriggerEventE _ = Nothing
> antiTriggerEventP :: TriggerEvent -> Maybe PatQ
> antiTriggerEventP (AntiTriggerEvent v) = Just $ varP $ mkName v
> antiTriggerEventP _ = Nothing
what needs to be done to support _ in pattern quasiquotes? -> I think it's just adding a wildcard ctor to the appropriate ast types using makeantinodes, and adding in lexing and parsing support - actually using wildcards is now working with the annotation approach above also, how to use haskell syntax in splices ----------------------------------
> parseStatements :: P.ParseFlags -- ^ parse options
>                 -> FilePath -- ^ filename to use in errors
>                 -> Maybe (Int,Int) -- ^ set the line number and column number
>                                    -- of the first char in the source (used in annotation)
>                 -> String -- ^ a string containing the sql to parse
>                 -> Either P.ParseErrorExtra [Statement]
> parseStatements p f s src = P.parseStatements p f s (L.pack src)
> {-parseQueryExpr :: P.ParseFlags -- ^ parse options
>                -> FilePath -- ^ filename to use in errors
>                -> Maybe (Int,Int) -- ^ set the line number and column number
>                -> String -- ^ a string containing the sql to parse
>                -> Either P.ParseErrorExtra QueryExpr
> parseQueryExpr p f s src = P.parseQueryExpr p f s (L.pack src)-}
> parseScalarExpr :: P.ParseFlags -- ^ parse options
>                 -> FilePath -- ^ filename to use in errors
>                 -> Maybe (Int,Int) -- ^ set the line number and column number
>                 -> String -- ^ a string containing the sql to parse
>                 -> Either P.ParseErrorExtra ScalarExpr
> parseScalarExpr p f s src = P.parseScalarExpr p f s (L.pack src)
> parseName :: P.ParseFlags
>           -> FilePath
>           -> Maybe (Int,Int)
>           -> String
>           -> Either P.ParseErrorExtra A.Name
> parseName p f s src = P.parseName p f s (L.pack src)
> parseNameComponent :: P.ParseFlags
>                    -> FilePath
>                    -> Maybe (Int,Int)
>                    -> String
>                    -> Either P.ParseErrorExtra NameComponent
> parseNameComponent p f s src = P.parseNameComponent p f s (L.pack src)
> parsePlpgsql :: P.ParseFlags -- ^ parse options
>              -> FilePath -- ^ filename to use in errors
>              -> Maybe (Int,Int) -- ^ set the line number and column number
>              -> String
>              -> Either P.ParseErrorExtra [Statement]
> parsePlpgsql p f s src = P.parseProcSQL p f s (L.pack src)