content: > {- | 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
  <http://jakewheat.github.com/hssqlppp/source/examples/Database/HsSqlPpp/Examples/Extensions/>
  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)
  